#!/usr/bin/perl

push @INC, ".";

use strict;

use Encode;
use Encode::JP;

# use encoding "shiftjis";

use CGI;
use Diary;
use Data::Dumper;

sub date_str {

    my $t = shift || time;
    my @t = (gmtime($t))[5,4,3,2,1,0];
    $t[0] += 1900;
    $t++;

    sprintf "%04d-%02d-%02dT%02d:%02d:%02d+00:00", @t;

}

sub parse_pathinfo {

    my $info = $ENV{PATH_INFO};

    my @info = split /\//, $info;
    shift @info;
    return undef if (scalar @info < 1);

    $info[0] = -1 if ($info[-1] !~ /\.html$/);

    $info[-1] =~ s/(\d+)\.html/$1/;
    $info[0] = -1 if ($info[0] < 1999 );
    $info[0] = -1 if ($info[1] < 1 or $info[1] > 12);
    $info[1] = sprintf "%02d", $info[1] if ($info[1]);
    $info[2] = sprintf "%02d", $info[2] if ($info[2]);
    $info[3] = sprintf "%03d", $info[3] if ($info[3]);

    @info = (@info, '', '', '', '')[0..3];

    \@info;

}

sub parse_query {

    my $query_string = <STDIN>;
    $query_string = Encode::encode('shiftjis', $query_string);

    my $query;
    foreach (split /&/, $query_string) {
	my ($key, $val) = split /=/, $_, 2;
	$key =~ tr/A-Z/a-z/;
	$query->{$key} = $val;
    }

    my ($test, $kanji) = ( substr($query->{kanji}, 1, 2), 'jis');
    $test =~ tr/A-F/a-f/;

    if ( $test eq 'b4' ) {
        $kanji = 'euc-jp';
    } elsif ( $test eq '8a' ) {
        $kanji = 'shiftjis';
    } elsif ( $test eq 'e6' ) {
        $kanji = 'utf-8';
    }


    foreach( qw / name comment password auth_code target/ ) {
        $query->{$_} =~ tr/+/ /;
        $query->{$_} =~ s/%([0-9a-f][0-9a-f])/pack("C", hex($1))/egio;
	$query->{$_} = Encode::decode($kanji, $query->{$_});
    }

    $query;


}

sub parse_search {

    my $referrer = $ENV{HTTP_REFERER};
    my @query;

    return \@query;

    $referrer =~ /\?(.+)$/;
    my $query_string = $1;


    if ( $referrer =~ /\.google\.com\/search/ ) {
	$query_string = (
	    grep { /^q=/ }
	    split /&/, $query_string
	)[0];
	$query_string =~ s/^q=//;
	$query_string =~ s/%([0-9a-f][0-9a-f])/pack("C", hex($1))/egio;
	@query = 
	    map {
	    	Encode::decode('utf8', $_);
            }
	    split /\+/, $query_string;

    }

    \@query;

}

sub parse_ref {

    my $info = shift;
    my $diary = shift;

    return if ($ENV{'REQUEST_METHOD'} eq 'HEAD' );

    my $id = sprintf "%04d/%02d/%02d-%03d", @$info;

    my $file;
    if ( $info->[0] < 1 ) {
        my @date = (localtime)[5,4,3];
	$date[0] += 1900;
	$date[1]++;
        $file = sprintf "%s/access/%04d%02d%02d.cnt",
	    $diary->entry,
            @date;
    } else {
        $file = sprintf "%s/%04d%02d/%04d%02d%02d-%03d.cnt",
            $diary->entry,
            (@$info)[0,1],
            @$info;
    }
    
    my $FH;
    open $FH, ">>$file";
    printf $FH sprintf "%d\t%s\t%s\t%s\t%s\n", time, $ENV{'REQUEST_METHOD'}, $ENV{REMOTE_ADDR}, $id, scalar localtime ;
    close $FH;

    return undef  unless ($ENV{HTTP_REFERER});
    return undef if ( $ENV{HTTP_REFERER} =~ /^https?:\/\/ryuchi\.bsddiary\.org\/diary/ );
#    return undef if ( $ENV{HTTP_REFERER} =~ /^https?:\/\/.+?\.bsdclub\.org\// );

    $file =~ s/cnt$/ref/;

    open $FH, "$file";
    my ($last_ref, $last_addr)  = (split /\t/, (<$FH>)[-1])[1,2];
    close $FH;

    return undef if (($last_ref eq $ENV{HTTP_REFERER}) and ($last_addr eq $ENV{REMOTE_ADDR}));

    open $FH, ">>$file";
    printf $FH "%d\t%s\t%s\t%s\t%s\n", time, $ENV{HTTP_REFERER}, $ENV{REMOTE_ADDR}, $id, scalar localtime;
    close $FH;

    return;

}


