#! /usr/local/bin/perl
use strict;

#=============================================================================
# 
#=============================================================================

# log/       --- 606 (600)
# url.cgi    --- 707 (700)
# url.rdf    --- 606 (606)
# style.css  --- 606 (606)

#### ȥ
my $cgi_title = 'URL MEMO';
#### CGI URL
my $cgi_url   = './url.cgi'; # л
my $cgi_index = 'http://ym2151.ath.cx:8080/url/url.cgi'; # л
#### եݴɾ
my $log_dir     = './log/';
#### CSSե (ȤʤȤ϶)
my $css         = './style.css';
#### 1ڡɽ
my $page_max    = 5;


#---------------------------------------
# RSS
#### RSSե (ȤʤȤ϶)
my $rdf_file    = './index.rdf';


#---------------------------------------

### jcode.plȤȤϥե̾
my $jcode = '';
### Ϻ (1024bytes٤̵?)
my $maxlength = 2048;
### URL (256ʸ٤ܰ¤)
my $maxurllength = 256;

#=============================================================================
# ѹʤ
#=============================================================================







#=============================================================================
# ¾Хѿ
#=============================================================================
my %FORM;
my %nowtime;
my %log_exist;
my @log_files;
my $last_modified_file = $log_dir . 'last_modified';

#=============================================================================
# ᥤ
#=============================================================================
&decode();
&get_nowtime();
&check_form();
&GetExistLogfiles();
&print_header();
if ($ENV{'REQUEST_METHOD'} eq 'post' || $ENV{'REQUEST_METHOD'} eq 'POST') {
	&write_url();
}
&print_log();
&print_footer();
exit;


#=============================================================================
# ɽ
#=============================================================================

#-----------------------------------------------------------
# 顼
sub print_error
{
	my $errmsg = $_[0];
	&print_header();

	print << "_END_";
<P align="center"><B>$errmsg</B></P>
<P align="center"><FORM><INPUT type="button" value="β̤" onclick="history.back();"></FORM></P>
_END_

	&print_footer();
	exit 0;
}

#-----------------------------------------------------------
# إå
sub print_header
{
	my $wwwc = &getwwwc();
	print "Content-type: text/html\n\n";
	print << "_END_";
<HTML>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<META http-equiv="Content-Language" content="ja">
$wwwc
<TITLE>$cgi_title</TITLE>
_END_
	if ($css ne '') {
		print << "_END_";
<LINK rel=StyleSheet href="$css" type="text/css">
_END_
	}
	print << "_END_";
</HEAD>
<BODY>
<h1>$cgi_title</h1>
_END_

	# ƥեФ
	if ($FORM{'mode'} eq 'largeform') {
		print << "_END_";
<form method="post" action="$cgi_url" target="_self">
  <textarea rows="6" cols="80" name="url" wrap="off"></TEXTAREA><br>
  <input type="submit" value="Ƥ">
  <input type="reset" value="ä">&nbsp;&nbsp;&nbsp;&nbsp;(ʣURLϻϲԤǶڤäƤ)<br>
  <input type="hidden" name="mode" value="largeform">
</form>
_END_
	} else {
		print << "_END_";
<form method="post" action="$cgi_url" target="_self">
  <a href="$cgi_url?mode=largeform"></A>
  <input type="text" name="url" size="80" maxlength="256" value="">
  <input type="submit" value="Ƥ">
  <input type="reset" value="ä"><br>
</form>
_END_
	}
	print "<hr>\n";
	return;
}

#-----------------------------------------------------------
# եå
sub print_footer
{
	print << "_END_";
</BODY>
</HTML>
_END_
	return;
}

#-----------------------------------------------------------
# WWWC᥿
sub getwwwc
{
	my $localtime = 0;
	if (-e $last_modified_file) {
		open (IN, "$last_modified_file");
		$localtime = <IN>;
		close (IN);
	}

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($localtime);
	$mon++;
	$year += 1900;
	$year = sprintf("%04d",$year);
	$mon  = sprintf("%02d",$mon);
	$mday = sprintf("%02d",$mday);
	$hour = sprintf("%02d",$hour);
	$min  = sprintf("%02d",$min);
	$sec  = sprintf("%02d",$sec);
	return "<META NAME=\"WWWC\" CONTENT=\"$year/$mon/$mday $hour:$min\">";
}

