1package HNS::Tools::Title;
2# $Id: Title.pm,v 1.8 2003/05/28 04:52:58 togawa Exp $
3# Title.pm 2001/5/6 ari@mbf.sphere.ne.jp (Akihiro Arisawa)
4#
5# Copyright (C) 2001 Akihiro Arisawa, HyperNikkiSystem Project
6# All rights reserved.
7#
8# This is free software with ABSOLUTELY NO WARRANTY.
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either versions 2, or (at your option)
13# any later version.
14######################################################################
15
16use strict vars;
17use SimpleDB::Hash;
18use DateTime::Date;
19use CodeConv;
20use HNS::Status;
21use HNS::Hnf::Command;
22use HNS::Diary::Template;
23use ObjectTemplate;
24use CGI::Tools;
25
26use vars qw(@ISA);
27use vars qw($Range);
28use vars qw($CatTemplate $CatLinkTemplate $HeadTitle $Header $BacktoDiary
29	    %CatTemplate %CatLinkTemplate %HeadTitle %Header %BacktoDiary);
30use vars qw($NKF $NKF_USE);
31use vars qw($Version);
32
33@ISA = qw(HNS::Diary::Template ObjectTemplate);
34attributes qw(arg mode files title cat_title start_time);
35
36# customizable variables at config.ph.
37$Range = 3;
38
39require './config.ph';
40
41# customizable variables at theme.ph
42$CatTemplate = qq(<h3>%img<a href="title.cgi?%{arg}CAT=%enc_var">%var</a></h3>\n);
43$CatLinkTemplate = qq([<a href="title.cgi?%{arg}CAT=%enc_var">%var</a>]);
44
45$HeadTitle = qq(<title>$HNS::System::Title Title List</title>\n);
46$Header = qq(<h1><a href="$HNS::System::MyDiaryURI">$HNS::System::Title</a> Title List</h1>\n);
47$BacktoDiary =
48        qq(<div align="right"><a href="$HNS::System::MyDiaryURI">Back to Diary</a></div>\n);
49
50################################################################
51# global variables
52my @Selected;
53my %Selected;
54my %GRP_DB;
55
56sub initialize($)
57{
58    my $self = shift;
59
60    $self->start_time(time());
61    $self->files({});
62}
63
64sub main ($) {
65    my $self = shift;
66
67    $self->getArg();
68    $self->html_header();
69    $self->getFileList();
70
71    my %files = %{$self->files};
72    foreach (($self->mode ne 'recent' && $HNS::System::AlwaysReverse eq "OFF")
73	     ? sort keys(%files) : reverse sort keys(%files)) {
74	$self->readHnf($_, 'title');
75    }
76
77    $self->html_body();
78    $self->html_footer();
79}
80
81sub getArg () {
82    my $self = shift;
83    my $method = $ENV{'REQUEST_METHOD'};
84    my $query;
85    my $arg;
86
87    if ($method eq 'GET' || $method eq 'HEAD') {
88	$query = $ENV{'QUERY_STRING'};
89    } elsif ($method eq 'POST') {
90	read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
91    } else {
92	$query = join('&', @ARGV);
93    }
94
95    foreach (split('&', $query)) {
96	my ($key, $value) = split("=");
97	if (defined($value)) {
98	    if ($value eq "ALL") {
99		$Selected{$key}->[0] = "ALL";
100	    } else {
101		push(@{$Selected{$key}}, $value);
102	    }
103	    $arg .= "$_&" if ($key ne "CAT");
104	} else {
105	    if ($key =~ /^(\d{4})/) {
106		push(@Selected, $key);
107		$arg .= "$key&";
108	    }
109	}
110    }
111    $self->arg($arg);
112}
113
114
115sub html_header($) {
116    my $self = shift;
117
118    if ($HNS::Status->mode ne 'static') {
119	print qq(Content-Type: text/html; charset=EUC-JP\r\n\r\n);
120    }
121
122    print $HNS::ExtHTML::DOCTYPE;
123    if ($HNS::System::Lang) {
124	print qq(<html lang="$HNS::System::Lang">\n<head>\n);
125    } else {
126	print qq(<html>\n<head>\n);
127    }
128
129    print qq(<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP">\n);
130
131    print SelectTemplate($HNS::ExtHTML::Head, %HNS::ExtHTML::Head);
132#    print SelectTemplate($HeadTitle, %HeadTitle);
133    print $self->get_template_variable('HeadTitle');
134
135    print qq(</head>\n\n);
136    print qq(<body $HNS::ExtHTML::BodyVal>\n);
137
138    print $self->get_template_variable('Header');
139}
140
141
142sub html_footer($) {
143    my $self = shift;
144    my $elapse_time = time() - $self->start_time;
145
146    print $self->get_template_variable('BacktoDiary');
147
148    print qq(
149<!-- elapsed time: $elapse_time -->
150<hr>
151	<div align="right">
152	Powered by HNS Title List-$Version,
153	<a href="http://www.h14m.org/">HyperNikkiSystem Project</a>
154	</div>
155</body>
156</html>
157);
158}
159
160
161sub getFileList($;$) {
162    my ($self, $num) = @_;
163
164    $self->mode('recent');
165
166    if (defined(@Selected)) { # ?2001, ?200105, ?2001050, ?200105a
167	$self->mode(undef);
168
169	foreach my $selected (@Selected) {
170	    $self->getFileListByPattern($self->diaryDir(substr($selected, 0, 4)),
171					$selected);
172	}
173    }
174
175    if (defined($Selected{YEAR})) { # YEAR=2001&MONTH=5
176	my %pat;
177
178	$self->mode(undef);
179
180	foreach my $year (@{$Selected{YEAR}}) {
181	    my $dir = $self->diaryDir($year);
182	    $pat{year} = $year;
183	    if (defined($Selected{MONTH}) && $Selected{MONTH}->[0] ne "ALL") {
184		foreach my $month (@{$Selected{MONTH}}) {
185		    $pat{month} = $pat{year} . sprintf("%02d", $month);
186		    if (defined($Selected{DAY}) &&
187			$Selected{DAY}->[0] ne "ALL") {
188			foreach my $day (@{$Selected{DAY}}) {
189			    $pat{day} = $pat{month} . $day;
190			    $self->getFileListByPattern($dir, $pat{day});
191			}
192		    } else {
193			$self->getFileListByPattern($dir, $pat{month});
194		    }
195		}
196	    } else {
197		$self->getFileListByPattern($dir, $pat{year});
198	    }
199	}
200    }
201
202    if ($self->mode eq 'recent') { # Recent
203	my $date = $HNS::Status->start_time;
204	if ($num) {
205	    while ($date->year >= $HNS::System::StartYear &&
206		   keys %{$self->files} < $num) {
207		$self->getFileListByPattern($self->diaryDir($date->year),
208					    $date->year);
209		$date -= '1Y';
210	    }
211	} else {
212	    if ($Range < 0) {
213		$Range = $Range * -1 + 1;
214		$date += $Range-1 . 'M';
215	    }
216	    foreach (1 .. $Range) {
217		last if ($date->year < $HNS::System::StartYear);
218		$self->getFileListByPattern($self->diaryDir($date->year),
219					    $date->year . sprintf("%02d", $date->month));
220		$date -= '1M';
221	    }
222	}
223    }
224}
225
226sub getFileListByPattern($$$) {
227    my ($self, $dir, $pat) = @_;
228    my @files;
229    my %files = %{$self->files};
230
231    $pat =~ s/[abc]$/{'a' => '(0\d|10)',
232		      'b' => '(11|12|13|14|15|16|17|18|19|20)',
233		      'c' => '(21|22|23|24|25|26|27|28|29|30|31)'}->{$&}/e;
234    opendir DIR, $dir or die "can't open directory: $!";
235    @files = grep /^d$pat\d{0,4}.hnf$/, readdir DIR;    # Y10K
236    closedir DIR;
237    foreach (@files) {
238	$files{$_} = "$dir/$_";
239    }
240    $self->files(\%files);
241}
242
243sub diaryDir($$) {
244    my ($self, $year) = @_;;
245
246    if (-d $HNS::System::DiaryDir . "/" . $year) {
247	$HNS::System::DiaryDir . "/" . $year;
248    } else {
249	$HNS::System::DiaryDir;
250    }
251}
252
253sub readHnf ($$;$) {
254    my ($self, $hnf, $cache_suffix) = @_;
255
256    if ($HNS::System::Caching && $cache_suffix) {
257	$hnf =~ /d((\d+)\d{4})\.hnf$/;
258	my $cache = "$HNS::System::CacheDir/$2/$1.$cache_suffix";
259	my $lm = (stat($self->files->{$hnf}))[9];
260	if (-e $cache && $lm == (stat($cache))[9]) { # use cache
261	    my @new = @{$self->title};
262	    my %cat = %{$self->cat_title};
263	    open(CACHE, $cache);
264	    while (<CACHE>) {
265		if (/^<!-- CAT:(.*?) -->/) {
266		    push(@{$cat{$1}}, $');
267		} else {
268		    push(@new, $_);
269		}
270	    }
271	    close(CACHE);
272	    $self->title(\@new);
273	    $self->cat_title(\%cat);
274	} else { # generate cache
275	    mkdir "$HNS::System::CacheDir/$2", 0755
276	      unless (-d "$HNS::System::CacheDir/$2");
277	    my @new = @{$self->title}; $self->title([]);
278	    my %cat = %{$self->cat_title}; $self->cat_title({});
279	    $self->readHnf1($hnf);
280	    open(CACHE, "> $cache");
281	    foreach (@{$self->title}) {
282		push(@new, $_);
283		print CACHE "$_\n";
284	    }
285	    foreach my $cat (keys %{$self->cat_title}) {
286		foreach (@{$self->cat_title->{$cat}}) {
287		    push(@{$cat{$cat}}, $_);
288		    print CACHE "<!-- CAT:$cat -->$_\n";
289		}
290	    }
291	    close(CACHE);
292	    utime($lm, $lm, $cache);
293	    $self->title(\@new);
294	    $self->cat_title(\%cat);
295	}
296    } else {
297	$self->readHnf1($hnf);
298    }
299}
300
301sub readHnf1($$) {
302    my ($self, $hnf) = @_;
303    my ($ok, $newCount, $subCount);
304    my (@hnf, $text);
305    $hnf =~ /d(\d+)(\d\d)(\d\d)\.hnf/;
306    my $params = { year => $1, month => $2, day => $3, high => int($3/10),
307		   abc => ($3 <= 10 ? 'a' : $3 <= 20 ? 'b' : 'c'),
308		   arg => $self->arg};
309
310    if ($NKF_USE) {
311	open (HNF, "$NKF -emXZ1 $self->files->{$hnf} |") || die "can't open hnf: $!";
312    } else {
313	open (HNF, $self->files->{$hnf}) || die "can't open hnf: $!";
314    }
315    while (<HNF>) {
316	s/\r?\n?$//;
317
318	if (! $ok) { # hnf header
319	    if (/^OK$/) {  # line 'OK'
320		$ok = 1;
321	    } elsif (/^([A-Z]+)\s/) {  # User Variable
322		;
323	    } else {  # illegal hnf header
324		last;
325	    }
326	} else { # hnf body
327	    CodeConv::toeuc(\$_) unless ($NKF_USE);
328
329	    # convert to entity reference
330	    s/&/&amp;/g;
331	    s/>/&gt;/g;
332	    s/</&lt;/g;
333
334	    if (/^(GRP|CAT|NEW|LNEW|RLNEW) ?/) {
335		if ($1 eq "GRP") {
336		    $hnf[$newCount]->{grp} = $';
337		} elsif ($1 eq "CAT") {
338		    $hnf[$newCount]->{cat} = $';
339		} else {
340		    $hnf[$newCount]->{new} = $_;
341		    $text = \@{$hnf[$newCount]->{text}};
342		    $newCount++;
343		    $subCount = 0;
344		}
345	    } elsif (/^(SUB|LSUB|RLSUB)/) {
346		$hnf[$newCount-1]->{sub}->[$subCount]->[0] = $_;
347		$text = \@{$hnf[$newCount-1]->{sub}->[$subCount]};
348		$subCount++;
349	    } else {
350		push(@{$text}, $_);
351	    }
352	}
353    }
354    close(HNF);
355
356    $self->Parse($params, @hnf);
357}
358
359sub Parse($$@) {
360    my ($self, $params, @hnf) = @_;
361    my ($grpCount, $newCount, $subCount);
362    my $templ = new HNS::Template;
363    my $id;
364
365    my $newHtml = new HNS::Tools::Title::New;
366    my $subHtml = new HNS::Tools::Title::Sub;
367
368    my @new = @{$self->title};
369    my %cat = %{$self->cat_title};
370
371    foreach my $new (@hnf) {
372	my $cat_link;
373	my $grp;
374	if ($new->{grp}) {
375	    $grpCount++;
376	    $params->{new} = "G" . $grpCount;
377	    $params->{mark} = $HNS::Hnf::Command::GRP::Mark;
378	    $grp = "<!-- GRP:" . $new->{grp} . " -->";
379	} else {
380	    $newCount++;
381	    $params->{new} = $newCount;
382	    $params->{mark} = $newCount;
383	    $grp = "";
384	}
385	if ($new->{new} =~ /^NEW ?/) {
386	    $params->{content} = $';
387	} elsif ($new->{new} =~ /^LNEW /) {
388	    $params->{content} = $newHtml->ConvUrl($');
389	} elsif ($new->{new} =~ /^RLNEW /) {
390	    $params->{content} = $newHtml->ConvRlink($');
391	}
392	$params->{cat_link} = $cat_link;
393
394	if ($new->{cat}) {
395	    my $html = $grp . $newHtml->AsHTML($templ, $params);
396	    foreach my $cat (split(' ', $new->{cat})) {
397		push(@{$cat{$cat}}, $html);
398
399		$params->{var} = $params->{enc_var} = $cat;
400		$params->{enc_var} =~ s/([^a-zA-Z0-9~\-\_\.\/\:\%])/
401		  sprintf("%%%02X",ord($1))/ge;
402		# fix Cross Site Scripting bug
403		$params->{enc_var} = CGI::Tools::Escape($params->{enc_var});
404		$cat_link .=
405		  $templ->Expand(SelectTemplate($CatLinkTemplate,
406						%CatLinkTemplate),
407				 $params);
408	    }
409	}
410	$params->{cat_link} = $cat_link;
411	push(@new, $grp . $newHtml->AsHTML($templ, $params));
412
413	my $subCount;
414	foreach my $sub (@{$new->{sub}}) {
415	    $params->{sub} = ++$subCount;
416	    if ($sub->[0] =~ /^SUB ?/) {
417		$params->{content} = $';
418	    } elsif ($sub->[0] =~ /^LSUB /) {
419		$params->{content} = $subHtml->ConvUrl($');
420	    } elsif ($sub->[0] =~ /^RLSUB /) {
421		$params->{content} = $subHtml->ConvRlink($');
422	    }
423
424	    my $html = $grp . $subHtml->AsHTML($templ, $params);
425	    if ($new->{cat}) {
426		foreach my $cat (split(' ', $new->{cat})) {
427		    push(@{$cat{$cat}}, $html);
428		}
429	    }
430	    push(@new, $html);
431	}
432    }
433
434    $self->title(\@new);
435    $self->cat_title(\%cat);
436}
437
438sub html_body($) {
439    my $self = shift;
440    my $templ = new HNS::Template;
441    my %CAT_DB;
442    my %selected_cat;
443    my %cat = %{$self->cat_title};
444    my @new = @{$self->title};
445
446    if ($Selected{CAT}->[0] eq "ALL") {
447	foreach (keys %cat) {
448	    my $enc_cat = $_;
449	    $enc_cat =~ s/([^a-zA-Z0-9~\-\_\.\/\:\%])/sprintf("%%%02X",ord($1))/ge;
450	    # fix Cross Site Scripting bug
451	    $enc_cat = CGI::Tools::Escape($enc_cat);
452	    $selected_cat{$_} = $enc_cat;
453	}
454    } else {
455	foreach (@{$Selected{CAT}}) {
456	    my $cat = $_;
457	    $cat =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/ge;
458	    $cat = CGI::Tools::Escape($cat);	# fix Cross Site Scripting bug
459	    $selected_cat{$cat} = $_;
460	}
461    }
462
463    if (defined(%selected_cat)) {
464	tie %CAT_DB, 'SimpleDB::Hash', "$HNS::CategoryList::CatDir/cat.txt";
465	foreach my $cat (keys(%selected_cat)) {
466	    # fix Cross Site Scripting bug
467	    $cat = CGI::Tools::Escape($cat);
468	    $self->arg(CGI::Tools::Escape($self->arg));
469
470	    $templ->SetParamValues('var' => $cat);
471	    $templ->SetParamValues('enc_var' => $selected_cat{$cat});
472	    $templ->SetParamValues('arg' => $self->arg);
473	    my $img = "$HNS::CategoryList::CatDir/$CAT_DB{$cat}";
474	    $templ->SetParamValues('img' => -f $img ?
475				   qq(<img src="$img" alt="$cat">) : "");
476	    print $templ->Expand(SelectTemplate($CatTemplate, %CatTemplate));
477
478	    foreach my $title (@{$cat{$cat}}) {
479		next unless ($self->check_grp($title));
480		print "$title<br>\n";
481	    }
482	}
483    } else {
484	foreach my $title (@new) {
485	    next unless ($self->check_grp($title));
486	    print "$title<br>\n";
487	}
488    }
489}
490
491sub check_grp($$) {
492    my ($self, $content) = @_;
493
494    if ($content =~ /^<!-- GRP:(.*) -->/) {
495	unless (defined %GRP_DB) {
496	    tie %GRP_DB, 'SimpleDB::Hash',
497	      "$HNS::System::DiaryDir/conf/group.txt", 1;
498	}
499	my $id = $HNS::Status->id;
500	$id = "XXXXXXXXXXXXXXXXX" if length($id) < 17;
501
502	foreach my $grp (split(' ', $1)) {
503	    if ($grp =~ s/^!//) {   # reversed GRP
504                unless ($GRP_DB{$grp} =~ /$id/) {
505                    return 1;
506		}
507	    }
508            else {	# normal GRP
509	        if ($GRP_DB{$grp} =~ /$id/) {
510		    return 1;
511	        }
512	    }
513	}
514	return 0;
515    } else {
516	return 1;
517    }
518}
519
520package HNS::Tools::Title::Hnf;
521require HNS::Diary::Template;
522use vars qw(@ISA);
523use vars qw($BaseTemplate $NameTemplate $HrefTemplate
524	    %BaseTemplate %NameTemplate %HrefTemplate); # HNS::Diary::Template
525use vars qw($Template %Template);
526@ISA = qw(HNS::Diary::Template);
527
528$BaseTemplate = "$HNS::System::MyDiaryURI?%year%month%abc";
529$HrefTemplate = "%base#%name";
530my %RLINK_DB;
531
532sub new($)
533{
534    my $class = shift;
535    my $self = {};
536    bless $self, $class;
537    return $self;
538}
539
540sub DESTROY($)
541{
542}
543
544sub ConvUrl($$)
545{
546    my $self = shift;
547    my ($tmp, $cmd_arg) = split(' ', shift, 2);
548    my $ConvUrl = new HNS::Hnf::Command::ConvUrl;
549
550    $ConvUrl->ConvUrl(\$tmp);
551    qq(<a href="$tmp">$cmd_arg</a>);
552}
553
554sub ConvRlink($$)
555{
556    my $self = shift;
557    my ($rlink, $add, $cmd_arg) = split(' ', shift, 3);
558
559    unless (defined %RLINK_DB){
560	tie %RLINK_DB, 'SimpleDB::Hash',
561	  "$HNS::System::DiaryDir/conf/rlink.txt", 1;
562    }
563    qq(<a href="$RLINK_DB{$rlink}$add">$cmd_arg</a>);
564}
565
566sub AsHTML ($$$)
567{
568	my ($self, $templ, $params) = @_;
569	$self->ExpandTempl($templ, $params);
570	$templ->Expand($self->get_template_variable('Template'), $params);
571}
572
573package HNS::Tools::Title::New;
574use HNS::Diary::Template;
575use vars qw(@ISA);
576@ISA = qw(HNS::Tools::Title::Hnf);
577use vars qw($BaseTemplate $NameTemplate $HrefTemplate
578	    %BaseTemplate %NameTemplate %HrefTemplate); # HNS::Diary::Template
579use vars qw($Template %Template);
580$NameTemplate = "%year%month%day%new";
581$Template = qq(<a href="%href">%year/%month/%day#%mark</a>: %cat_link %content);
582
583package HNS::Tools::Title::Sub;
584use HNS::Diary::Template;
585use vars qw(@ISA);
586@ISA = qw(HNS::Tools::Title::Hnf);
587use vars qw($BaseTemplate $NameTemplate $HrefTemplate
588	    %BaseTemplate %NameTemplate %HrefTemplate); # HNS::Diary::Template
589use vars qw($Template %Template);
590$NameTemplate = "%year%month%day%{new}S%sub";
591$Template = qq(... <a href="%href">��</a> %content);
592
5931;
594