#!/usr/local/bin/jperl
# 
# refdate_html.pl: HTML ファイルの参照日付更新
#
#     Jan.29,'96. OSHIRO Naoki.
#     Feb.09.'96. OSHIRO Naoki. ディレクトリ下のファイルからのリンクを考慮
#     Feb.16.'96. OSHIRO Naoki. NIS サーバ以外のホストでの実行を抑制
#     [1997/05/30] OSHIRO Naoki.
# 
#     $Log:$

# 
#    Usage: refdate_html htmlfile
#
#    次の '??' 部分を更新する．
#
#     1. [19??/??/??]<!-- #REFDATE -->
#          ファイルの更新日に置き換え
#     2. <A HREF="xxx">(??/??)<!-- #REFDATE -->
#          リンク先ファイルの更新日に置き換え
#
#    オプション:
#        '-i' 更新ファイルのバックアップを行う．
#              '-i.bak' などでバックアップファイルの拡張子を指定する．
#

#
# 予定: 指定パス名にディレクトリが含まれていた場合の対応
#         --> そのディレクトリをカレントディレクトリ
#             としてファイル名展開などを行う．
#       ディレクトリを指定された場合の対応
#         --> ディレクトリ下の全 '*.html' ファイルを更新対象にする？
#           --> '-r' の場合は階層に対応する
#       refdate 指定コメント形式の変更？
#         --> HTML のコメント指定を '<!-- -->' と思っていたので
#             ファイルに埋め込むコマンドコメントを '<!-- #REFDATE -->'
#             としたが，実際には HTML のコメントは '<!- ->' で
#             マイナス記号が多かった．形式変更する？（拡張？）
#       NIS への対応
#         --> 
#       Dehtml を施して字面のみを比較の対象にする[1996/04/24]
#         --> 
#

$SIG{'INT'}=
$SIG{'TERM'}=
$SIG{'QUIT'}=
$SIG{'HUP'}= 'cleanup';

$Debug=0;

