eval '(exit $?0)' && eval '[ -f /usr/local/bin/perl ] && exec /usr/local/bin/perl -S $0 ${1+"$@"}; exec perl -S $0 ${1+"$@"};'
& eval 'if ( -f /usr/local/bin/perl ) exec /usr/local/bin/perl -S $0 $argv:q ; exec perl -S $0 $argv:q'
     if 0;

# @(#)[Hyper-G] [SDA] loadwww      1.04 [insert www server] [Gerald Pani]

#<copyright>
# 
# Copyright (c) 1995
# Institute for Information Processing and Computer Supported New Media (IICM),
# Graz University of Technology, Austria.
# 
#</copyright>

#<file>
#
# Name:       loadwww
#
# Purpose:    WWW-Server to Hyper-G-Server
#
# Created:     6 Oct 95    Gerald Pani
#
# Description:
#
# Usage: see below
# 
#</file>
#
# $Id: loadwww.pl,v 1.8 1995/12/06 07:35:13 gpani Exp $
#
# loadwww 1.02  1995/11/23 13:34:51  gpani
# o New option -replace
#
# loadwww 1.01  1995/11/22 13:34:58  gpani
# o multiple Name-attributes of collections
#


$usage = "usage: $0 [options] \n\n
        -h                           Help message.
        -basedir basedir             Path to the WWW-Servers '/'-directory.
                                     Default is '.'
        -startdir startdir           Default is basedir.
        -nochanges                   No insertions; scan directories only.
        -html                        Insert only html-documents.
        -txt                         Insert only txt-documents (not implemented).
        -ps                          Insert only ps-documents.
        -image                       Insert only image-documents.
        -movie                       Insert only movie-documents.
        -sound                       Insert only sound-documents.
        -hmc                         Insert only hmc-documents.
        -coll                        Insert only collections.
        -other                       Prints all other files.
        -links                       Insert only links.
        -hghost hghost               Hyper-G host.
        -hopo hostport               hostport of WWW server to insert 
                                     (e.g. 'fvkma.tu-graz.ac.at:8000').
        -nonrecursive                Insert only content of startdir.
        -strict                      Strict parsing of HTML files.
        -exist                       Don't try to insert if document exists.
        -replace                     Replace existing documents.
        -identify ['user[ passwd]']  Use or prompt for user and password.
";

$help = "

To load your WWW-Data into your Hyper-G Server invoke as hgsystem

  loadwww -basedir path_to_www_root -hopo official_host_name[:port_if_not_80]

Note: A collection having 'Name=/' must exist in your Hyper-G server.

";

$baseDir = '.';
$startDir = '';

$insHtml = 0;
$insTxt = 0;
$insPs = 0;
$insHmc = 0;
$insImage = 0;
$insMovie = 0;
$insSound = 0;
$insColl = 0;
$insOthers = 0;
$insLinks = 0;
$nochanges = 0;
$exist = 0;
$replace = 0;

$autoCollHead = 1;

$hghost = $ENV{'HGHOST'} || 'hyperg';
$hostport = $hghost;
$recursive = 1;
$permissive = 1;
$identify = 0;
$user = '';
$passwd = '';

$logFile = '';
$inFile = '';

select(STDOUT); $| = 1;		# unbuffered STDOUT

while ($ARGV[0]) {
    $_ = shift;
    /^-(h|help)$/ && (print("$usage\n$help\n"), exit(0));
    /^-base/ && ($baseDir = shift, next);
    /^-coll/ && ($insColl = 1, next);
    /^-exis/ && ($exist = 1, next);
    /^-hgho/ && ($hghost = shift, next);
    /^-hmc/ && ($insHmc = 1, next);
    /^-hopo/ && ($hostport = shift, next);
    /^-html/ && ($insHtml = 1, next);
    /^-imag/ && ($insImage = 1, next);
    /^-infi/ && ($inFile = shift, next);
    /^-link/ && ($insLinks = 1, next);
    /^-logf/ && ($logFile = shift, next);
    /^-movi/ && ($insMovie = 1, next);
    /^-noch/ && ($nochanges = 1, next);
    /^-nonr/ && ($recursive = 0, next);
    /^-othe/ && ($insOthers = 1, next);
    /^-ps/ && ($insPs = 1, next);
    /^-repl/ && ($replace = 1, next);
    /^-soun/ && ($insSound = 1, next);
    /^-star/ && ($startDir = shift, next);
    /^-stri/ && ($permissive = 0, next);
    /^-txt/ && ($insTxt = 1, next);
    if (/^-iden/) {
	if ($ARGV[0] && !($ARGV[0] =~ /^-/)) {
	    local( $idenData) = shift;
	    ($user, $passwd) = split(/\s+/, $idenData);
	}
	$identify = 1;
	next;
    }

    die "$usage";
}

