$title:
".
+ '';
+}
+
+sub hiddenfield {
+ my ($name,$value)=@_;
+ return "\n".'';
+}
+
+sub selectbox {
+ my ($title,$name,$value,%options)=@_;
+ my $selout="\n
$title:
".'';
+}
+
+# -------------------------------------------------------- Publication Step One
sub publish {
+
my ($source,$target,$style)=@_;
my $logfile;
+ my $scrout='';
+
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
- return 'No write permission to user directory, FAIL';
+ return
+ 'No write permission to user directory, FAIL';
}
print $logfile
-"\n\n================== Publish ".localtime()." =================\n";
+"\n\n================= Publish ".localtime()." Phase One ================\n";
+
+ if (($style eq 'ssi') || ($style eq 'rat')) {
+# ------------------------------------------------------- This needs processing
+
+# ----------------------------------------------------------------- Backup Copy
+ my $copyfile=$source.'.save';
+ {
+ my $org=Apache::File->new($source);
+ my $cop=Apache::File->new('>'.$copyfile);
+ while (my $line=<$org>) { print $cop $line; }
+ }
+ if (-e $copyfile) {
+ print $logfile "Copied original file to ".$copyfile."\n";
+ } else {
+ print $logfile "Unable to write backup ".$copyfile."\n";
+ return "Failed to write backup copy, FAIL";
+ }
+# ------------------------------------------------------------- IDs and indices
+
+ my $maxindex=10;
+ my $maxid=10;
+ my $content='';
+ my $needsfixup=0;
+
+ {
+ my $org=Apache::File->new($source);
+ $content=join('',<$org>);
+ }
+ {
+ my $parser=HTML::TokeParser->new(\$content);
+ my $token;
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $counter;
+ if ($counter=$addid{$token->[1]}) {
+ if ($counter eq 'id') {
+ if (defined($token->[2]->{'id'})) {
+ $maxid=
+ ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
+ } else {
+ $needsfixup=1;
+ }
+ } else {
+ if (defined($token->[2]->{'index'})) {
+ $maxindex=
+ ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
+ } else {
+ $needsfixup=1;
+ }
+ }
+ }
+ }
+ }
+ }
+ if ($needsfixup) {
+ print $logfile "Needs ID and/or index fixup\n".
+ "Max ID : $maxid (min 10)\n".
+ "Max Index: $maxindex (min 10)\n";
+
+ my $outstring='';
+ my $parser=HTML::TokeParser->new(\$content);
+ my $token;
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $counter;
+ if ($counter=$addid{$token->[1]}) {
+ if ($counter eq 'id') {
+ if (defined($token->[2]->{'id'})) {
+ $outstring.=$token->[4];
+ } else {
+ $maxid++;
+ my $thisid=' id="'.$maxid.'"';
+ my $fixup=$token->[4];
+ $fixup=~s/(\<\w+)/$1$thisid/;
+ $outstring.=$fixup;
+ print $logfile 'ID: '.$fixup."\n";
+ }
+ } else {
+ if (defined($token->[2]->{'index'})) {
+ $outstring.=$token->[4];
+ } else {
+ $maxindex++;
+ my $thisindex=' index="'.$maxindex.'"';
+ my $fixup=$token->[4];
+ $fixup=~s/(\<\w+)/$1$thisindex/;
+ $outstring.=$fixup;
+ print $logfile 'Index: '.$fixup."\n";
+ }
+ }
+ } else {
+ $outstring.=$token->[4];
+ }
+ } elsif ($token->[0] eq 'E') {
+ $outstring.=$token->[2];
+ } else {
+ $outstring.=$token->[1];
+ }
+ }
+ {
+ my $org;
+ unless ($org=Apache::File->new('>'.$source)) {
+ print $logfile "No write permit to $source\n";
+ return
+ "No write permission to $source, FAIL";
+ }
+ print $org $outstring;
+ }
+ $content=$outstring;
+ print $logfile "End of ID and/or index fixup\n".
+ "Max ID : $maxid (min 10)\n".
+ "Max Index: $maxindex (min 10)\n";
+ } else {
+ print $logfile "Does not need ID and/or index fixup\n";
+ }
+
+# --------------------------------------------- Initial step done, now metadata
+
+# ---------------------------------------- Storage for metadata keys and fields
+
+ %metadatafields=();
+ %metadatakeys=();
+
+ my %oldparmstores=();
+
+# ------------------------------------------------ First, check out environment
+ unless (-e $source.'.meta') {
+ $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
+ $ENV{'environment.middlename'}.' '.
+ $ENV{'environment.lastname'}.' '.
+ $ENV{'environment.generation'};
+ $metadatafields{'author'}=~s/\s+/ /g;
+ $metadatafields{'author'}=~s/\s+$//;
+ $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
+
+# ------------------------------------------------ Check out directory hierachy
+
+ my $thisdisfn=$source;
+ $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///;
+
+ my @urlparts=split(/\//,$thisdisfn);
+ $#urlparts--;
+
+ my $currentpath='/home/'.$ENV{'user.name'}.'/';
+
+ map {
+ $currentpath.=$_.'/';
+ $scrout.=&metaread($logfile,$currentpath.'default.meta');
+ } @urlparts;
+
+# ------------------- Clear out parameters and stores (there should not be any)
+
+ map {
+ if (($_=~/^parameter/) || ($_=~/^stores/)) {
+ delete $metadatafields{$_};
+ }
+ } keys %metadatafields;
+
+ } else {
+# ---------------------- Read previous metafile, remember parameters and stores
+
+ $scrout.=&metaread($logfile,$source.'.meta');
+
+ map {
+ if (($_=~/^parameter/) || ($_=~/^stores/)) {
+ $oldparmstores{$_}=1;
+ delete $metadatafields{$_};
+ }
+ } keys %metadatafields;
+
+ }
+
+# -------------------------------------------------- Parse content for metadata
+
+ my $allmeta=Apache::lonxml::xmlparse('meta',$content);
+ &metaeval($allmeta);
+
+# ---------------- Find and document discrepancies in the parameters and stores
+
+ my $chparms='';
+ map {
+ if (($_=~/^parameter/) || ($_=~/^stores/)) {
+ unless ($_=~/\.\w+$/) {
+ unless ($oldparmstores{$_}) {
+ print $logfile 'New: '.$_."\n";
+ $chparms.=$_.' ';
+ }
+ }
+ }
+ } sort keys %metadatafields;
+ if ($chparms) {
+ $scrout.='
New parameters or stored values: '. + $chparms; + } + + my $chparms=''; + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) { + print $logfile 'Obsolete: '.$_."\n"; + $chparms.=$_.' '; + } + } + } sort keys %oldparmstores; + if ($chparms) { + $scrout.='
Obsolete parameters or stored values: '. + $chparms; + } + +# ------------------------------------------------------- Now have all metadata + + $scrout.= + '
'; +} + +# -------------------------------------------------------- Publication Step Two + +sub phasetwo { + + my ($source,$target,$style)=@_; + my $logfile; + my $scrout=''; + + unless ($logfile=Apache::File->new('>>'.$source.'.log')) { + return + 'No write permission to user directory, FAIL'; + } + print $logfile +"\n================= Publish ".localtime()." Phase Two ================\n"; + + %metadatafields=(); + %metadatakeys=(); - my $version=''; + &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'})); + + $metadatafields{'title'}=$ENV{'form.title'}; + $metadatafields{'author'}=$ENV{'form.author'}; + $metadatafields{'subject'}=$ENV{'form.subject'}; + $metadatafields{'notes'}=$ENV{'form.notes'}; + $metadatafields{'abstract'}=$ENV{'form.abstract'}; + $metadatafields{'mime'}=$ENV{'form.mime'}; + $metadatafields{'language'}=$ENV{'form.language'}; + $metadatafields{'creationdate'}=$ENV{'form.creationdate'}; + $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; + $metadatafields{'owner'}=$ENV{'form.owner'}; + $metadatafields{'copyright'}=$ENV{'form.copyright'}; + + my $allkeywords=$ENV{'form.addkey'}; + map { + 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 - return 'Version '.$version.', SUCCESS'; +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 @@ -49,10 +658,18 @@ sub handler { return HTTP_NOT_FOUND; } + unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) { + $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + $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'}. @@ -72,8 +689,52 @@ sub handler { return HTTP_NOT_FOUND; } +unless ($ENV{'form.phase'} eq 'two') { + # --------------------------------- File is there and owned, init lookup tables + %addid=(); + + { + my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab'); + while (<$fh>=~/(\w+)\s+(\w+)/) { + $addid{$1}=$2; + } + } + + %nokey=(); + + { + my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); + map { + my $word=$_; + chomp($word); + $nokey{$word}=1; + } <$fh>; + } + + %language=(); + + { + my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab'); + map { + $_=~/(\w+)\s+([\w\s\-]+)/; + $language{$1}=$2; + } <$fh>; + } + + %cprtag=(); + + { + my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab'); + map { + $_=~/(\w+)\s+([\w\s\-]+)/; + $cprtag{$1}=$2; + } <$fh>; + } + +} + # ----------------------------------------------------------- Start page output $r->content_type('text/html'); @@ -103,13 +764,16 @@ sub handler { $r->print('
'); - + # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle - $r->print('Result: '.&publish($thisfn,$thistarget,$thisembstyle)); - - } + unless ($ENV{'form.phase'} eq 'two') { + $r->print('