--- loncom/publisher/lonpublisher.pm 2000/12/02 20:55:16 1.11
+++ loncom/publisher/lonpublisher.pm 2001/03/22 22:41:01 1.18
@@ -5,17 +5,17 @@
#
# 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,12/23 Gerd Kortemeyer
package Apache::lonpublisher;
use strict;
use Apache::File;
+use File::Copy;
use Apache::Constants qw(:common :http :methods);
use HTML::TokeParser;
use Apache::lonxml;
-use Apache::structuretags;
-use Apache::response;
+use Apache::lonhomework;
my %addid;
my %nokey;
@@ -25,6 +25,10 @@ my %cprtag;
my %metadatafields;
my %metadatakeys;
+my $docroot;
+
+# ----------------------------------------------- Evaluate string with metadata
+
sub metaeval {
my $metastring=shift;
@@ -60,6 +64,8 @@ sub metaeval {
}
}
+# -------------------------------------------------------- Read a metadata file
+
sub metaread {
my ($logfile,$fn)=@_;
unless (-e $fn) {
@@ -76,6 +82,8 @@ sub metaread {
return '
Processed file: '.$fn.'';
}
+# --------------------------------------------------------- Various form fields
+
sub textfield {
my ($title,$name,$value)=@_;
return "\n
$title:
".
@@ -98,6 +106,8 @@ sub selectbox {
return $selout.'';
}
+# -------------------------------------------------------- Publication Step One
+
sub publish {
my ($source,$target,$style)=@_;
@@ -116,16 +126,11 @@ sub publish {
# ----------------------------------------------------------------- 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) {
+ if (copy($source,$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";
+ print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
+ return "Failed to write backup copy, $!,FAIL";
}
# ------------------------------------------------------------- IDs and indices
@@ -284,7 +289,7 @@ sub publish {
# -------------------------------------------------- Parse content for metadata
my $allmeta=Apache::lonxml::xmlparse('meta',$content);
- &metaeval($allmeta);
+# &metaeval($allmeta);
# ---------------- Find and document discrepancies in the parameters and stores
@@ -307,7 +312,7 @@ sub publish {
my $chparms='';
map {
if (($_=~/^parameter/) || ($_=~/^stores/)) {
- unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) {
+ unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) {
print $logfile 'Obsolete: '.$_."\n";
$chparms.=$_.' ';
}
@@ -350,9 +355,12 @@ sub publish {
}
} ($textonly=~m/(\w+)/g);
+ map {
+ $keywords{$_}=1;
+ } split(/\W+/,$metadatafields{'keywords'});
map {
- $keywordout.='
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; + + if (copy($target,$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'; + if (copy($target.'.meta',$copyfile)) { + print $logfile "Copied old target metadata to ".$copyfile."\n"; + $scrout.='
Copied old metadata'; + } else { + print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; + if (-e $target.'.meta') { + 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); + } + } + + if (copy($source,$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 + + $copyfile=$copyfile.'.meta'; + + if (copy($source.'.meta',$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 @@ -451,6 +616,7 @@ sub handler { return OK; } +unless ($ENV{'form.pubdir'}) { # -------------------------------------------------------------- Check filename my $fn=$ENV{'form.filename'}; @@ -472,7 +638,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'}. @@ -544,7 +710,8 @@ unless ($ENV{'form.phase'} eq 'two') { $r->send_http_header; $r->print('