[LON-CAPA-cvs] cvs: loncom /publisher lonpublisher.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Mon, 07 Oct 2002 21:07:08 -0000
This is a MIME encoded message
--matthew1034024828
Content-Type: text/plain
matthew Mon Oct 7 17:07:08 2002 EDT
Modified files:
/loncom/publisher lonpublisher.pm
Log:
- retabinate phasetwo
- rflush the publishing output
- fix directory publishing to not skip the /
--matthew1034024828
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20021007170708.txt"
Index: loncom/publisher/lonpublisher.pm
diff -u loncom/publisher/lonpublisher.pm:1.99 loncom/publisher/lonpublisher.pm:1.100
--- loncom/publisher/lonpublisher.pm:1.99 Mon Oct 7 09:50:36 2002
+++ loncom/publisher/lonpublisher.pm Mon Oct 7 17:07:08 2002
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.99 2002/10/07 13:50:36 www Exp $
+# $Id: lonpublisher.pm,v 1.100 2002/10/07 21:07:08 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1196,243 +1196,241 @@
=item Scalar string
String contains status (errors and warnings) and information associated with
-the server's attempts at publication.
+the server's attempts at publication.
=cut
+#'stupid emacs
#########################################
#########################################
sub phasetwo {
- my ($source,$target,$style,$distarget,$batch)=@_;
+ my ($r,$source,$target,$style,$distarget,$batch)=@_;
my $logfile;
- my $scrout='';
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return
- '<font color=red>No write permission to user directory, FAIL</font>';
+ '<font color=red>No write permission to user directory, FAIL</font>';
}
print $logfile
-"\n================= Publish ".localtime()." Phase Two ================\n";
-
- %metadatafields=();
- %metadatakeys=();
-
- &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'}=
- &sqltime($ENV{'form.creationdate'});
- $metadatafields{'lastrevisiondate'}=
- &sqltime($ENV{'form.lastrevisiondate'});
- $metadatafields{'owner'}=$ENV{'form.owner'};
- $metadatafields{'copyright'}=$ENV{'form.copyright'};
- $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
-
- my $allkeywords=$ENV{'form.addkey'};
- if (exists($ENV{'form.keywords'})) {
- if (ref($ENV{'form.keywords'})) {
- $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});
- } else {
- $allkeywords .= ','.$ENV{'form.keywords'};
- }
- }
- $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
- '<font color=red>Could not write metadata, FAIL</font>';
- }
- foreach (sort keys %metadatafields) {
- unless ($_=~/\./) {
- my $unikey=$_;
- $unikey=~/^([A-Za-z]+)/;
- my $tag=$1;
- $tag=~tr/A-Z/a-z/;
- print $mfh "\n\<$tag";
- foreach (split(/\,/,$metadatakeys{$unikey})) {
- my $value=$metadatafields{$unikey.'.'.$_};
- $value=~s/\"/\'\'/g;
- print $mfh ' '.$_.'="'.$value.'"';
- }
- print $mfh '>'.
- &HTML::Entities::encode($metadatafields{$unikey})
- .'</'.$tag.'>';
- }
- }
- $scrout.='<p>Wrote Metadata';
- print $logfile "\nWrote metadata";
- }
-
+ "\n================= Publish ".localtime()." Phase Two ================\n";
+
+ %metadatafields=();
+ %metadatakeys=();
+
+ &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'}=
+ &sqltime($ENV{'form.creationdate'});
+ $metadatafields{'lastrevisiondate'}=
+ &sqltime($ENV{'form.lastrevisiondate'});
+ $metadatafields{'owner'}=$ENV{'form.owner'};
+ $metadatafields{'copyright'}=$ENV{'form.copyright'};
+ $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
+
+ my $allkeywords=$ENV{'form.addkey'};
+ if (exists($ENV{'form.keywords'})) {
+ if (ref($ENV{'form.keywords'})) {
+ $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});
+ } else {
+ $allkeywords .= ','.$ENV{'form.keywords'};
+ }
+ }
+ $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
+ '<font color=red>Could not write metadata, FAIL</font>';
+ }
+ foreach (sort keys %metadatafields) {
+ unless ($_=~/\./) {
+ my $unikey=$_;
+ $unikey=~/^([A-Za-z]+)/;
+ my $tag=$1;
+ $tag=~tr/A-Z/a-z/;
+ print $mfh "\n\<$tag";
+ foreach (split(/\,/,$metadatakeys{$unikey})) {
+ my $value=$metadatafields{$unikey.'.'.$_};
+ $value=~s/\"/\'\'/g;
+ print $mfh ' '.$_.'="'.$value.'"';
+ }
+ print $mfh '>'.
+ &HTML::Entities::encode($metadatafields{$unikey})
+ .'</'.$tag.'>';
+ }
+ }
+ $r->print('<p>Wrote Metadata');
+ print $logfile "\nWrote metadata";
+ }
+
# -------------------------------- Synchronize entry with SQL metadata database
- my $warning;
+
$metadatafields{'url'} = $distarget;
$metadatafields{'version'} = 'current';
unless ($metadatafields{'copyright'} eq 'priv') {
my ($error,$success) = &store_metadata(\%metadatafields);
if ($success) {
- $scrout.='<p>Synchronized SQL metadata database';
+ $r->print('<p>Synchronized SQL metadata database');
print $logfile "\nSynchronized SQL metadata database";
} else {
- $warning.=$error;
+ $r->print($error);
print $logfile "\n".$error;
}
} else {
- $scrout.='<p>Private Publication - did not synchronize database';
+ $r->print('<p>Private Publication - did not synchronize database');
print $logfile "\nPrivate: Did not synchronize data into ".
"SQL metadata database";
}
# ----------------------------------------------------------- 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 "<font color=red>Invalid target directory, FAIL</font>";
- }
- opendir(DIR,$srcd);
- while ($filename=readdir(DIR)) {
- if (-l $srcd.'/'.$filename) {
- unlink($srcd.'/'.$filename);
- unlink($srcd.'/'.$filename.'.meta');
- } else {
- if ($filename=~/$srcf\.(\d+)\.$srct$/) {
- $maxversion=($1>$maxversion)?$1:$maxversion;
- }
- }
- }
- closedir(DIR);
- $maxversion++;
- $scrout.='<p>Creating old version '.$maxversion;
- print $logfile "\nCreating old version ".$maxversion;
-
- my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
-
+ 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 "<font color=red>Invalid target directory, FAIL</font>";
+ }
+ opendir(DIR,$srcd);
+ while ($filename=readdir(DIR)) {
+ if (-l $srcd.'/'.$filename) {
+ unlink($srcd.'/'.$filename);
+ unlink($srcd.'/'.$filename.'.meta');
+ } else {
+ if ($filename=~/$srcf\.(\d+)\.$srct$/) {
+ $maxversion=($1>$maxversion)?$1:$maxversion;
+ }
+ }
+ }
+ closedir(DIR);
+ $maxversion++;
+ $r->print('<p>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.='<p>Copied old target file';
+ $r->print('<p>Copied old target file');
} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";
- return "<font color=red>Failed to copy old target, $!, FAIL</font>";
+ return "<font color=red>Failed to copy old target, $!, FAIL</font>";
}
-
+
# --------------------------------------------------------------- Copy Metadata
$copyfile=$copyfile.'.meta';
-
+
if (copy($target.'.meta',$copyfile)) {
print $logfile "Copied old target metadata to ".$copyfile."\n";
- $scrout.='<p>Copied old metadata';
+ $r->print('<p>Copied old metadata')
} else {
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
if (-e $target.'.meta') {
- return
- "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
+ return
+ "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
}
}
-
-
-} else {
- $scrout.='<p>Initial version';
- print $logfile "\nInitial version";
-}
+
+
+ } else {
+ $r->print('<p>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.='<p>Created directory '.$parts[$count];
- mkdir($path,0777);
- }
- }
-
- if (copy($source,$copyfile)) {
- print $logfile "\nCopied original source to ".$copyfile."\n";
- $scrout.='<p>Copied source file';
- } else {
- print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
- return "<font color=red>Failed to copy source, $!, FAIL</font>";
+ 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;
+ $r->print('<p>Created directory '.$parts[$count]);
+ mkdir($path,0777);
}
-
+ }
+
+ if (copy($source,$copyfile)) {
+ print $logfile "\nCopied original source to ".$copyfile."\n";
+ $r->print('<p>Copied source file');
+ } else {
+ print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
+ return "<font color=red>Failed to copy source, $!, FAIL</font>";
+ }
+
# --------------------------------------------------------------- Copy Metadata
- $copyfile=$copyfile.'.meta';
-
- if (copy($source.'.meta',$copyfile)) {
- print $logfile "\nCopied original metadata to ".$copyfile."\n";
- $scrout.='<p>Copied metadata';
- } else {
- print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
- return
- "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
- }
-
+ $copyfile=$copyfile.'.meta';
+
+ if (copy($source.'.meta',$copyfile)) {
+ print $logfile "\nCopied original metadata to ".$copyfile."\n";
+ $r->print('<p>Copied metadata');
+ } else {
+ print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
+ return
+ "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
+ }
+ $r->rflush;
# --------------------------------------------------- Send update notifications
my @subscribed=&get_subscribed_hosts($target);
foreach my $subhost (@subscribed) {
- $scrout.='<p>Notifying host '.$subhost.':';
+ $r->print('<p>Notifying host '.$subhost.':');$r->rflush;
print $logfile "\nNotifying host ".$subhost.':';
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
- $scrout.=$reply;
+ $r->print($reply);$r->rflush;
print $logfile $reply;
}
-
+
# ---------------------------------------- Send update notifications, meta only
my @subscribedmeta=&get_subscribed_hosts("$target.meta");
foreach my $subhost (@subscribedmeta) {
- $scrout.='<p>Notifying host for metadata only '.$subhost.':';
+ $r->print('<p>Notifying host for metadata only '.$subhost.':');$r->rflush;
print $logfile "\nNotifying host for metadata only ".$subhost.':';
my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
$subhost);
- $scrout.=$reply;
+ $r->print($reply);$r->rflush;
print $logfile $reply;
}
-
+
# ------------------------------------------------ Provide link to new resource
- unless ($batch) {
- my $thisdistarget=$target;
- $thisdistarget=~s/^$docroot//;
-
- my $thissrc=$source;
- $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
-
- my $thissrcdir=$thissrc;
- $thissrcdir=~s/\/[^\/]+$/\//;
-
-
- return $warning.$scrout.
- '<hr><a href="'.$thisdistarget.'"><font size="+2">'.
- 'View Published Version</font></a>'.
- '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
- '<p><a href="'.$thissrcdir.
- '"><font size="+2">Back to Source Directory</font></a>';
- } else {
- return $warning.$scrout;
- }
+ unless ($batch) {
+ my $thisdistarget=$target;
+ $thisdistarget=~s/^$docroot//;
+
+ my $thissrc=$source;
+ $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
+
+ my $thissrcdir=$thissrc;
+ $thissrcdir=~s/\/[^\/]+$/\//;
+
+
+ $r->print(
+ '<hr><a href="'.$thisdistarget.'"><font size="+2">'.
+ 'View Published Version</font></a>'.
+ '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
+ '<p><a href="'.$thissrcdir.
+ '"><font size="+2">Back to Source Directory</font></a>');
+ }
}
#########################################
@@ -1466,8 +1464,9 @@
# phase two takes
# my ($source,$target,$style,$distarget,batch)=@_;
# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...
- $r->print(
-'<p>'.&phasetwo($srcfile,$targetfile,$thisembstyle,$thisdistarget,1).'</p>');
+ $r->print('<p>');
+ &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
+ $r->print('</p>');
return '';
}
@@ -1476,9 +1475,9 @@
sub publishdirectory {
my ($r,$fn,$thisdisfn)=@_;
my $resdir=
- $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.
+ $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.
$thisdisfn;
- $r->print('<h1>Directory <tt>'.$thisdisfn.'/</tt></h1>'.
+ $r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'.
'Target: <tt>'.$resdir.'</tt><br />');
my $dirptr=16384; # Mask indicating a directory in stat.cmode.
@@ -1711,9 +1710,8 @@
$r->print(
'<hr />'.&publish($thisfn,$thistarget,$thisembstyle));
} else {
- $r->print(
- '<hr />'.&phasetwo($thisfn,$thistarget,
- $thisembstyle,$thisdistarget));
+ $r->print('<hr />');
+ &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);
}
}
--matthew1034024828--