#Please save this file by EUC-code unless you use jperl.
package libhuginn;

use Socket;
require 'jcode.pl';

$agentname   = "Huginn DiaryCheck/1.20";
$update      = "20001124";
$home        = $ENV{HOME};
$DEBUG       = "0";
$TIMEOUT     = 10;
$outputTMZ   = "JST";
$innerTMZ    = "GMT";

$logfile     = "$home/.huginn.log";
$timeDBfile  = "$home/.huginnDB";
$rcfile      = "$home/.huginnrc";
$resultfile  = "$home/.huginnResult.html";

#if you not use LIRS.pm, but you want to read LIRS Data
$simpleLIRSsupport = "on";
$gzip        = "/bin/gzip";

&initscript();

sub initscript{
    local($i);
    &thistime();
    $sock_addr = 'S n a4 x8';
    $hostname = '$ENV{HOST}';
    ($name,$aliases,$proto) = getprotobyname('tcp');
    ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
    $port = 80;
    
    %TIMEZONE
	= ("GMT",0,
	   "UT",0,
	   "EST",-5,
	   "CST",-6,
	   "MST",-7,
	   "PST",-8,
	   "EDT",-4,
	   "CDT",-5,
	   "MDT",-6,
	   "PDT",-7,
	   "A",-1,
	   "B",-2,
	   "C",-3,
	   "D",-4,
	   "E",-5,
	   "F",-6,
	   "G",-7,
	   "H",-8,
	   "I",-9,
	   "K",-10,
	   "L",-11,
	   "M",-12,
	   "N",+1,
	   "O",+2,
	   "P",+3,
	   "Q",+4,
	   "R",+5,
	   "S",+6,
	   "T",+7,
	   "U",+8,
	   "V",+9,
	   "W",+10,
	   "X",+11,
	   "Y",+12,
	   "Z",0,
	   "JST",+9,
	   "ECT",+1,
	   "EET",+2,
	   "ART",+2,
	   "EAT",+3,
	   "MET",+3.5,
	   "NET",+4,
	   "PLT",+5,
	   "IST",+5.5,
	   "BST",+6,
	   "VST",+7,
	   "CTT",+8,
	   "JST",+9,
	   "ACT",+9.5,
	   "AET",+10,
	   "SST",+11,
	   "NST",+12,
	   "MIT",-11,
	   "HST",-10,
	   "AST",-9,
	   "PNT",-7,
	   "IET",-5,
	   "PRT",-4,
	   "CNT",-3.5,
	   "AGT",-3,
	   "BET",-3,
	   "CAT",-1,
	   "+00", 0,
	   "+01", +1,
	   "+02", +2,
	   "+03", +3,
	   "+04", +4,
	   "+05", +5,
	   "+06", +6,
	   "+07", +7,
	   "+08", +8,
	   "+09", +9,
	   "+10", +0,
	   "+11", +11,
	   "+12", +12,
	   "-00", 0,
	   "-01", -1,
	   "-02", -2,
	   "-03", -3,
	   "-04", -4,
	   "-05", -5,
	   "-06", -6,
	   "-07", -7,
	   "-08", -8,
	   "-09", -9,
	   "-10", -10,
	   "-11", -11,
	   "-12", -12,
	   
	   "+0000", 0,
	   "+0030", +0.5,
	   "+0100", +1,
	   "+0130", +1.5,
	   "+0200", +2,
	   "+0230", +2.5,
	   "+0300", +3,
	   "+0330", +3.5,
	   "+0400", +4,
	   "+0430", +4.5,
	   "+0500", +5,
	   "+0530", +5.5,
	   "+0600", +6,
	   "+0630", +6.5,
	   "+0700", +7,
	   "+0730", +7.5,
	   "+0800", +8,
	   "+0830", +8.5,
	   "+0900", +9,
	   "+0930", +9.5,
	   "+1000", +10,
	   "+1030", +10.5,
	   "+1100", +11,
	   "+1130", +11.5,
	   "+1200", +12,
	   "-0000", -0,
	   "-0030", -0.5,
	   "-0100", -1,
	   "-0130", -1.5,
	   "-0200", -2,
	   "-0230", -2.5,
	   "-0300", -3,
	   "-0330", -3.5,
	   "-0400", -4,
	   "-0430", -4.5,
	   "-0500", -5,
	   "-0530", -5.5,
	   "-0600", -6,
	   "-0630", -6.5,
	   "-0700", -7,
	   "-0730", -7.5,
	   "-0800", -8,
	   "-0830", -8.5,
	   "-0900", -9,
	   "-0930", -9.5,
	   "-1000", -10,
	   "-1030", -10.5,
           "-1100", -11,
	   "-1130", -11.5,
	   "-1200", -12
	   );
    %MONTH      = ("Jan",1,"Feb",2,"Mar",3,"Apr",4,"May",5,"Jun",6,
		   "Jul",7,"Aug",8,"Sep",9,"Oct",10,"Nov",11,"Dec",12);
    $MONTH      = "(?:".join('|',keys %MONTH).")";

    $TIMEARGS = '$year,$month,$day,$hour,$minute,$second,$timezone';

    local(@pattern)
	=('(?:Sun,|Mon,|Tue,|Wed,|Thu,|Fri,|Sat,) (\d{2}) ($MONTH) (\d{4}) (\d{2}):(\d{2}):(\d{2}) ([^ \)\n\-]+|[+-]\d{4})',
	  '(?:Sunday,|Monday,|Tuesday,|Wednesday,|Thursday,|Friday,|Saturday,) (\d{2})-($MONTH)-(\d{2,4}) (\d{2}):(\d{2}):(\d{2}) ([^ \)\n\-]+|[+-]\d{4})',
	  '(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat) ($MONTH) (\d{1,2}) (\d{2}):(\d{2}):(\d{2}) (\d{4})',
	  '[^\d](\d{4})(?:ǯ|\.|/| )(\d{1,2})(?:·î|\.|/| )(\d{1,2})[^\d]',
	  '[^\d](\d{2})(?:ǯ|\.|/| )(\d{1,2})(?:·î|\.|/| )(\d{1,2})[^\d]',
	  '[^\d](\d{1,2})(?:·î|\.|/| )(\d{1,2})[^\d]');
    local(@args)
	=('$3,$MONTH{$2},$1,$4,$5,$6,$7',
	  '($3<1970)?(2000+$3):($3),$MONTH{$2},$1,$4,$5,$6,$7',
	  '$6,$MONTH{$1},$2,$3,$4,$5,"JST"',
	  '$1,$2,$3,0,0,0,"JST"',
	  '2000+$1,$2,$3,0,0,0,"JST"',
	  '$thisyear,$1,$2,0,0,0,"JST"');
    local($els) = "";
    $parsescript = 'local($flag)=1;'."\n";
    for($i=0;defined($pattern[$i]);$i++){
	
	$parsescript .= $els."if(m%$pattern[$i]%)";
	$parsescript .= "{($TIMEARGS) = ($args[$i]);}\n";
	$els = "els";
    }
    $parsescript .= "else{\$flag = 0;}\n";
    $parsescript .= '$time = &convTMZ($year,$month,$day,$hour,$minute,$second,$timezone) if($flag != 0);'." \n";
}