$exist = 1 if $replace;

if (!$insHtml && !$insPs && !$insHmc && !$insImage && !$insMovie 
    && !$insSound && !$insColl && !$insOthers && !$insLinks && !$insTxt) {
    $insHtml = 1;
    $insPs = 1;
    $insHmc = 1;
    $insImage = 1;
    $insMovie = 1;
    $insSound = 1;
    $insColl = 1;
    $insOthers = 1;
    $insLinks = 1;
    $insTxt = 1;
}

if ($identify) {
    while (!$user) {
	print "Username: ";
	chop($user = <STDIN>);
    }
    while (!$passwd) {
	print "Password: ";
	system('stty -echo');
	chop($passwd = <STDIN>);
	system('stty echo');
	print "\n";
    }
}

%ignored = ();

if ($inFile) {
    open(INFILE, "< $inFile") || die "Error: open $inFile: $!\n";
    while (<INFILE>) {
	(/^IGNORED\s+\/(.+)$/) && ($ignored{$1} = 1);
    }
    close(INFILE);
}

if ($logFile) {
    open( LOG, "> $logFile") || die "$0: Error: open $logFile: $!\n";
}

$startDir = $baseDir unless $startDir;

$invokeDir = &Pwd();
chdir($baseDir) || die $!;
$baseDir = &Pwd();
chdir($invokeDir) || die $!;
chdir($startDir) || die "Error: $startDir: $!\n";
$startDir = &Pwd();
if (!($startDir =~ /^$baseDir/)) {
    die "$baseDir is not a prefix of $startDir\n";
}

%haveDirs = ();

@addNames = ();
@addNamesOf = ();

@subSrcDirs = ();

if ($logFile) {
    open( STDOUT, ">&LOG") || die "$0: Error: dup STDOUT: $!\n";
    open( STDERR, ">&LOG") || die "$0: Error: dup STDERR: $!\n";
}

&loadWWW( $startDir);

if ($recursive) {
  while( @subSrcDirs) {
    @srctodo = @subSrcDirs;
    @subSrcDirs = ();
    while ($s = shift(@srctodo)) {
      &loadWWW( $s);
    }
  }
}

while( @addNames && @addNamesOf) {
    local( $aName) = shift( @addNames);
    local( $aNameOf) = shift( @addNamesOf);
    local($doit) = 1;
    print "   adding name $aName to $aNameOf\n";
    next if $nochanges;
    if ($exist) {
	local(@ids1) = &exists( $aNameOf);
	local(@ids2) = &exists( $aName);
	$doit = 0 if (@ids1 && @ids1 == @ids2);
    }
    while( $doit) {
	local($stat) = &addName( $aNameOf, $aName) || last;
	print "ERROR: NAME $aName NOT UNIQUE\n" if ($stat == 17);
	print "ERROR: NAME $aNameOf NOT FOUND\n"     if $stat == -2;
	print "ERROR: NOT IDENTIFIED\n"           if $stat == -7;
	if ($logFile) {
	    print "IGNORED /$aName\n";
	    last;
	}
	local( $resp);
	print "failed: retry, ignore? ([r]/i) ";
	$resp = <STDIN>;
	last if ($resp =~ /^[Ii]/);
    }
}

exit(0);


