#!%PERL_PATH%

# HyperNikkiSystem Title List for hns 2.10 or later
# version 0.1.9
# 2000/10/22  Kenji Suzuki <kenji@h14m.org>
package HNS::Tools::Title;

$version = "0.1.9";

# Special Thanks:
# Akihiro Arisawa <ari@nijino.com>
# Akihiko Hayashi <hayashi@totalware.gifu.gifu.jp>

# Copyright (C) 1998-2000  Kenji Suzuki, HyperNikkiSystem Project

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# $Id: title.cgi.in,v 1.25 2000/10/22 04:54:55 kenji Exp $

#use strict;
use lib qw(lib);

use SimpleDB::Hash;
use HNS::AccessControl;
use HNS::Status;
use HNS::Hnf::Command;
use CodeConv;

require './config.ph';
#require 'lib/jcode.pl'; # if you use nkf, comment this line out.

$NKF = "%NKF_PATH%";
$NKF_USE = 0; # 1 -> Use, 0 -> No Use (default)

$diaryDir = $HNS::System::DiaryDir;
$webDiaryDir = "%HTMLDIR%";
$catDir = $webDiaryDir . "/cat";
$catFile = $catDir . "/cat.txt";
$Title = $HNS::System::Title;
$MyDiaryURI = $HNS::System::MyDiaryURI;

# customizable variables
$NewStart = "";
$NewEnd = "";
$SubStart = "";
$SubEnd = "";
$SubMark = "¡÷";
$HeadTitle = qq(<title>$Title Title List</title>\n);
$Header = qq(<h1><a href="$MyDiaryURI">$Title</a> Title List</h1>\n);
$BacktoDiary =
        qq(<div align="right"><a href="$MyDiaryURI">Back to Diary</a></div>\n);

################################################################
# DO NOT CHANGE following code.
# access control
my $acl = new HNS::AccessControl;

################################################################
# theme Overriding

if ($HNS::System::Theme) {
    my $theme_ph = "$HNS::System::Theme/theme.ph";
    my $theme_static_ph;

    if (! $ENV{'SCRIPT_NAME'}) {
        $theme_static_ph = "$HNS::System::Theme/theme-static.ph";
        if (-f "$theme_static_ph") {
            $theme_ph = $theme_static_ph;
        }
    }
    unless (-f "$theme_ph"){
        die "no theme file : $theme_ph";
    }
    require "$theme_ph";
}
else {
    die 'no theme';
}

################################################################
# global variables
my ($arg, @CAT, @SELECTED_CAT, %cat, $dispOrder, @filelist, @NEW, $hnf);
my %GRP_DB = ();
my %RLINK_DB = ();
my (%time);

&main;


sub getArg () {
  $arg = $ENV{'QUERY_STRING'};
  $arg =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/ge;
 
  $arg =~ s/CAT=([^&]*)/push(@SELECTED_CAT, $1);"";/ge;
  foreach (@SELECTED_CAT) {
    if ($_ eq "ALL") {
      undef @SELECTED_CAT;
      $SELECTED_CAT[0] = "ALL";
    }
  }

  $arg =~ s/\D*(\d+[abc]?)\D*/$1/;
  if ($arg =~ /(\d\d\d\d)(.*)/) {
    $year = $1; 
    $dispOrder = 1; # in late order
  }
  else {
    $arg = $year . $mon;
    $dispOrder = -1; # in reverse order
  } 
}


sub main () {
  my (@tmp);

  &getTime;
  &readCatFile;
  &getArg;
  &html_header;

  if (-d $diaryDir . "/" . $year) {
    &getFileList($diaryDir . "/" . $year);
  }

  &getFileList($diaryDir);

  if ($dispOrder == 1) {
    @tmp = sort @filelist;
  }
  else {
    @tmp = reverse sort @filelist;
  }

  @filelist = @tmp;

  foreach $file (@filelist) {
    &readHnf($file);
    &getNew(@hnfs);
  }

  if ($SELECTED_CAT[0] eq "ALL") {
    @SELECTED_CAT = keys %CAT;
  } 
  if (defined(@SELECTED_CAT)) {
    foreach $cat (@SELECTED_CAT) {
      print "<h3>";

      $enc_cat = $cat;
      $enc_cat =~ s/([^a-zA-Z0-9~\-\_\.\/\:\%])/
                sprintf("%%%02X",ord($1))/ge;

      if (-f $catDir . "/" . $cats{$cat}) {
        print qq(<img src="./cat/$cats{$cat}" alt="$cat"> 
	  <a href="./title.cgi?$arg&CAT=$enc_cat">$cat</a>);
      }
      else {
        print qq(<a href="./title.cgi?$arg&CAT=$enc_cat">$cat</a>);
      }
      print "</h3>\n";

      foreach $title (@{$CAT{$cat}}) {
        print "$title<br>\n";
      }
    }
  }
  else {
    foreach $title (@NEW) {
      print "$title<br>\n";
    }
  }

  &html_footer;
}