$progname=$0;
$progname=$1 if ($0=~m#/([^/]+)$#);

$NIS_server='tec101';
$PasswdFile="/etc/passwd";
$refdate="<!-- #REFDATE -->";
$default_htmldir='/usr/local/lib/Web';
$default_htmlhomedir='public_html';
$default_htmlfile='Welcome.html';
$html_ext='.html';

$force=0;
while ($ARGV[0] =~ /^-/) {
    $_ = shift;
    if (/^-i(.*)/) {
	$bak=$1;
    }
    elsif (/^-f/) {
	$force=1;
    }
    elsif (/^-v/) {
	$verbose=1;
    }
    else {
	die "Unrecognized switch: $_\n";
    }
}
if ($ENV{'HOST'} ne $NIS_server) {
    if ($force==1) {
	if ($verbose) {	
		print "$progname: Warning: This host '$ENV{'HOST'}' is not NIS server '$NIS_server', ";
		print "but execute $progname forcely by option '-f'.\n";
	}
    } else {
	print "$progname: Fatal: This host '$ENV{'HOST'}' is not NIS server '$NIS_server', ";
	print "login to the server and execute this command.\n";
	exit 1;
    }
}

&hash_userinfo;

#
# 未実装の機能:ファイル名にディレクトリが含まれている場合の処理
#          --> href ファイルを正しく同定できない．．．
#
foreach $path (@ARGV) {
    unless (-T $path) {
	print STDERR "$path is directory (skip).\n";
	next;
    }
    unless (open(F, "<$path")) {
	print STDERR "Cannot open file $path (skip).\n";
	next;
    }
    
    $tmpfile=&tmpname($path);
    if (!open(T, ">$tmpfile")) {
	print STDERR "Fatal: Cannot open tmp file $tmpfile.\n";
	exit 1;
    }
    select(T);

    $curdir='';
    $href='';
    $f=$path;
    if ($f=~m#(.+/)(.+)$#) {
	$curdir=$1;
	$f=$2;
    }
    while (<F>) {
	$href=$1 if (/<A HREF="([^\"]+)"/);
	if (/\(..\/..\)$refdate/) {
	    print "**********   match: $_" if ($Debug);
	    $pre=$`;
	    $post=$';
	    ($y, $m, $d)=&href_get_mdate($href, $curdir);
	    print "$pre";
	    printf("(%02d/%02d)$refdate", $m, $d);
	    print "$post";
	} elsif (/\(....\/..\/..\)$refdate/) {
	    print "**********   match: $_" if ($Debug);
	    $pre=$`;
	    $post=$';
	    ($y, $m, $d)=&href_get_mdate($href, $curdir);
	    print "$pre";
	    printf("(%04d/%02d/%02d)$refdate", $y, $m, $d);
	    print "$post";
	} elsif (/\(..\/..\/..\)$refdate/) {
	    print "**********   match: $_" if ($Debug);
	    $pre=$`;
	    $post=$';
	    ($y, $m, $d)=&href_get_mdate($href, $curdir);
	    print "$pre";
	    printf("(%02d/%02d/%02d)$refdate", $y-1990, $m, $d);
	    print "$post";
	} elsif (/\[....\/..\/..\]$refdate/) {
	    print "**********   match: $_" if ($Debug);
	    $pre=$`;
	    $post=$';
	    ($y, $m, $d)=&get_mdate($path);
	    print "$pre";
	    printf("[%02d/%02d/%02d]$refdate", $y, $m, $d);
	    print "$post";
	} else {
	    print;
	}
    }
    close(F);
    close(T);
    select(STDOUT);

    if (&diff($path, $tmpfile)) {
	&move($path, "$path$bak") if ($bak);
	&move($tmpfile, $path);
	print STDERR "$path: updated.\n";
    } else {
#	print STDERR "$path: not updated.\n";
    }
    &cleanup;
}
#------------------------------------------

sub href_get_mdate {
    local($href, $curdir)=@_;

    $href=&href_to_file($href);
    $href="$curdir$href" if ($href=~m#^[^/]#);
    ($y, $m, $d)=&get_mdate($href);
}

#
# 未実装の機能:
#    'http://host/' としてユーザ名・ファイル名の指定無しの場合
#    'file' としてた場合のディレクトリ名の補完
#
sub href_to_file {
    local($_)=@_;
print "***** $_ ---> " if ($Debug);
    s/^http://;
    s#//[^/]+##;
    $_=$default_htmldir . $_ if (m#^/[^~]#);
    $_=$USER_home{$1} . "/$default_htmlhomedir" . $' if (s#^/~([^/]+)##);
    s/#.+//;			       
print "(user:$1) $_\n" if ($Debug);
    $_.=$default_htmlfile if (m#/$#);
    $_.=$html_ext unless (/$html_ext$/);
    return $_;
}

sub get_mdate {
    local($filename)=@_;
print "********* ---> stat($filename)\n" if ($Debug);
    local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	  $atime,$mtime,$ctime,$blksize,$blocks)
	= stat($filename);
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime($mtime);
print "********* ---> " if ($Debug);
printf("  %02d:%02d:%02d %02d/%02d/%02d\n", 
       $hour, $min, $sec, 1900+$year, $mon+1, $mday) if ($Debug);
    return (1900+$year, $mon+1, $mday, $hour, $min, $sec);
}

sub hash_userinfo {
    local($info, $user);

    unless (open(P, "<$PasswdFile")) {
	print STDERR "Warning: Cannot open $PASSWD file.\n";
	return;
    }

    while (<P>) {
	next if /^\+/;
	@info=split(':');
	$user=$info[0];
	$USER_realname{$user}=$info[4];
	$USER_home{$user}=$info[5];
	$USER_shell{$user}=$info[6];
    }
    close(P);
}

sub tmpname {
    local($_)=@_;
    s#/#_#g;
    "/tmp/upd_html$_$$";
}

sub cleanup {
    unlink($tmpfile);
}

sub fatal {
    print STDERR $_[0],"\n";
    &cleanup;
}

sub move {
    local($from, $to)=@_;
#    local(IN, OUT);

    return if $from eq $to;
    open(IN, "<$from") || die "Can't open $from.\n";
    open(OUT, ">$to") || die "Can't open $to.\n";;

      # system "/bin/mv -f $from $to";
    while (<IN>) {
	print OUT;
    }
    close(OUT);
    close(IN);
    #&fatal("Can't move $from to $to") if $?;
    unlink("from");
}

sub diff {
    local($file1, $file2)=@_;
    system "/usr/bin/diff $file1 $file2 > /dev/null";
    $? >> 8;
}

#
# end of upd_html.pl
#

# major-mode: perl