#-----------------------------------------------------------
# ʬ
sub print_day
{
	my $num = $_[0];
	my $date;
	my ($year, $month, $day);
	my $day_param = 0;
	my @comment;
	my @dailylog;

	$log_files[$num] =~ /$log_dir[0-9]{4}\/([0-9]{4})([0-9]{2})([0-9]{2})/;
	$year = $1;
	$month= $2;
	$day  = $3;
	$date = "$year$month$day";

	open (IN, "$log_files[$num]");
	while (<IN>) {
		push (@dailylog, $_);
	}
	close (IN);

	# դϤ ###################
	print << "_END_";
<dl>
  <dt class="date"><a href="$cgi_url?date=$date" class="date">$year/$month/$day</a></dt>
  <dd class="contents">
_END_

	# 鷺ĽϤ
	$day_param = scalar(@dailylog);
	foreach my $log (@dailylog) {
		chomp($log);
		print << "_END_";
    <a href="view-source:$log" target="_blank">[VS]</A> <a href="$log" target="_blank">$log</A><br>
_END_
		$day_param--;
	}

	print "  </dd>\n</dl>\n<hr>\n";
	return;
}

#-----------------------------------------------------------
# Ϥʬ
sub print_log
{
	my $page_start = 0;
	my $page_last;

	if ($FORM{'date'} ne '') {
		# ǯꤵƤϡפդƽϤ
		&print_calendar();
		print << "_END_";
<hr><div class="guidance">
    <a href="$cgi_url">ǿ</a>
</div>
<hr>
_END_
		for my $num (0 .. scalar(@log_files)-1) {
			&print_day($num);
		}
	} else {
		# ǯꤵƤʤϡڡϤ
		$page_start += $FORM{'page'} if ($FORM{'page'}) > 0;
		$page_start = 0 if ($page_start < 0);

		$page_last = $page_start + ($page_max - 1);
		$page_last = (scalar(@log_files)-1 < $page_last) ? scalar(@log_files)-1 : $page_last;

		&print_calendar();
		print "<hr>\n<div class=\"guidance\">\n";
		print "  <a href=\"$cgi_url\">ǿ</a>\n";
		# ڡʤ ###################
		if (scalar(@log_files)-1 > $page_last) {
			my $next_page = $page_start + $page_max;
			print "  <a href=\"?page=$next_page\">&lt;$page_maxʬ</a>\n";
		}
		# ڡ ###################
		if ($page_start > 0) {
			my $prev_page = $page_start - $page_max;
			$prev_page = 0 if ($prev_page < 0);
			print "  <a href=\"?page=$prev_page\">$page_maxʬ&gt;</a>\n";
		}
		print "</div>\n<hr>\n";

		#  *  Ϥ #########
		for my $num ($page_start .. $page_last) {
			&print_day($num);
		}
		print "\n";

	}
}

#-----------------------------------------------------------
# ɽ
sub print_calendar
{
	my $br;
	my $year_old;
	print "<div class=\"calendar\">\n";
	my @temp = 
		map { $_->[0] }
			sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
				map { [$_, substr($_, 0, 4), substr($_, 4, 2) ] }
					keys %log_exist;

	foreach my $date (@temp) {
		my $year = substr($date, 0, 4);
		my $month = substr($date, 4, 2);
		print "$br$year | " if ($year_old ne $year);
		print "<a href=\"$cgi_url?date=$year$month\">$month</a> ";
		$year_old = $year;
		$br = "<br>\n";
	}
	print "<br>\n";
	print "</div>\n";
}


#=============================================================================
# Ͽ
#=============================================================================

