--- loncom/publisher/lonpublisher.pm 2000/12/02 20:55:16 1.11 +++ loncom/publisher/lonpublisher.pm 2000/12/04 12:27:58 1.12 @@ -5,7 +5,7 @@ # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # -# 11/28,11/29,11/30,12/01,12/02 Gerd Kortemeyer +# 11/28,11/29,11/30,12/01,12/02,12/04 Gerd Kortemeyer package Apache::lonpublisher; @@ -15,6 +15,7 @@ use Apache::Constants qw(:common :http : use HTML::TokeParser; use Apache::lonxml; use Apache::structuretags; +use Apache::inputtags; use Apache::response; my %addid; @@ -25,6 +26,10 @@ my %cprtag; my %metadatafields; my %metadatakeys; +my $docroot; + +# ----------------------------------------------- Evaluate string with metadata + sub metaeval { my $metastring=shift; @@ -60,6 +65,8 @@ sub metaeval { } } +# -------------------------------------------------------- Read a metadata file + sub metaread { my ($logfile,$fn)=@_; unless (-e $fn) { @@ -76,6 +83,8 @@ sub metaread { return '
Processed file: '.$fn.''; } +# --------------------------------------------------------- Various form fields + sub textfield { my ($title,$name,$value)=@_; return "\n

$title:
". @@ -98,6 +107,8 @@ sub selectbox { return $selout.''; } +# -------------------------------------------------------- Publication Step One + sub publish { my ($source,$target,$style)=@_; @@ -307,7 +318,7 @@ sub publish { my $chparms=''; map { if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) { + unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) { print $logfile 'Obsolete: '.$_."\n"; $chparms.=$_.' '; } @@ -350,9 +361,12 @@ sub publish { } } ($textonly=~m/(\w+)/g); + map { + $keywords{$_}=1; + } split(/\W+/,$metadatafields{'keywords'}); map { - $keywordout.=''; } +# -------------------------------------------------------- Publication Step Two + sub phasetwo { my ($source,$target,$style)=@_; @@ -422,7 +440,6 @@ sub phasetwo { $metadatafields{'title'}=$ENV{'form.title'}; $metadatafields{'author'}=$ENV{'form.author'}; $metadatafields{'subject'}=$ENV{'form.subject'}; - $metadatafields{'keywords'}=$ENV{'form.keywords'}; $metadatafields{'notes'}=$ENV{'form.notes'}; $metadatafields{'abstract'}=$ENV{'form.abstract'}; $metadatafields{'mime'}=$ENV{'form.mime'}; @@ -431,13 +448,193 @@ sub phasetwo { $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; $metadatafields{'owner'}=$ENV{'form.owner'}; $metadatafields{'copyright'}=$ENV{'form.copyright'}; - + + my $allkeywords=$ENV{'form.addkey'}; map { - print $logfile "\n".$_.': '.$metadatafields{$_}. - "\n".$_.'.keys: '.$metadatakeys{$_}; - } sort keys %metadatafields; + if ($_=~/^form\.key\.(\w+)/) { + $allkeywords.=','.$1; + } + } keys %ENV; + $allkeywords=~s/\W+/\,/; + $allkeywords=~s/^\,//; + $metadatafields{'keywords'}=$allkeywords; + + { + print $logfile "\nWrite metadata file for ".$source; + my $mfh; + unless ($mfh=Apache::File->new('>'.$source.'.meta')) { + return + 'Could not write metadata, FAIL'; + } + map { + unless ($_=~/\./) { + my $unikey=$_; + $unikey=~/^([A-Za-z]+)/; + my $tag=$1; + $tag=~tr/A-Z/a-z/; + print $mfh "\n\<$tag"; + map { + my $value=$metadatafields{$unikey.'.'.$_}; + $value=~s/\"/\'\'/g; + print $mfh ' '.$_.'="'.$value.'"'; + } split(/\,/,$metadatakeys{$unikey}); + print $mfh '>'.$metadatafields{$unikey}.''; + } + } sort keys %metadatafields; + $scrout.='