sub loadWWW {
    local( $srcDir) = @_;
    local($tmp) = $srcDir;
    $tmp =~ s/^$baseDir//;
    print "-- scanning: $tmp -------------\n";

    if (!opendir(DIR, $srcDir)) {
	print "Warning: can't open $srcDir: $!\n";
	return;
    }
    chdir($srcDir) || die $!;
    local( $absDir);
    $absDir = &Pwd();
    if ($haveDirs{$absDir}) {  
	chdir($startDir) || die $!;
	return;
    }
    else {
	$haveDirs{$absDir} = 1;
    }

    if ($insColl) {
	&insertColl( $srcDir);
    }

    local( @allFiles) = sort(grep(!/^\.\.?$/, readdir(DIR)));
    closedir(DIR);
    @allLinks = grep(-l, @allFiles);
    @allFiles = grep(! -l, @allFiles);
    local( @allDirs) = grep( -d, @allFiles);
    local( $tDir);
    foreach $tDir (@allDirs) {
	push( @subSrcDirs, "$srcDir/$tDir");
    }
    @allFiles =  grep(! -d, @allFiles);

    if ($insLinks) {
	local( $linkFile);
	foreach $linkFile (@allLinks) {
	    local($link) = readlink($linkFile);
	    if (!($link =~ /^\//)) {
		# relative
		$link = "$absDir/$link";
	    }
	    $link =~ s/\/[^\/]+\/\.\.\//\// while ($link =~ /\/[^\/]+\/\.\.\//);
	    $link =~ s/^$absDir/$srcDir/;
	    if (-d $link) {
		if ($link =~ /^$baseDir/) {
		    $link =~ s/^$baseDir//;
		    $linkFile = "$srcDir/$linkFile";
		    $linkFile =~ s/^$baseDir//;
		    $linkFile =~ s/^\/// unless $linkFile eq '/';
		    $link =~ s/^\/// unless $link eq '/';
		    print "   link: ADD Name=$linkFile TO COLLECTION $link\n";
		    push( @addNames, $linkFile);
		    push( @addNamesOf, $link);
		}
		elsif ($logFile) {
		    # outside
		    print "   DESTINATION OF LINK IS OUTSIDE\n     $linkFile -> $link\n";
		    push( @subSrcDirs, "$srcDir/$linkFile");
		}
		else {
		    # outside
		    print "   DESTINATION OF LINK IS OUTSIDE\n     $linkFile -> $link\n  follow link, ignore? ([f]/i)";
		    local( $resp);
		    $resp = <STDIN>;
		    push( @subSrcDirs, "$srcDir/$linkFile") unless ($resp =~ /^[Ii]/);
		}
	    }
	    elsif (-f $link) {
		if ($link =~ /^$baseDir/) {
		    $link =~ s/^$baseDir//;
		    $linkFile = "$srcDir/$linkFile";
		    $linkFile =~ s/^$baseDir//;
		    $linkFile =~ s/^\/// unless $linkFile eq '/';
		    $link =~ s/^\/// unless $link eq '/';
		    print "   link: ADD Name=$linkFile TO DOCUMENT $link\n";
		    push( @addNames, $linkFile);
		    push( @addNamesOf, $link);
		}
		elsif ($logFile) {
		    # outside
		    print "   DESTINATION OF LINK IS OUTSIDE\n     $linkFile -> $link\n";
		    push( @allFiles, $linkFile);
		}
		else {
		    # outside
		    print "   DESTINATION OF LINK IS OUTSIDE\n     $linkFile -> $link\n  follow link, ignore? ([f]/i)";
		    local( $resp);
		    $resp = <STDIN>;
		    push( @allFiles, $linkFile) unless ($resp =~ /^[Ii]/);
		}
	    }
	    elsif (!(-e $link)) {
		print "ERROR: DESTINATION OF LINK MISSING\n  $linkFile -> $link\n";
	    }
	    elsif (!(-r $link)) {
		print "ERROR: DESTINATION OF LINK NOT READABLE\n  $linkFile -> $link\n";
	    }
	    else {
		print "ERROR: DESTINATION OF LINK IS UNKNOWN\n  $linkFile -> $link\n";
	    }
	}
    }
    @htmlFiles = grep(/^.*\.(html|htm)$/, @allFiles);
    @allFiles = grep(! /^.*\.(html|htm)$/, @allFiles);
    @imageFiles = grep(/^.*\.(bmp|tif|gif|jpg|xpm|ppm|xbm|pbm)$/, @allFiles);
    @allFiles = grep(! /^.*\.(bmp|tif|gif|jpg|xpm|ppm|xbm|pbm)$/, @allFiles);
    @movieFiles = grep(/^.*\.(mpg)$/, @allFiles);
    @allFiles = grep(! /^.*\.(mpg)$/, @allFiles);
    @soundFiles = grep(/^.*\.(wav|au)$/, @allFiles);
    @allFiles = grep(! /^.*\.(wav|au)$/, @allFiles);
    @txtFiles = grep(/^.*\.txt$/, @allFiles);
    @allFiles = grep(! /^.*\.txt$/, @allFiles);
    @psFiles = grep(/^.*\.ps$/, @allFiles);
    @allFiles = grep(! /^.*\.ps$/, @allFiles);
    @hmcFiles = grep(/^.*\.hmc$/, @allFiles);
    @allFiles = grep(! /^.*\.hmc$/, @allFiles);
    @allFiles = grep(! /^.*~$/, @allFiles);
    @allFiles = grep(! /^.*\.(bak|gz|Z)$/, @allFiles);

    if ($insHtml) {
	local( $htmlFile);
	foreach $htmlFile (@htmlFiles) {
	    &insHtmlFile( $htmlFile, $srcDir);
	}
	if ($autoCollHead) {
	    local($collHead) = '';
	    $collHead = (grep(/^welcome\.(html|htm)$/, @htmlFiles))[0];
	    $collHead = (grep(/^index\.(html|htm)$/, @htmlFiles))[0] unless $collHead;
	    $collHead = (grep(/^home\.(html|htm)$/, @htmlFiles))[0] unless $collHead;
	    if ($collHead) {
		&addCollHead( $collHead, $srcDir);
	    }
	}
    }
    if ($insImage) {
	local( $imageFile);
	foreach $imageFile (@imageFiles) {
	    &insDocFile( $imageFile, $srcDir, 'I');
	}
    }
    if ($insMovie) {
	local( $movieFile);
	foreach $movieFile (@movieFiles) {
	    &insDocFile( $movieFile, $srcDir, 'M');
	}
    }
    if ($insSound) {
	local( $soundFile);
	foreach $soundFile (@soundFiles) {
	    &insDocFile( $soundFile, $srcDir, 'S');
	}
    }
    if ($insTxt) {
	local( $txtFile);
	foreach $txtFile (@txtFiles) {
	    # &insDocFile( $txtFile, $srcDir, 'Ascii');
	    print "   SORRY NO .txt-files $txtFile\n";
	}
    }
    if ($insPs) {
	local( $psFile);
	foreach $psFile (@psFiles) {
	    &insDocFile( $psFile, $srcDir, 'P');
	}
    }
    if ($insHmc) {
	local( $hmcFile);
	foreach $hmcFile (@hmcFiles) {
	    &insDocFile( $hmcFile, $srcDir, 'G', 'hmcpage');
	}
    }
    if ($insOthers) {
	local( $othFile);
	foreach $othFile (@allFiles) {
	    print "   unknown $othFile\n";
	}
    }
    chdir($startDir) || die $!;

}

sub insHtmlFile {
    local($file, $dir) = @_;
    $dir =~ s/^$baseDir//;
    $dir =~ s/^\///;
    local($fcoll) = $dir;
    $fcoll =~ s/[\/]+$//;
    local($base, $name);
    if ($fcoll) {
	$base = "http://$hostport/$fcoll/";
	$name = "$fcoll/$file";
    }
    else {
	$base = "http://$hostport/";
	$name = $file;
	$fcoll = '/' unless $fcoll;
    }
    print "   insert HTML $file\n";
    if (!$nochanges) {
	local($repl) = $replace;
	if ($repl) {
	    $repl = 0 unless &exists($name);
	}
	elsif ($exist) {
	    return if &exists($name);
	}
	local($strict) = $permissive ? '' : '-strict';
	local($replStr) = $repl ? $name : '';
	while( 1) {
	    local($stat) = &hginstext( $file, $fcoll, $base, $strict, $replStr) || last;
	    print "ERROR: NAME $name NOT UNIQUE\n" if $stat == 17;
	    print "ERROR: NOT IDENTIFIED\n" if $stat == -7;
	    if ($logFile) {
		print "IGNORED /$name\n";
		last;
	    }
	    local( $resp);
	    if ($permissive) {
		print "failed: retry, ignore? ([r]/i) ";
	    }
	    else {
		print "failed: retry, retry permissive, ignore? ([r]/p/i) ";
	    }
	    $resp = <STDIN>;
	    last if ($resp =~ /^[Ii]/);
	    $strict = '' if ($resp =~ /^[Pp]/);
	}
    }
    return;
}

sub addCollHead {
    local($file, $dir) = @_;
    $dir =~ s/^$baseDir//;
    $dir =~ s/^\///;
    local($fcoll) = $dir;
    $fcoll =~ s/[\/]+$//;
    local($name);
    if ($fcoll) {
	$name = "$fcoll/$file";
    }
    else {
	$name = $file;
	$fcoll = '/' unless $fcoll;
    }
    print "   CollectionHead $file\n";
    if (!$nochanges) {
	return if (&existAttr($name, 'PresentationHints', 'FullCollectionHead'));
	while( 1) {
	    local($stat) = &addAttribute( $name, 'PresentationHints', 'FullCollectionHead') || last;
	    if ($logFile) {
		print "IGNORED /$name\n";
		last;
	    }
	    local( $resp);
	    print "failed: retry, ignore? ([r]/i) ";
	    $resp = <STDIN>;
	    last if ($resp =~ /^[Ii]/);
	}
    }
    return;
}

sub insDocFile {
    local($file, $dir, $type, $subType) = @_;
    $dir =~ s/^$baseDir//;
    $dir =~ s/^\///;
    local($fcoll) = $dir;
    $fcoll =~ s/[\/]+$//;
    local($name);
    if ($fcoll) {
	$name = "$fcoll/$file";
    }
    else {
	$name = "$file";
	$fcoll = '/' unless $fcoll;
    }
    print "   insert $type $file\n";
    if (!$nochanges) {
	local($repl) = $replace;
	if ($repl) {
	    $repl = 0 unless &exists($name);
	}
	elsif ($exist) {
	    return if &exists($name);
	}
	local($replStr) = $repl ? $name : '';
	while( 1) {
	    local($stat) = &hginsdoc( $file, $fcoll, $name, $type, $subType, $replStr) || last;
	    print "ERROR: NAME $name NOT UNIQUE\n" if $stat == 17;
	    print "ERROR: NOT IDENTIFIED\n" if $stat == -7;
	    if ($logFile) {
		print "IGNORED /$name\n";
		last;
	    }
	    local( $resp);
	    print "failed: retry, ignore? ([r]/i) ";
	    $resp = <STDIN>;
	    last if ($resp =~ /^[Ii]/);
	}
    }
    return;
}

sub insertColl {
     local($dir) = @_;
     $dir =~ s/^$baseDir//;
     $dir =~ s/^\///;
     return unless $dir;
     print "   insert Collection $dir\n";
     if (!$nochanges) {
	 return if ($exist && &exists("$dir"));
	 while( 1) {
	     local($stat) = &hginscoll( $dir) || last;
	     print "ERROR: NAME $dir NOT UNIQUE\n" if $stat == 17;
	     print "ERROR: NOT IDENTIFIED\n" if $stat == -7;
	     if ($logFile) {
		 print "IGNORED /$dir\n";
		 last;
	     }
	     local( $resp);
	     print "failed: retry, ignore? ([r]/i) ";
	     $resp = <STDIN>;
	     last if ($resp =~ /^[Ii]/);
	 }
     }
     return;
}

sub hginscoll {
    local($dir) = @_;
    local($fcoll) = $dir;
    $fcoll =~ s/[^\/]*$//;
    $fcoll =~ s/\/$//;
    $fcoll = '/' unless $fcoll;
    local( $ret) = '';
    print "hginscoll -hgho $hghost -pname $fcoll -title /$dir -name $dir \n";
    $ret = $identify 
	? `hginscoll -hgho $hghost -pname $fcoll -title /$dir -name $dir -iden \'$user $passwd\'`
	    : `hginscoll -hgho $hghost -pname $fcoll -title /$dir -name $dir `;
    local($stat) = $? >> 8;
    $stat = unpack('c', pack( 'c', $stat));
    print "Error in hginscoll: $stat\n" if $stat;
    return $stat;
}

sub hginstext {
    local($file, $fcoll, $base, $strict, $repl) = @_;
    local( $ret) = '';
    local($comm) = "hginstext -hghost $hghost $strict -base $base ";
    $comm .= $repl ? "-replace $repl " : "-pname $fcoll ";
    print "$comm $file \n";
    $comm .= "-iden \'$user $passwd\' -file " if $identify;
    $comm .= "\'$file\' ";
    $ret = `$comm`;
    local($stat) = $? >> 8;
    $stat = unpack('c', pack( 'c', $stat));
    print "Error in hginstext: $stat\n" if $stat;
    return $stat;
}

sub hginsdoc {
    local($file, $fcoll, $name, $type, $subType, $repl) = @_;
    local( $ret) = '';
    local($comm) = "hginsdoc -hghost $hghost ";
    $comm .= $repl 
	? "-replace $repl " : "-pname $fcoll -type $type -form -title \'Title=en:$file\\Name=$name\' ";
    $comm .= "-path \'$file\' ";
    $comm .= "-subtype $subType " if ($subType && !$repl);
    print "$comm \n";
    if ($identify) {
	$comm = "$comm -iden \'$user $passwd\'";
    }
    $ret = `$comm`;
    local($stat) = $? >> 8;
    $stat = unpack('c', pack( 'c', $stat));
    print "Error in hginsdoc: $stat\n" if $stat;
    return $stat;
}

sub addName {
    local($name, $addName) = @_;
    local( $ret) = '';
    local($comm) = "hgmodify -hghost $hghost -form -key Name=$name -comm \'add Name=$addName\'";
    if ($identify) {
	$comm = "$comm -iden \'$user $passwd\'";
    }
    $ret = `$comm`;
    local($stat) = $? >> 8;
    $stat = unpack('c', pack( 'c', $stat));
    print "Error in hgmodify: $stat\n" if $stat;
    return $stat;
}

sub addAttribute {
    local($name, $attr, $value) = @_;
    local( $ret) = '';
    local($comm) = "hgmodify -hghost $hghost -form -key Name=$name -comm \'add $attr=$value\'";
    if ($identify) {
	$comm = "$comm -iden \'$user $passwd\'";
    }
    $ret = `$comm`;
    local($stat) = $? >> 8;
    $stat = unpack('c', pack( 'c', $stat));
    print "Error in hgmodify: $stat\n" if $stat;
    return $stat;
}

sub exists {
    local($name) = @_;
    local( @ret) = ();
    local($comm) = "hginfo -hghost $hghost -form -key Name=$name -ids";
    if ($identify) {
	$comm = "$comm -iden \'$user $passwd\'";
    }
    @ret = split(/[\s\n]+/, `$comm`);
    local($stat) = $? >> 8;
    $stat = unpack('c', pack( 'c', $stat));
    die "Error in hginfo: $stat\n" if $stat;
    return @ret;
}

sub existAttr {
    local($name, $attr, $value) = @_;
    local( @ret) = ();
    local($comm) = "hginfo -hghost $hghost -form -key Name=$name -query \'$attr=$value\' -ids";
    if ($identify) {
	$comm = "$comm -iden \'$user $passwd\'";
    }
    @ret = split(/[\s\n]+/, `$comm`);
    local($stat) = $? >> 8;
    $stat = unpack('c', pack( 'c', $stat));
    die "Error in hginfo: $stat\n" if $stat;
    return @ret;
}

sub Pwd {
    local($pwd);
    local($dd,$di) = stat('.');
    chop($pwd = `pwd`);
    die "Pwd:pwd empty\n" if (!$pwd);
    chdir( $pwd) || die "Pwd:chdir current:$!\n";
    local($pd,$pi) = stat('.');
    die "Pwd:dev or ino not equal\n" if ($di != $pi || $dd != $pd);
    return $pwd;
}

    