#-----------------------------------------------------------
# URLå
# URLʳnullʸ֤
sub check_url
{
	my $str = $_[0];
	$str =~ s/^\s+//g;
	my $match = $str =~ m/(http(s)?|ftp|mms|rtsp):\/\/[\w|\!\#\$\%\&\'\(\)\=\-\^\`\\\|\@\~\[\{\]\}\;\+\:\*\,\.\?\/]+/;
	return '' if ($maxurllength < length($str));
	return '' if ($match == 0);
	return $&;
}

#-----------------------------------------------------------
# ʣå
# ʣƤ1֤
sub check_dup
{
	my ($log, $url) = @_;
	foreach (@$log) {
		return 1 if ($_ eq "$url\n");
	}
	return 0;
}

#-----------------------------------------------------------
# ϤϿ
sub write_url
{
	my $localtime = time;
	my $logfile;
	my @log;

	my $write_message = ''; # 񤭹URL
	my $written_url = ''; # 񤭹ޤ줿URL (ɽ)
	my $false_url = ''; # 񤭹ޤʤäURL (ɽ)
	my $dup_url = ""; # ȽʣƤURL (ɽ)

	$FORM{'url'} =~ s/\n+/\n/g;
	$FORM{'url'} =~ s/^\n+//g;
	$FORM{'url'} =~ s/\n+$//g;
	$FORM{'url'} =~ s/\s+$//g;
	return if( $FORM{'url'} eq'');

	$logfile = "$log_dir$nowtime{year}/$nowtime{year}$nowtime{mon}$nowtime{mday}.dat";
	if (-e "$logfile") {
		open (IN, "$logfile");
		while (<IN>) {
			push (@log, $_);
		}
		close (IN);
	}

	my @urls = split(/\n/, $FORM{'url'});
	foreach my $url (@urls) {
		my $cheked_url = &check_url($url);
		if ($cheked_url ne '') {
			unless ( &check_dup(\@log, $cheked_url) ) {
				$write_message .= "$cheked_url\n";
				$written_url .= "$cheked_url<br>\n";
			} else {
				$dup_url .= "$cheked_url<br>\n";
			}
		} else {
			$false_url .= "$url<br>\n"
		}
	}

	print "<font color=\"red\">$false_url</font>Ͽ˼ԤޤURLľƤ<br><br>\n" if ($false_url ne '');
	print "<font color=\"red\">$dup_url</font>ʣƤΤϿޤǤ<br><br>\n" if ($dup_url ne '');
	return if ($write_message eq '');
	print "<font color=\"yellow\">$written_url</font>Ͽޤ<br><br>\n";

	# ǥ쥯ȥ¸ߤå(̵к)
	unless (-e "$log_dir$nowtime{year}") {
		mkdir "$log_dir$nowtime{year}";
	}
	# ե¸ߤå(̵к)
	unless (-e "$logfile") {
		open (OUT, ">$logfile");
		close (OUT);
	}

	unshift (@log, $write_message);
	open (OUT, "+< $logfile");
	flock(OUT, 2);
	truncate(OUT, 0);
	seek(OUT, 0, 0);
	print OUT @log;
	close (OUT);

	@log_files = ();
	$FORM{'date'} = '';
	&GetExistLogfiles();
	&write_rdf();

	open (OUT, ">$last_modified_file");
	print OUT "$localtime";
	close (OUT);
	return;
}

#-----------------------------------------------------------
# RDF Ϥ
sub write_rdf
{
	return if ($rdf_file eq '');

	my $out_rdf = << "_END_";
<?xml version="1.0" encoding="euc-jp"?>
<rdf:RDF 
  xmlns="http://purl.org/rss/1.0/"
  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
  xml:lang="ja">
  <channel>
    <title>$cgi_title</title>
    <link>$cgi_index</link>
    <description>$cgi_title</description>
    <language>ja-jp</language>
  </channel>
_END_

	for my $num (0 .. $page_max-1) {
		my @log;
		my ($year, $month, $day);
		my ($time, $contents, $desc, $enc);
		$log_files[$num] =~ /^$log_dir[0-9]{4}\/([0-9]{4})([0-9]{2})([0-9]{2})/;
		$year = $1;
		$month= $2;
		$day  = $3;
		open (IN, $log_files[$num]);
		while (<IN>) {
			push (@log, $_);
		}
		close (IN);
		foreach (@log) {
			chomp($_);
			$desc .= "$_\n";
			$enc .= "<a href=\"$_\">$_</a><br />\n";
		}

		$out_rdf .= << "_END_";
  <item rdf:about="$cgi_index?date=$year$month$day">
    <title>$year-$month-$day</title>
    <link>$cgi_index?date=$year$month$day</link>
    <description>$desc    </description>
    <content:encoded>$enc    </content:encoded>
  </item>
_END_

	}
	$out_rdf .= "</rdf:RDF>\n";
	open (OUT, ">$rdf_file");
	print OUT $out_rdf;
	close(OUT);
	return;
}

#=============================================================================
# Ϸ
#=============================================================================

#-----------------------------------------------------------
# ϥǥ
sub decode
{
	&print_error("ϥǡ礭ޤ") if($ENV{'CONTENT_LENGTH'} > $maxlength);

	my ( $formbuf, $name, $value );
	if ( $ENV{'REQUEST_METHOD'} eq 'POST' ) {
		read ( STDIN, $formbuf, $ENV{'CONTENT_LENGTH'} );
	} else {
		$formbuf = $ENV{'QUERY_STRING'};
	}
	
	if ( $formbuf ) {
		
		foreach ( split ( /&/, $formbuf ) ) {
			my ( $name, $value ) = split ( /=/ );
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			if ($jcode ne '') {
				require $jcode;
				&jcode'convert(*value,'euc');
			} else {
				use Jcode;
				Jcode::convert(*value,'euc');
			}
			$value =~ s/\r//g;
			$value =~ s/\t//g;
			$value =~ s/</&lt;/g;
			$value =~ s/>/&gt;/g;
			$value =~ s/&/&amp;/g;
			if ($FORM{$name}) {
				$FORM{$name} .= ",$value";
			} else {
				$FORM{$name} = $value;
			}
		}
	}
	return;
}

#-----------------------------------------------------------
# ϥå
sub check_form
{
	if ($FORM{'date'} ne '') {
		if ($FORM{'date'} !~ /^[0-9]{4}/) {
			&print_error("դ۾Ǥ");
		}
	}
	if ($FORM{'page'} ne '') {
		$FORM{'page'} = int($FORM{'page'});
		if ($FORM{'page'} < 0) {
			$FORM{'page'} = 0;
		}
		if ($FORM{'page'} > 100000) {
			$FORM{'page'} = 100000;
		}
	}
}

#=============================================================================
# ¾
#=============================================================================

#-----------------------------------------------------------
# ¸ߤե̾
sub GetExistLogfiles
{
	my $dir;
	my @dir_entry;
	my @log_dirs;
	my $date;

	if ($FORM{'date'} ne '') {
		$FORM{'date'} =~ /^([0-9]{4})([0-9]{2})?([0-9]{2})?[0-9]*$/;
		$date = "$1$2$3";
	}

	# ǯñ̥ǥ쥯ȥ #################
	opendir(DIR, $log_dir);
	@dir_entry = sort {$a cmp $b} readdir DIR;
	closedir DIR;
	foreach (@dir_entry) {
		if ($_ =~ /^[0-9]{4}/) {
			push (@log_dirs, $_);
		}
	}

	# ե̾ #####################
	foreach $dir (@log_dirs) {
		if (-d "$log_dir$dir") {
			opendir(DIR, "$log_dir$dir");
			@dir_entry = sort {$a cmp $b} readdir DIR;
			closedir DIR;
			foreach my $files (@dir_entry) {
				if($files =~ /^([0-9]{4}[0-9]{2})[0-9]{2}.dat$/) {
					# ǯñ̤¸ߤ¸()
					$log_exist{$1} = '.' if ($1 ne '');
					# դꤵƤ硢եեΤ߻Ĥ
					next if ($date ne '' && $files !~ /^$date/);
					push(@log_files, "$log_dir$dir/$files");
				}
			}
		}
	}

	@log_files = sort {$b cmp $a} @log_files;
	return;
}

#-----------------------------------------------------------
# դ
sub get_nowtime
{
	(
	$nowtime{sec}, 
	$nowtime{min}, 
	$nowtime{hour}, 
	$nowtime{mday}, 
	$nowtime{mon}, 
	$nowtime{year}, 
	$nowtime{wday}, 
	$nowtime{yday}, 
	$nowtime{isdst}
	) = localtime(time);
	$nowtime{mon}++;
	$nowtime{year} += 1900;
	$nowtime{year} = sprintf("%04d",$nowtime{year});
	$nowtime{mon}  = sprintf("%02d",$nowtime{mon});
	$nowtime{mday} = sprintf("%02d",$nowtime{mday});
	$nowtime{hour} = sprintf("%02d",$nowtime{hour});
	$nowtime{min}  = sprintf("%02d",$nowtime{min});
	$nowtime{sec}  = sprintf("%02d",$nowtime{sec});
	return;
}