Wrote Metadata'; + print $logfile "\nWrote metadata"; + } + +# ----------------------------------------------------------- Copy old versions + +if (-e $target) { + my $filename; + my $maxversion=0; + $target=~/(.*)\/([^\/]+)\.(\w+)$/; + my $srcf=$2; + my $srct=$3; + my $srcd=$1; + unless ($srcd=~/^\/home\/httpd\/html\/res/) { + print $logfile "\nPANIC: Target dir is ".$srcd; + return "Invalid target directory, FAIL"; + } + opendir(DIR,$srcd); + while ($filename=readdir(DIR)) { + if ($filename=~/$srcf\.(\d+)\.$srct$/) { + $maxversion=($1>$maxversion)?$1:$maxversion; + } + } + closedir(DIR); + $maxversion++; + $scrout.='

Creating old version '.$maxversion; + print $logfile "\nCreating old version ".$maxversion; + + my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; + + { + my $org=Apache::File->new($target); + my $cop; + unless ($cop=Apache::File->new('>'.$copyfile)) { + print $logfile "Unable to open for write ".$copyfile."\n"; + return "Failed to open '.$copyfile. + ', FAIL"; + } + while (my $line=<$org>) { print $cop $line; } + } + if (-e $copyfile) { + print $logfile "Copied old target to ".$copyfile."\n"; + $scrout.='

Copied old target file'; + } else { + print $logfile "Unable to write ".$copyfile."\n"; + return "Failed to copy old target, FAIL"; + } + +# --------------------------------------------------------------- Copy Metadata + + $copyfile=$copyfile.'.meta'; + { + my $org=Apache::File->new($target.'.meta'); + my $cop=Apache::File->new('>'.$copyfile); + while (my $line=<$org>) { print $cop $line; } + } + if (-e $copyfile) { + print $logfile "Copied old target metadata to ".$copyfile."\n"; + $scrout.='

Copied old metadata'; + } else { + print $logfile "Unable to write metadata ".$copyfile."\n"; + return + "Failed to write old metadata copy, FAIL"; + } +} else { + $scrout.='

Initial version'; + print $logfile "\nInitial version"; +} + +# ---------------------------------------------------------------- Write Source + my $copyfile=$target; + + my @parts=split(/\//,$copyfile); + my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; + + my $count; + for ($count=5;$count<$#parts;$count++) { + $path.="/$parts[$count]"; + if ((-e $path)!=1) { + print $logfile "\nCreating directory ".$path; + $scrout.='

Created directory '.$parts[$count]; + mkdir($path,0777); + } + } + + { + my $org=Apache::File->new($source); + my $cop; + unless ($cop=Apache::File->new('>'.$copyfile)) { + print $logfile "Unable to open for write ".$copyfile."\n"; + return "Failed to open '.$copyfile. + ', FAIL"; + } + while (my $line=<$org>) { print $cop $line; } + } + if (-e $copyfile) { + print $logfile "Copied original source to ".$copyfile."\n"; + $scrout.='

Copied source file'; + } else { + print $logfile "Unable to write ".$copyfile."\n"; + return "Failed to copy source, FAIL"; + } + +# --------------------------------------------------------------- Copy Metadata + + my $copyfile=$target.'.meta'; + { + my $org=Apache::File->new($source.'.meta'); + my $cop=Apache::File->new('>'.$copyfile); + while (my $line=<$org>) { print $cop $line; } + } + if (-e $copyfile) { + print $logfile "Copied original metadata to ".$copyfile."\n"; + $scrout.='

Copied metadata'; + } else { + print $logfile "Unable to write metadata ".$copyfile."\n"; + return + "Failed to write metadata copy, FAIL"; + } + +# --------------------------------------------------- Send update notifications + +{ + + my $filename; + + $target=~/(.*)\/([^\/]+)$/; + my $srcf=$2; + opendir(DIR,$1); + while ($filename=readdir(DIR)) { + if ($filename=~/$srcf\.(\w+)$/) { + my $subhost=$1; + if ($subhost ne 'meta') { + $scrout.='

Notifying host '.$subhost.':'; + print $logfile "\nNotifying host '.$subhost.':'"; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + $scrout.=$reply; + print $logfile $reply; + } + } + } + closedir(DIR); + +} + +# ------------------------------------------------ Provide link to new resource + + my $thisdistarget=$target; + $thisdistarget=~s/^$docroot//; + + return $scrout. + '

View Target'; } # ================================================================ Main Handler @@ -472,7 +669,7 @@ sub handler { $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; my $targetdir=''; - my $docroot=$r->dir_config('lonDocRoot'); + $docroot=$r->dir_config('lonDocRoot'); if ($1 ne $ENV{'user.name'}) { $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. ' trying to publish unowned file '.$ENV{'form.filename'}.