sub setCheckMode{
    local($_) = @_;
    $checkmode = $_;
}

sub openLOG{
    open(LOG,">$logfile");
}

sub closeLOG{
    close(LOG);
}

sub readRCfile{
    open(COM,"$rcfile");
    while(<COM>){
	undef(%value);

	#parse rc-file line
	if(/^\#/){next;}
	&resolveRCMacro(*_);
	while(s/^(.*?)="(.*?[^\\])"\s*//){$value{$1} = "$2";}
	#do each command-param
	if(defined $value{"useraddress"}){
	    $useraddress = $value{"useraddress"};
	}
	if(defined $value{"remote"}){
	    push(@remotelist,$value{"remote"});
	    if(defined $value{"type"}){
		$agent_data_type{$value{"remote"}} = $value{"type"};
	    }
	    if(defined $value{"sig"}){
		$agent_sig{$value{"remote"}} = $value{"sig"};
	    }
	}
	if(defined $value{"ref"}){
	    push(@outlist,$value{"ref"});
	    if(defined $value{"title"}){
		$title{$value{"ref"}}=$value{"title"};
	    }else{
		$title{$value{"ref"}}=$value{"ref"};
	    }
	}
	if(defined $value{"logfile"}){$logfile = $value{"logfile"};}
    }
}

sub readtimeDB{
    local($count,$_);
    open(DB,"$timeDBfile");
    $count = 0;
    while(<DB>){
	chop;
	($time,$method,$url) = split("\t");
	$url[$count]  = $url;
	$whatmethod{$url} = $method;
	$timeDB{$url} = $time;
	$count++;
    }
    close(DB);
}

sub writetimeDB{
    local($count,$_);
    open(DB,">$timeDBfile");
    foreach $url(keys %timeDB){
	print DB $timeDB{$url}."\t".$whatmethod{$url}."\t".$url."\n";
    }
    close(DB);
}

sub mergeTimeDB{
    foreach $url (keys %newtimeDB){
	if($newtimeDB{$url} > $timeDB{$url}){
	    print LOG "renew timeDB: $url,$newtimeDB{$url}\n";
	    $timeDB{$url} = $newtimeDB{$url};
	    $whatmethod{$url} = $newwhatmethod{$url};
	}
    }
}

sub RemoteCheck{
    foreach $url (@remotelist){
	&REMOTE($url);
    }
}

sub nonRemoteCheck{
    foreach $url (@outlist){
	if(defined($newtimeDB{$url})){
	    print LOG "use REMOTE data: $url\n";
	    print STDERR "use REMOTE data: $url\n";
	}else{
	    $stat = &HEAD($url);
	    &GET($url) if($stat != 404 && !defined($newtimeDB{$url}));
	    $timeDB{$url} = "00000000000000" if(!defined($newtimeDB{$url}));
	}
    }
}

sub output{
    local(%output,$output);
    foreach $url (@outlist){
	$time = convTMZ($timeDB{$url},'JST');
	$time =~ /\d{4}(\d{2}\d{2}\d{2}\d{2})\d{2}/;
	$query = $1;
	$output{"$time$url"} =
	    "  <li>".&reformTIME($time).&outputMethodType($url)
		.qq!<a href="$url?$query">$title{$url}</a></li>\n!;
    }
    $output = '<?xml version="1.0" encoding="euc-japan" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0Strict//EN"
                 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> 
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja" lang="ja">
<head>
<title>Diary Checker Result</title>
<meta http-equiv="Content-type" content="text/html; charset=euc-japan" />
</head>
<body>
<ul>';
    foreach(sort{($a <=> $b)*-1} keys %output){
	$output .= $output{$_};
    }
    $output .='</ul>
</body>
</html>';
    open(RESULT,">$resultfile");
    print RESULT $output;
    close(RESULT);
}

sub outputMethodType{
    local($url) = @_;
    local($result);

    $_ = $whatmethod{$url};
    if   (/remote/i){$result="(r)";}
    elsif(/head/i  ){$result="(h)";}
    elsif(/get/i  ){$result="(g)";}
    elsif(/unknown/i){$result="(?)";}

    return $result;
}

sub HEAD{
    local($url) = @_;
    local($_,$method,$time,$stat,$text,@text);

    $method = "HEAD";
    print LOG "HEAD getting: $url ...";
    print STDERR "HEAD getting: $url ...";
    $text = &HTTPrequest($url,$method);
    normal_text(*text);
    @text = split("\n",$text);
    $_ = shift(@text);/(\d\d\d)/;$stat = $1;
    foreach (@text){
	if(/^Last-Modified:/i){
	    eval $parsescript;
	    $newtimeDB{$url} = $time;
	    $newwhatmethod{$url} = "head";
	    last;
	}
    }
    return $stat;
}

sub GET{
    local($url) = @_;
    local($_,$method,$time);

    $method = "GET";$newtimeDB{$url} = 0;
    print LOG "GET getting: $url ...";
    print STDERR "GET getting: $url ...";
    $text = &HTTPrequest($url,$method);
    normal_text(*text);
    &thistime();
    foreach (split("\n",$text)){
	eval $parsescript;
	if($time < $thistime && $time > $newtimeDB{$url}){
	    $newtimeDB{$url}=$time;
	    $newwhatmethod{$url} = "get";
	}
    }
    return;
}

sub REMOTE{
    local($href) = @_;
    local($_,$text,$method,$url,$time);
    local($year,$month,$day,$hour,$minute,$second,$timezone);

    print LOG "REMOTE getting: $href ...";
    print STDERR "REMOTE getting: $href ...";

    $method = "GET";
    $text = &HTTPrequest($href,$method);
    if($agent_data_type{$href} eq "LIRS"){
	resolveLIRS($text);
    }else{
	normal_text(*text);
	&resolveHINATXT($text);
    }
}

sub resolveHINATXT{
    local($text) = @_;
    foreach (split("\n",$text)){
	if(m%<!--HINA_OK (\d{2,4})/(\d{2})/(\d{2}) (\d{2}):(\d{2}).*?-->%i){
	    ($year,$month,$day,$hour,$minute,$second,$timezone)
		= ($1,$2,$3,$4,$5,0,'JST');
	    $time =
		&convTMZ($year,$month,$day,$hour,$minute,$second,$timezone);
	    /<a href=['"](.*?)\?.*["']>/i;$url = $1;
	    if($DEBUG == 1){
		printf("resolveHINATXT: $time\n");
	    }
	    if($time > $newtimeDB{$url}){
		$newtimeDB{$url} = $time;
		$newwhatmethod{$url} = "remote";
	    }
	}
    }
}

sub resolveLIRS{
    local($text) = @_;
    
    open(GZIP,"| $gzip -d >tmp$$");
    print GZIP $text;
    close(GZIP);
    $text = "";
    open(GZIP,"tmp$$");
    while(<GZIP>){$text .= $_;}
    close(GZIP);
    unlink("tmp$$");

    local($time);
    foreach (split("\n",$text)){
	#    LIRS LM    LD    TMZ   CLeng URL   Title owner agent
	if(m%^LIRS,(\d+),(\d+),(\d+),(\d+),(.*?),(.*?),(.*?),(.*?),(.*)$%){
	    local($LM,$LD,$TMZ,$leng,$url,$title,$owner,$agent,$expand)
		= ($1,$2,$3,$4,$5,$6,$7,$8,$9);
	    $time = USTtoHuginn($LM);
	    if($DEBUG == 1){
		printf("resolveLIRS: $time\n");
	    }
	    if($time > $newtimeDB{$url}){
		$newtimeDB{$url} = $time;
		$newwhatmethod{$url} = "remote";
	    }
	}
    }
}

sub HTTPrequest{
    local($url,$method) = @_;

    $url =~ m%http://(.*?)(/.*/)(.*)%;
    local($serv,$dir,$file) = ($1,$2,$3);
    local($path) = $dir.$file;
    local ($text);

    $req_str  = "$method $path HTTP/1.1\r\n";
    $req_str .= "Connection: close\r\n";
    $req_str .= "User-Agent: $agentname\r\n";
    $req_str .= "From: $useraddress\r\n";
    $req_str .= "Host: $serv\r\n";
    $req_str .= "\r\n";

    eval{ $SIG{'ALRM'} = 'timeout';sub timeout{ die "timeout";}
	  ($name,$aliases,$port)
	      = getservbyname($port,'tcp') unless $port =~/^\d+$/;;
	  ($name,$aliases,$type,$len,$thataddr) = gethostbyname($serv);
	  eval{alarm(0);};
      };
    if($@ ne ""){print LOG $@;print STDERR $@;return}
    
    $that = pack($sock_addr,&AF_INET,80,$thataddr);
    $this = pack($sock_addr,&AF_INET,0,$thisaddr);

    eval{ $SIG{'ALRM'} = 'timeout';sub timeout{ die "timeout";}
	  eval{ alarm($TIMEOUT);};
	  socket(S,&PF_INET,&SOCK_STREAM,$proto)||die "cannot get a socket";
	  bind(S,$this) ||die "cannot bind socket";
	  connect(S,$that) ||die "cannot connect socket";

	  local($oldselect) = select;select(S);$| = 1;
	  print S $req_str;
	  select($oldselect);
	  
	  if($method eq "GET"){while(<S>){if(/^\015\012$/){last;}}}
	  while(<S>){
	      $text .= $_;
	  }
	  close(S);
	  eval{alarm(0);};
      };
    if($@ ne ""){close(S);print LOG $@;print STDERR $@;}
    else{print LOG "done.\n";print STDERR "done.\n";}
    return $text;
}

sub thistime{
    ($thissecond,$thisminute,$thishour,$thisday,$thismonth,
     $thisyear,$thiswday,$thiswyear,$thisstime) = gmtime;$thismonth++;
    ($thislocalsecond,$thislocalminute,$thislocalhour,$thislocalday,
     $thislocalmonth,$thislocalyear,$thislocalwday,$thislocalwyear,
     $thislocalstime) = localtime;$thislocalmonth++;

    if($thisyear < 1970){$thisyear += 1900;}
    $thistime =	sprintf("%04d%02d%02d%02d%02d%02d",
			$thisyear,$thismonth,$thisday,
			$thishour,$thisminute,$thissecond);
    $thislocaltime = sprintf("%04d%02d%02d%02d%02d%02d",
			     $thislocalyear,$thislocalmonth,$thislocalday,
			     $thislocalhour,$thislocalminute,$thislocalsecond);
}

sub normal_text{
    local(*_) = @_;
    &jcode::convert(*_,"euc");
    s/\015\012/\012/g;
    s/\015/\012/g;
    s/\012$/\n/g;
   
    s/£±/1/g;
    s/£²/2/g;
    s/£³/3/g;
    s/£´/4/g;
    s/£µ/5/g;
    s/£¶/6/g;
    s/£·/7/g;
    s/£¸/8/g;
    s/£¹/9/g;
    s/£°/0/g;
}

sub convTMZ{
    local($time,$wday,$wyear,$stime);
    local($year,$month,$day,$hour,$minute,$second,$timezone,$targetzone);
    if(scalar(@_) == 2){
	($time,$targetzone) = @_;
	$time =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
	($year,$month,$day,$hour,$minute,$second,$timezone)
	    = ($1,$2,$3,$4,$5,$6,$innerTMZ);
    }else{
	($year,$month,$day,$hour,$minute,$second,$timezone,$targetzone) = @_;
	$targetzone = $innerTMZ if(!defined($targetzone));
    }
    if($DEBUG == 1){
	printf("convTMZ: %04d%02d%02d%02d%02d%02d\n"
	       ,$year,$month,$day,$hour,$minute,$second);
    }
    
    local(@DAYOFMONTH) = (31,28,31,30,31,30,31,31,30,31,30,31);
    if($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)){
	@DAYOFMONTH = (31,29,31,30,31,30,31,31,30,31,30,31);
    }
    # $time means days
    $time = $year * 365 + int($year/4) - int($year/100) + int(year/400);
    $time -= 719523;# days since 1970;
    $month--;for($i = 0;$i < $month;$i++){$time += $DAYOFMONTH[$i];}
    $time += $day-1;

    
    # $time means hours
    $time *= 24;$time += $hour;
    $time += ($TIMEZONE{$targetzone} - $TIMEZONE{$timezone});
    # $time means minutes
    $time *= 60;$time += $minute;
    # $time means seconds(UNIX standard time)
    $time *= 60;$time += $second;

    ($second,$minute,$hour,$day,$month,$year,$wday,$wyear,$stime)
	= gmtime($time);$month++;
    if($year < 1970){$year += 1900;}
    if($DEBUG == 1){
	printf("convTMZ: %04d%02d%02d%02d%02d%02d\n"
	       ,$year,$month,$day,$hour,$minute,$second);
    }
    return sprintf("%04d%02d%02d%02d%02d%02d"
		   ,$year,$month,$day,$hour,$minute,$second);
}

sub USTtoHuginn{
    local($time) = @_;
    local($second,$minute,$hour,$day,$month,$year,$wday,$wyear,$stime)
	= gmtime($time);$month++;
    if($year < 1970){$year += 1900;}
    return sprintf("%04d%02d%02d%02d%02d%02d"
		   ,$year,$month,$day,$hour,$minute,$second);
}

sub reformTIME{
    local($time) = @_;
    $time =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
    return sprintf("%04d %02d/%02d %02d:%02d:%02d",$1,$2,$3,$4,$5,$6);
}

sub resolveRCMacro{
    #
    ### You can Customize RCfile's Macro at here.
    #
    local(*_) = @_;
    s/(?=[^\\])%2y/sprintf("%02d",($thisyear % 100))/eg;
    s/(?=[^\\])%y/sprintf("%d",$thisyear)/eg;
    s/(?=[^\\])%m/sprintf("%d",$thismonth)/eg;
    s/(?=[^\\])%0m/sprintf("%02d",$thismonth)/eg;
    s/(?=[^\\])%d/sprintf("%d",$thisday)/eg;
    s/(?=[^\\])%\[(.*)\]/$1/eeg;
    s/(?=[^\\])%\((.*)\)/$1/eeg;
    s/(?=[^\\])%\{(.*)\}/$1/eeg;
}

1;