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

use lib './';
#require 'jcode.pl';
use NKF;
use Time::Local;
use DI::blocks;
use DI::Di;
use HTTP::Date;
use IO::Socket;
use IO::Select;
use File::Copy 'cp';
use vars qw(
            $DI_DATA

	    $CACHED_DI_FILE
	    $REMOTE_CFG
	    $REMOTE_CFG_FILE
	    %BYMYSELF
	    $CFG_FILE
	    $URL

	    $METHOD
	    $M_NAME
	    $R_FILE
	    $G_URL
	    $R_URL
	    $LMD

	    $VERSION
	    $USER_AGENT
            $HTTP_PROXY

	    $DATA_DIR

	    $THIS_TIME
	    $THIS_YEAR
	    $EXPIRE_MARGIN
	    $ONE_HOUR
	    $ONE_DAY
            $CONNECT_TIMEOUT
            $READ_TIMEOUT
);


$REMOTE_CFG_FILE = 'remote.cfg';
$CFG_FILE = 'popopo.cfg';
$CACHED_DI_FILE  = 'po.di';
$URL = 'http://popopo.hauN.org/';

$DATA_DIR ='./data';

$VERSION = "2.0b7 (19991005; DI::Di/$DI::Di::VERSION; DI::blocks/$DI::blocks::VERSION)";
$USER_AGENT = 'MICAN';
$USER_AGENT .= "/$VERSION";
#
# &jcode::init();
#
$METHOD = 'METHOD';
$M_NAME = 'METHOD_NAME';
$R_FILE = 'REMOTE_FILE';
$G_URL  = 'GET_URL';
$R_URL  = 'REFER_URL';
$LMD    = 'L_M_D';
#
#
$ONE_HOUR      = 60 * 60;
$ONE_DAY       = $ONE_HOUR * 24;
$EXPIRE_MARGIN = $ONE_HOUR * 2;
$THIS_TIME     = time();
$THIS_YEAR     = (localtime($THIS_TIME))[5];
#
$CONNECT_TIMEOUT = 1;
$READ_TIMEOUT    = 20;
#
#


$DI_DATA = new DI::Di();

## read config
&read_config_file;

## read remote CFG
&remote_cfg;

## read cache
&read_cache_di;

## change to data directry 
chdir ( $DATA_DIR );

foreach my $file ( keys %$REMOTE_CFG ){
#  print STDERR "FILE: $file\n";
#  next if &get_remote($file);
  &get_remote($file);
  &remote_data($file);
}

$DI_DATA->sort();

print "User-Agent: $USER_AGENT\n";
print "Date: ",HTTP::Date::time2str($THIS_TIME),"\n\n";
print $DI_DATA->as_di_string;

exit;
###
##
#
sub read_cache_di{

  my $RS = $/;$/="\n\n";
  open(DI,$CACHED_DI_FILE);
  while(<DI>){
    my (%rec)=();
    my $di = undef;
    my @lines=split("\n");
    
    foreach my $line (@lines){
      my ($a, $b) = split(/:\s*/,$line,2);
      $rec{"\L$a\E"} = $b;
    }
    
    if (exists $rec{'url'} ) {
	$di = new DI::blocks( %rec );
	next if ( $di->last_modified > $di->last_modified_detected );
	if ( ($di->expired) || ($di->last_modified == 0 )){
	  if ( exists $BYMYSELF{$rec{'url'}} ){
	    $REMOTE_CFG->{$BYMYSELF{$rec{'url'}}}->{$LMD} = 0;
	  }
	}else{
	  $DI_DATA->update($di);
	}
    }
  }
  close(DI);
  $/ = $RS;
}