sub post_comment {

    my $query = shift;
    my $info  = shift;
    my $diary = shift;
    my @result;

    my $file = sprintf "%s/%04d%02d/%04d%02d%02d-%03d",
                  $diary->entry,
                  (@$info)[0..1],
                  @$info;


    my $file2 = sprintf "%s/comment/%04d%02d%02d-%03d",
                  $diary->entry,
                  @$info;

    push @result, Encode::decode( 'shiftjis', 'お名前を入力してください')     if ($query->{name} eq '');
    push @result, Encode::decode( 'shiftjis', 'コメント文を入力してください') if ($query->{comment} eq '');
    push @result, Encode::decode( 'shiftjis', '認証コードが違います' )        if ($query->{password} ne $query->{auth_code});
    push @result, '不正と思われるアクセスです。アクセス手順を確認してください。' if (scalar @$info < 4);
    push @result, Encode::decode( 'shiftjis', 'コメントの書き込み先が存在しません')    if (! -f "$file.txt" );

    map {
    	$query->{$_} =~ s/&/&amp;/g;
	$query->{$_} =~ s/</&lt;/g;
	$query->{$_} =~ s/>/&gt;/g;
	$query->{$_} =~ s/"/&quot;/g;
    } qw / name comment /;

    $query->{comment_cook} = [
        grep { $_ }
        map { tr/\r//d; $_ }
        split /\s*\n\s*/, $query->{comment}
    ];

    if (scalar @result > 0) {

        $file2 =~ s/comment/error/;
	open my $FH, ">>:encoding(shiftjis)", "$file2.comment";
        print $FH Dumper( $query, \%ENV );
        print $FH '=' x 60;
        print $FH "\n";
	close $FH;

	return \@result;
    }

    open my $FH, ">>:encoding(shiftjis)", "$file.comment";
    printf $FH "<DT>%s : %s\n<DD>%s\n", $query->{name}, scalar localtime, join ( "<br>\n", @{$query->{comment_cook}});
    close $FH;

    open my $FH, ">>$file2.comment";
    close $FH;

    return undef;

}

my $diary = new Diary;
my $info  = parse_pathinfo;

my $query;

if ($ENV{REQUEST_METHOD} eq 'POST') {

    $query = parse_query;
    my $result = post_comment($query, $info, $diary);
    if ($result) {
       $query->{error} = join '<br>', @$result;
    } else {
       $query = {};
    }
    
}

my $search = parse_search;
my $navi = $diary->list_navi;

if ($info->[0] < 0 ) {
    $diary->not_found($navi);
    exit;
}

parse_ref $info, $diary;

my $entry = [];
if ( $info->[0] < 1 ) {

    opendir my $DIR, $diary->entry;
    my @ls =
        sort {$b cmp $a }
        grep { !/^\./  }
        readdir  $DIR;
    closedir $DIR;

    foreach (@ls) {
	/(\d{4})(\d{2})/;
	my $info = [ $1, $2, '', '' ]; 
	my $sub_entry = $diary->list_entry({
	    info => $info,
	    entry => $diary->entry,
	    search => $search,
	    config => $diary->config,
	});

	my $left = $diary->config->{maxentrys} - (scalar @$entry);
	if (scalar @$sub_entry >= $left) {
	    push @$entry, (reverse @$sub_entry)[0..($left -1)];
	    last;
	}
	push @$entry, reverse @$sub_entry;
    }


} else {
    $entry = $diary->list_entry({
	info => $info,
	entry => $diary->entry,
	search => $search,
	config => $diary->config,
    });
}

if (scalar @$entry < 1 ) {

    $diary->not_found($navi);
    exit;

}

my $last;
foreach(@$entry) {
    $last = $_->{last_modified} if ($last < $_->{last_modified});
}

my ($html, $ref);
$ref = $diary->list_ref({
    entry => $entry,
    info  => $info,
    config => $diary->config,
});

my $ref_time = shift @$ref;
$last = $ref_time->{time} if ($last < $ref_time->{time});

if ( scalar @$entry == 1 and $info->[3] > 0 ) {

    $html = $diary->one_entry({
	navi  => $navi,
	entry => $entry,
	query => $query,
	search => $search,
	config => $diary->config,
	ref    => $ref,
	last_modified => scalar localtime $last,
    },);
#    $last = 0;

} else {

    $html = $diary->multi_entry({
	navi  => $navi,
	entry => $entry,
	query => $query,
	search => $search,
	config => $diary->config,
	ref    => $ref,
	last_modified => scalar localtime $last,
    },);

}


$html = Encode::encode('shiftjis', $$html);
printf "Content-Type: text/html\n";
#printf "Content-Length: %d\n", length($html);
printf "Last-Modified: %s\n", scalar gmtime($last) if ($last);
printf "\n";

print "$html\n";

# print "<hr>DEBUG<br><pre>\n";
# use Data::Dumper;
# print Encode::encode('shiftjis', Dumper ($ref));

exit;