sub html_header {
  print qq(Content-Type: text/html; charset=EUC-JP\r\n\r\n);

  print $HNS::ExtHTML::DOCTYPE;

  if ($HNS::System::Lang) {
      print qq(<html lang="$HNS::System::Lang">\n<head>);
  }
  else {
      print qq(<html>\n<head>);
  }

  print qq(
<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP">\n);

  print $HNS::ExtHTML::Head;
  print $HeadTitle;

  print qq(</head>\n\n);
  print qq(<body $HNS::ExtHTML::BodyVal>\n);

  print $Header;
}


sub html_footer {
  $time->{end} = time;
  $time->{elapsed} = $time->{end} - $time->{start};

  print $BacktoDiary;
  
  print qq(
<!-- elapsed time: $time->{elapsed} -->
<hr>
	<div align="right">
	Powered by HNS Title List-$version, 
	<a href="http://www.h14m.org/">HyperNikkiSystem Project</a>
	</div>
</body>
</html>
);
}


sub getFileList ($) {
  my $dir = $_[0];
  my @files;

  if ($arg =~ /(\d{6})([abc])$/) { # 199910a
    foreach ({'a'=>1, 'b'=>11, 'c'=>21}->{$2} ..
	     {'a'=>10, 'b'=>20, 'c'=>31}->{$2}) {
      $file = sprintf("d%06d%02d.hnf", $1, $_);
      push(@files, $file) if (stat("$dir/$file"));
    }
  } else {
    opendir DIR, $dir or die "can't open directory: $!";
    @files = grep /^d$arg\d{0,4}.hnf$/, readdir DIR;	# Y10K
    closedir DIR;
  }

  push @filelist, @files;

  foreach $file (@files) {
    $filedir{$file} = $dir;
  }
}


sub readHnf ($) {
  my $hnf = $_[0];
  @hnfs = undef;
  my $ok = 0;
  my $err = 0;

  $hnf_ = $filedir{$hnf} . "/" . $hnf; 
  if ($NKF_USE) {
    open (HNF, "$NKF -emXZ1 $hnf_ |") || die "can't open hnf: $!";
    while (<HNF>) {
      if ($ok) {  # hnf body
          push (@hnfs, $_);
      } 
      else {  # head part
        if (/^OK$/) {  # line 'OK'
          $ok = 1;
        } 
        elsif (/^([A-Z]+)\s(.*)$/) {  # User Variable
          ;
        }
        else {  # illegal hnf header
          $err = 1;
        }
      }
    }
  }
  else {
    open (HNF, $hnf_) || die "can't open hnf: $!";
    while (<HNF>) {
      #&jcode::convert(\$_, 'euc');
      CodeConv::toeuc(*_);

      if ($ok) {  # hnf body 
          push (@hnfs, $_);
      } 
      else {  # head part
        if (/^OK$/) {  # line 'OK'
          $ok = 1;
        } 
        elsif (/^([A-Z]+)\s(.*)$/) {  # User Variable
          ;
        } 
        else {  # illegal hnf header
          $err = 1;
        }
      }
    }
  }
  close(HNF);
  @hnfs = undef unless ($ok);
  @hnfs = undef if ($err);
}


sub getNew (@) {
  my @hnfs = @_;
  my ($i, %TITLE, $linkHi, $link, $date, @cat, @catSub, $cat);

  $date = $link = $linkHi = $file;
  $link =~ s/d(\d{8}).hnf/$1/;
  $date =~ s/d(\d.*)(\d\d)(\d\d).hnf/$1\/$2\/$3/;
  $linkHi = $1 . $2 . ($3 <= 10 ? 'a' : $3 <= 20 ? 'b' : 'c');

  $i = 1;		# NEW counter
  $j = 1;		# SUB counter
  $grpCount = 0;	# GRP counter
  $tmpnewCount = 0;	# tmp NEW counter

  my $non_member = 0;	# 1 or 2 -> non member of the group
			# so that no display 

  my $status = new HNS::Status;
  my $id = $status->id;
  my $in_grp = 0;	# 0 -> not in GRP

  my $mark;		# for hiding GRP section number

  foreach (@hnfs) {
    # convert to entity reference
    s/&/&amp;/g;
    s/>/&gt;/g;
    s/</&lt;/g;

    if (/^GRP (.*)/) {
	my @grp = split (" ", $1);

	$in_grp = 1;
	unless ($i =~ /^G/) {
	    $tmpnewCount = $i;
	}
	$grpCount++;
	$i = "G" . $grpCount;
	$mark = $HNS::Hnf::Command::GRP::Mark;

        unless (defined %GRP_DB){
            tie %GRP_DB, 'SimpleDB::Hash',
                "$HNS::System::DiaryDir/conf/group.txt", 1;
        }
        foreach my $grp (@grp) {
	    my $is_grp_member = 0; 
            if ($GRP_DB{$grp} =~ /$id/) {
                $is_grp_member = 1;
            }
	    if ($is_grp_member) {
		$non_member = 0;
	    }
	    else {
		$non_member = 1;
	    }
        }
    }

    if (/^CAT (.*)/) {
      @cat = split(' ', $1);
    }

    if (defined(@cat)) {
      if (/^(LNEW|NEW|RLNEW)\s(.*)/) {
	my $cmd = $1;
	my $cmd_arg = $2;
	my $a_start = "";
	my $a_end = "";

	if ($cmd eq "LNEW") {
	    if ($cmd_arg =~ /(.*?) (.*)/) {
		$a_start = qq(<a href="$1">);
		$a_end = qq(</a>);
		$cmd_arg = $2;
	    }
	}
        if ($cmd eq "RLNEW") {
            if ($cmd_arg =~ /(.*?) (.*?) (.*)/) {
		unless (defined %RLINK_DB){
		    tie %RLINK_DB, 'SimpleDB::Hash',
			"$HNS::System::DiaryDir/conf/rlink.txt", 1;
		}
                $a_start = qq(<a href="%RLINK_DB{$1}$2">);
                $a_end = qq(</a>);
                $cmd_arg = $3;
            }
        }

	$non_member = 0 if $non_member > 1;
	if ($in_grp > 1) {
	    $i = $mark = $tmpnewCount;
	    $in_grp = 0;
	}
	$mark = $i if $in_grp == 0;

	my $cat_link = "";

	foreach $cat (@cat) {
	  push (@{$CAT{$cat}},
            qq(<a href="$MyDiaryURI?$linkHi#$link$i">$date#$mark</a>: 
		$NewStart$a_start$cmd_arg$a_end$NewEnd\n))
	    unless $non_member;

	  $enc_cat = $cat;
	  $enc_cat =~ s/([^a-zA-Z0-9~\-\_\.\/\:\%])/
		sprintf("%%%02X",ord($1))/ge;
	  $cat_link .= qq([<a href="title.cgi?$arg&CAT=$enc_cat">$cat</a>]);
	}
        @catSub = @cat;
        undef(@cat);

        push (@NEW, 
	    qq(<a href="$MyDiaryURI?$linkHi#$link$i">$date#$mark</a>: 
		$NewStart$cat_link $a_start$cmd_arg$a_end$NewEnd\n))
	    unless $non_member;
        $i++;
        $j = 1;
	$non_member++ if $non_member;
	$in_grp++ if $in_grp;
      } 
    }
    else {
      if (/^(LNEW|NEW|RLNEW)\s(.*)/) {
        my $cmd = $1;
        my $cmd_arg = $2;
        my $a_start = "";
        my $a_end = "";

        if ($cmd eq "LNEW") {
            if ($cmd_arg =~ /(.*?) (.*)/) {
                $a_start = qq(<a href="$1">);
                $a_end = qq(</a>);
                $cmd_arg = $2;
            }
        }
        if ($cmd eq "RLNEW") {
            if ($cmd_arg =~ /(.*?) (.*?) (.*)/) {
                unless (defined %RLINK_DB){
                    tie %RLINK_DB, 'SimpleDB::Hash',
                        "$HNS::System::DiaryDir/conf/rlink.txt", 1;
                }
                $a_start = qq(<a href="%RLINK_DB{$1}$2">);
                $a_end = qq(</a>);
                $cmd_arg = $3;
            }
        }

	$non_member = 0 if $non_member > 1;
        if ($in_grp > 1) {
            $i = $mark = $tmpnewCount;
            $in_grp = 0;
        }
        $mark = $i if $in_grp == 0;

        push (@NEW,
            qq(<a href="$MyDiaryURI?$linkHi#$link$i">$date#$mark</a>:
                $NewStart$a_start$cmd_arg$a_end$NewEnd\n))
            unless $non_member;

        undef(@catSub);
        $i++;
        $j = 1;
	$non_member++ if $non_member;
	$in_grp++ if $in_grp;
      }
    }

    if (defined(@catSub)) {
      if (/^(LSUB|SUB|RLSUB)\s(.*)/) {
        my $cmd = $1;
        my $cmd_arg = $2;
        my $a_start = "";
        my $a_end = "";

        if ($cmd eq "LSUB") {
            if ($cmd_arg =~ /(.*?) (.*)/) {
                $a_start = qq(<a href="$1">);
                $a_end = qq(</a>);
                $cmd_arg = $2;
            }
        }
        if ($cmd eq "RLSUB") {
            if ($cmd_arg =~ /(.*?) (.*?) (.*)/) {
                unless (defined %RLINK_DB){
                    tie %RLINK_DB, 'SimpleDB::Hash',
                        "$HNS::System::DiaryDir/conf/rlink.txt", 1;
                }
                $a_start = qq(<a href="%RLINK_DB{$1}$2">);
                $a_end = qq(</a>);
                $cmd_arg = $3;
            }
        }

        if ($i =~ /^G/) {
	    $i = "G" . $grpCount;
	}
	else {
	    $i--;
	}

        foreach $cat (@catSub) {
          push (@{$CAT{$cat}},
            qq(... <a href="$MyDiaryURI?$linkHi#$link${i}S$j">$SubMark</a> 
		$SubStart$a_start$cmd_arg$a_end$SubEnd\n))
	    unless $non_member;
        }
        push (@NEW, 
	  qq(... <a href="$MyDiaryURI?$linkHi#$link${i}S$j">$SubMark</a> 
		$SubStart$a_start$cmd_arg$a_end$SubEnd\n))
	  unless $non_member;
        $j++;
        $i++;
      }
    } else {
      if (/^(LSUB|SUB|RLSUB)\s(.*)/) {
        my $cmd = $1;
        my $cmd_arg = $2;
        my $a_start = "";
        my $a_end = "";

        if ($cmd eq "LSUB") {
            if ($cmd_arg =~ /(.*?) (.*)/) {
                $a_start = qq(<a href="$1">);
                $a_end = qq(</a>);
                $cmd_arg = $2;
            }
        }
        if ($cmd eq "RLSUB") {
            if ($cmd_arg =~ /(.*?) (.*?) (.*)/) {
                unless (defined %RLINK_DB){
                    tie %RLINK_DB, 'SimpleDB::Hash',
                        "$HNS::System::DiaryDir/conf/rlink.txt", 1;
                }
                $a_start = qq(<a href="%RLINK_DB{$1}$2">);
                $a_end = qq(</a>);
                $cmd_arg = $3;
            }
        }

        if ($i =~ /^G/) {
            $i = "G" . $grpCount;
        }    
        else {    
            $i--; 
        }

        push (@NEW, 
	  qq(... <a href="$MyDiaryURI?$linkHi#$link${i}S$j">$SubMark</a> 
		$SubStart$a_start$cmd_arg$a_end$SubEnd\n))
	  unless $non_member;
        $j++;
        $i++;
      }
    }
  }
}


sub getTime () {
  $time->{start} = time;

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  $year = $year + 1900;
  $mon  = $mon + 1;
  $mday = "0$mday" if $mday < 10;
  $mon  = "0$mon"  if $mon  < 10;
  $sec  = "0$sec"  if $sec  < 10;
  $min  = "0$min"  if $min  < 10;
  $hour = "0$hour" if $min  < 10;
}


sub readCatFile () {
  if (-f $catFile) {
    if ($NKF_USE) {
      open (FILE, "$NKF -emXZ1 $catFile |") || die "can't open $catFile: $!";
      @tmp = <FILE>;
    }
    else {
      open(FILE, "$catFile") || die "Can't Open File: $catFile: $!";
      while (<FILE>) {
        #&jcode::convert(\$_, 'euc');
	CodeConv::toeuc(*_);
        push (@tmp, $_);
      }
    }
    close(FILE);
  }
  foreach (@tmp) {
    if ($_ =~ /(\S+) (\S+)(.*)/) {
      $cats{$1} = $2;
    }
  }
}