###
## リモートTEIGIの読み込み
#
sub remote_cfg{
    my ($method, $name, $filename,$url, $refer);
    open ( FILE ,$REMOTE_CFG_FILE);
    while (<FILE>){
	next if ( /^\s*$/ );
	next if ( /^#/ );
#	$_ = &jcode::euc($_);
	$_ = nkf("-e",$_);
	chomp;
	( $method, $name, $filename, $url, $refer ) = split ("::");

	$REMOTE_CFG->{$filename}->{$METHOD} = $method;
	$REMOTE_CFG->{$filename}->{$M_NAME} = $name;
	$REMOTE_CFG->{$filename}->{$G_URL} = $url;
	$REMOTE_CFG->{$filename}->{$R_URL} = $refer;
	if ( -e "$DATA_DIR/$filename" ){
	  $REMOTE_CFG->{$filename}->{$LMD} = &file_time("$DATA_DIR/$filename");
	}else{
	  $REMOTE_CFG->{$filename}->{$LMD} = 0;
	}
	if ( $method ne 'remote' ){
	  $BYMYSELF{$refer} = $filename;
	}
    }
    close FILE;
}

###
## リモートファイルから情報を取得。
## hina.txt,hina.di,dirp,http headerの出力に対応
#
sub remote_data{
  my $file = shift;
  my $url = undef;
  my $time = 0;
  my $detected = 0;
  my %rec = ();

  open (FILE,$file);
  while (<FILE>){

    # EUCにする
#    $_=&jcode::euc($_);
    $_ = nkf("-e",$_);
    # 改行コードを取り除く
    chomp;

    if ( /^[\w\-_]+:/ ){
      my ($feature, $value) = split(/:\s*/,$_,2);


      if ( $feature =~ /last-modified/i ){
	  $detected ||= &lm2time($value);
      }elsif ( $feature =~ /url$/i){
	$value =~ s!/%7E!/~!;
      }
      if ( DI::blocks->is_feature_defined($feature) ){
	$rec{$feature} = $value ;
      }
            
    }elsif (/HINA_OK/){
      # <!--HINA_OK 1998/09/11 16:20 [1]-->\
      # <a href="http://www.spa.is.uec.ac.jp/%7Emasanari/d/digest.html?09111620">まさなりさん　</a> 09/11 16:20
      if ( m%[^\(]<a[^>]+href=\"([^\"]+)\"[^>]*>%i ){
	$url = $1;
	# URLの後のゴミを取り除く。
	$url =~ s/[\?&]\d+(\#\w+)?$//;
	$url =~ s/\%7E/~/o;
	# 時刻を取り出す。
	$time = &lm2time($_);
	
	&set_info( $file, $url, $time, $detected );
	$url      = "";
	$time     = 0;
#	$detected = 0;
      }
      # 猫フォーマット
    }elsif ( /^(\d+)\s\d+\s(\d+)\s\d{3}\s\w+\s(http:\/\/\S+)/ ){
      $detected = $1;
      $time = $2;
      $url = $3;
      # URLの後のゴミを取り除く。
      $url =~ s/[\?&]\d+(\#\w+)?$//;
      $url =~ s/\%7E/~/o;
      if ( $url ne "" && $time ne ""){

	&set_info( $file, $url, $time, $detected );
	$url      = "";
	$time     = 0;
#	$detected = 0;
      }
      
    }elsif ( /\d+:\d+/){
      if (m%href=\"([^\"]+)\"[^>]*>%i){
	$url = $1;
	# URLの後のゴミを取り除く。
	$url =~ s/[\?&]\d+(\#\w+)?$//;
	$url =~ s/\%7E/~/o;
	
	# 時刻を取り出す。
	$time = &lm2time($_);
	
	if ( $url ne "" && $time ne ""){
	  &set_info( $file, $url, $time, $detected );
	  $url      = "";
	  $time     = 0;
	  $detected = 0;
	}
      }
    }elsif (/^$/){
      my $di = new DI::blocks( %rec );
      %rec = ();
#      next if ( $di->authorized_url =~ /\Q$URL\E/i );
      next if ( $di->last_modified > $THIS_TIME + $ONE_HOUR / 4 );
      $di->header(X_Mican_Authorized => $REMOTE_CFG->{$file}->{$M_NAME});
      $di->header(X_Mican_Authorized_Url => $REMOTE_CFG->{$file}->{$R_URL});
      unless ( defined $di->last_modified_detected ){
	  $di->last_modified_detected($detected);
      }
      if ( defined $di->expire ){
	$di->expires($di->expire) unless ( defined $di->expires );
      }
#      if ( ( $di->url =~ /^http:/ ) && ($di->expired == 0 ) ){
      if ( $di->url =~ /^http:/ ){
	$DI_DATA->update($di);
      }
      %rec = ();
    }
  }
}
###
## リモートデータをupdateする。
#
sub set_info{
    my $file = shift;
    my $url = shift;
    my $time = shift;
    my $detected = shift;

    my $di = new DI::blocks( URL => $url );

    $di->last_modified($time);
    return if ( $di->last_modified > $THIS_TIME + $ONE_HOUR / 4 );

#    if ($detected){
      $di->last_modified_detected($detected);
#    }
    $di->header(X_Mican_Authorized => $REMOTE_CFG->{$file}->{$M_NAME});
    $di->header(X_Mican_Authorized_Url => $REMOTE_CFG->{$file}->{$R_URL});
    $di->header(Authorized_Url => $REMOTE_CFG->{$file}->{$R_URL});
#    $di->expire( $THIS_TIME + $EXPIRE_MARGIN );
#    $di->expires( $THIS_TIME + $EXPIRE_MARGIN );
    $di->expire( $THIS_TIME );
    $di->expires( $THIS_TIME );

    $DI_DATA->update($di);

    
}
###
## 様々な形式の時刻表記から、timeを取り出す。
#
sub lm2time{
    $_ = shift ;
    my $time = 0;
    my ($y,$m,$d, $H,$M,$S);
    if (m%\w+, (\d+) (\w+) (\d+) (\d\d):(\d\d):(\d\d) (\w+)%io) {
	# rfc1123 "Sun, 06 Nov 1994 08:49:37 GMT"
	$y = $3 ;
	$y -= 1900 if ( $y >= 1900);
	$y += 100 if ( $y <70 );
	$time = &timeglobal( $7, $6, $5, $4, $1,&month2num($2),$y);
    } elsif (m%\w+, (\d+)-(\w+)-(\d+) (\d\d):(\d\d):(\d\d) (\w+)%io) {
	# rfc1036 "Sunday, 06-Nov-94 08:49:37 GMT"
	$y = $3 ;
	$y -= 1900 if ( $y >= 1900);
	$y += 100 if ( $y <70 );
	$time = &timeglobal( $7, $6, $5, $4, $1,&month2num($2),$y);
    } elsif (m%\w+ (\w+) (\d+) (\d\d):(\d\d):(\d\d) (\d+)%io) {
	# Sun Nov 6 08:49:37 1994 (ANSI C's asctime() format) 
	$y = $6 ;
	$y -= 1900 if ( $y >= 1900);
	$y += 100 if ( $y <70 );
	$time = &timeglobal( "GMT", $5, $4, $3, $2,&month2num($1),$y);
    } elsif (m%HINA_OK (\d\d\d\d)/(\d+)/(\d+) (\d+):(\d+)%io){
	# for 朝日奈アンテナ hina.txt
	# <!--HINA_OK 1998/10/23 00:48 
	$y = $1 -1900;
	$time = &timeglobal( "JST", 0, $5, $4, $3, $2-1 ,$y);
    } elsif (m%HINA_OK (\d\d)/(\d+)/(\d+) (\d+):(\d+)%io){
	# for 朝日奈アンテナ hina.txt older version
	# <!--HINA_OK 98/10/23 00:48 
	$y = $1 ;
	$y += 100 if ( $y <70 );
	$time = &timeglobal( "JST", 0, $5, $4, $3, $2-1 ,$y);
    } else {

	# 時分秒
	if ( m%(\d+):(\d+):(\d+)% ){
	    $H = $1; $M = $2; $S = $3;
	} elsif ( m%(\d+):(\d+)% ){
	    $H = $1; $M = $2; $S = 0;
	}
	# 年月日
	if ( m%(\d+)/(\d+)/(\d+)% ){
	    $y = $1;
	    $m = $2;
	    $d = $3;
	    if ( $y >= 1900 ){
		$y -= 1900;
	    }
	    if ( $y < 70 ){
		$y +=100;
	    }
	}elsif ( m%(\d+)/(\d+)% ){
	    $y = $THIS_YEAR ; $m = $1; $d = $2;
	}
	if ( ( ( 0 <= $S ) && ( $S < 60 ) )
	     && ( ( 0 <= $M ) && ( $M < 60 ) )
	     && ( ( 0 <= $H ) && ( $H < 24 ) )
	     && ( ( 0 <= $d ) && ( $d < 32 ) )
	     && ( ( 1 <= $m ) && ( $m < 13 ) ) )
	{
	    $time = &timeglobal( "JST", $S, $M, $H, $d, $m-1 ,$y);
	    my $week = 60 * 60 * 24 * 7;
	    if ( $time > $THIS_TIME + $week ){
		$time = &timeglobal( "JST", $S, $M, $H, $d, $m-1 ,$y -1);
	    }
	}
    }
    return($time);
}
sub month2num{
    my $mon = shift;
    $mon =~ s%Jan%0%io;
    $mon =~ s%Feb%1%io;
    $mon =~ s%Mar%2%io;
    $mon =~ s%Apr%3%io;
    $mon =~ s%May%4%io;
    $mon =~ s%Jun%5%io;
    $mon =~ s%Jul%6%io;
    $mon =~ s%Aug%7%io;
    $mon =~ s%Sep%8%io;
    $mon =~ s%Oct%9%io;
    $mon =~ s%Nov%10%io;
    $mon =~ s%Dec%11%io;
    return $mon;
}
###
## timegm($sec,$min,$hours,$mday,$mon,$year);
#
sub timeglobal{
    my $hour = 60 * 60;
    my $tz = shift;
    my $time = &timegm( @_ );
    $tz =~ s%JST%-9%io;
    $tz =~ s%GMT%0%io;
    $time += $hour * $tz;
    $time;
}

###
## 
#
sub read_config_file{
  my $url ;
  my $time;
  my $title;
  my $option;
  
  open ( FILE, $CFG_FILE);
  while (<FILE>){
    next if ( /^\#/ );

    chomp;
#    $_ = &jcode::euc($_);
    $_ = nkf("-e",$_);
    
    s/\%7E/~/io;
    
    ( $time, $title, $url, $option ) = split("::");

    my $di = new DI::blocks( URL => $url ,
			     X_Mican_Title => $title);
#			     X_Mican_Fragment => $option );
    $di->last_modified($time);
#    $di->last_modified_detected($time);
#    $di->expire($time);

    $option =~ s/\?\%[^\#]+//;
    if ( $option ne '' ){
	$di->header(X_Mican_Fragment  => $option );
    }
    $DI_DATA->components($di);
    
  }
}
###
## リモートファイルの取得。
#
sub get_remote{
    my $out_file = shift;
    my $method = $REMOTE_CFG->{$out_file}->{$METHOD};
    my $url =    $REMOTE_CFG->{$out_file}->{$G_URL};
    my $lmd =    $REMOTE_CFG->{$out_file}->{$LMD};
    my $lm  ;
    my $http_opt;
    my $scheme;
    my $host;
    my $port;
    my $userfile;
    my $status;
    my $remote;
    my $sel = IO::Select->new();
    my @ready;
    my $this_time = time();
    
    if ( $method  =~ /head/i ){
	$http_opt = "HEAD ";
    }else{
	$http_opt = "GET ";
    }
    ( $scheme, $host, $port, $userfile ) = &parseURL( $url );
    if ( $scheme eq 'file'){
      if ( -e $userfile ){
	if ( &file_time($userfile) > $lmd ){
	  cp($userfile, $out_file );
	  return 0;
	}
	return 1;
      }else{
	print STDERR "not exist ",$url," $!\n";
	return 2;
      }
    }else{ #protcol is not 'file'
      if ( $HTTP_PROXY ne "" ){
	( $scheme, $host, $port, $userfile ) = &parseURL( $HTTP_PROXY );
	$http_opt .= "$url HTTP/1.0\n";
	#	    $http_opt .= "$url HTTP/1.1\n";
	$http_opt .= "Host: ".$host."\n";
      }else{
	if ($scheme eq 'dirp' ){
	  $http_opt = "dirp/0.2\n";
	}else{
	  $http_opt .= "$userfile HTTP/1.0\n";
	  #		$http_opt .= "$userfile HTTP/1.1\n";
	  $http_opt .= "Host: $host\n";
	}
      }
      $http_opt .= "User-Agent: $USER_AGENT\n";
      $http_opt .= "Date: ".HTTP::Date::time2str($this_time)."\n";
      $http_opt .= "\n" if ( $scheme eq 'dirp');
      if ( $scheme eq 'dirp' ){
	  $http_opt .= "If-Detected-Modified-Since: ";
	  $http_opt .= HTTP::Date::time2str( $lmd );
	  $http_opt .= "\n";
      }else{
	  $http_opt .= "If-modified-since: ";
	  $http_opt .= HTTP::Date::time2str( $lmd );
	  $http_opt .= "\n";
      }
      if ( $scheme eq 'http'){
	$http_opt .= "Connection: close\n";
      }
      
#      print STDERR  $scheme, $host, $port, $userfile,"\n";
#      print STDERR $http_opt,"\n\n";
      
      $remote = IO::Socket::INET->new( Proto     => "tcp",
				       PeerAddr  => $host,
				       PeerPort  => $port,
				       Timeout   => $CONNECT_TIMEOUT
				     );
      if ($remote) {
	$sel->add($remote);
	$remote->autoflush(1);
	print $remote $http_opt,"\n";
	
	@ready = $sel->can_read($READ_TIMEOUT);
	if ( @ready ){
	  foreach my $sock (@ready){
	    open FILE,">$out_file.$$";
	    binmode FILE;
	    
	    if ( $scheme eq 'http'){
	      $status = <$remote>;
	      $status =~ s/\015\012/\012/og;
	      $status =~ s/\015/\012/og;
	      if ( $method =~ /head/i ){
		my $margin = ( $this_time - $lmd ) / 3;
#		$margin = ( $lmd == 0 ) ? $EXPIRE_MARGIN : $margin ;
#		$margin = ( $margin < $EXPIRE_MARGIN ) ? $EXPIRE_MARGIN : $margin ;
		$margin = ( $ONE_DAY*3  > $margin ) ? $margin : ($ONE_DAY*3);

		print FILE "URL: ", $REMOTE_CFG->{$out_file}->{$R_URL},"\n";
		print FILE "Last-Modified-Detected: ";
		print FILE HTTP::Date::time2str( $this_time ),"\n";
		print FILE "Expire: ";
		print FILE HTTP::Date::time2str( $this_time + $margin),"\n";
		print FILE "Expires: ";
		print FILE HTTP::Date::time2str( $this_time + $margin),"\n";
		print FILE "Authorized: $USER_AGENT\n";
		print FILE "Authorized-Url: $URL\n";
	      }
#	      print FILE "Status: ", $status;
	    }
	    my $header = 1;
	    while(<$remote>){
	      s/\015\012/\012/og;
	      s/\015/\012/og;
	      $header = 0 if ( ( /^$/ ) || ( /^\012$/ ) );
	      if ( ($header == 1 ) && ( /^last-modified:\s*(.*)/i )){
		$lm = HTTP::Date::str2time( $1 );
	      }
	      
	      print FILE;
	      #	    print STDOUT;
	    }
	    close(FILE);
	    close($remote);
	    #	print "Status: $status\n";
	    if ( $status =~ /200/ ){
	      rename "$out_file.$$", $out_file;
	      utime $lm, $lm, $out_file if ( $lm );
	      return 0;
	    }elsif ( $scheme eq 'dirp' ){
	      rename "$out_file.$$", $out_file;
	      return 0;
	    }else{
	      unlink "$out_file.$$";
	      return 1;
	    }
	    
	  }
	}else{
	  print STDERR HTTP::Date::time2str($this_time),"\n";
	  print STDERR "read timeout ",$url,"\n";
	  print STDERR HTTP::Date::time2str( time() ),"\n\n";
	  close($remote);
	  return 2;
	}
      }else{
	print STDERR HTTP::Date::time2str($this_time),"\n";
	print STDERR "cannot open ",$url," $!\n";
	print STDERR HTTP::Date::time2str( time() ),"\n\n";
	return 2;
      }
    }
  }
# 入力 : $url.........URL
#
#
sub parseURL{
    local ($_) = shift;
    my $protcol = 'http';
    my $port = 80;
    my $server;
    my $userfile;

    if ( m%^(\w+://)%o ){
	s%^((\w+)://)%%;
	$protcol = $2;
    }
    unless ( $protcol eq 'file' ){
      s%^([^/:]+)%%;
      $server = $1;
      if ( m%^(:(\d+))%o ){
	s%^(:(\d+))%%o;
	$port = $2;
      }
    }
    $userfile = $_ ;
    $userfile = "/$userfile" unless ( $userfile =~ m%^/% );
    return ( $protcol, $server, $port, $userfile );
}
sub file_time{
    my $file = shift;
    (stat($file))[9] ;
#    (stat($file))[9] - 9 * $ONE_HOUR;
}