--- loncom/publisher/lonpublisher.pm 2002/10/07 13:50:36 1.99 +++ loncom/publisher/lonpublisher.pm 2002/10/07 21:07:08 1.100 @@ -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 @@ Returns: =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 - 'No write permission to user directory, FAIL'; + 'No write permission to user directory, FAIL'; } 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 - 'Could not write metadata, FAIL'; - } - 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}) - .''; - } - } - $scrout.='

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 + 'Could not write metadata, FAIL'; + } + 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}) + .''; + } + } + $r->print('

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.='

Synchronized SQL metadata database'; + $r->print('

Synchronized SQL metadata database'); print $logfile "\nSynchronized SQL metadata database"; } else { - $warning.=$error; + $r->print($error); print $logfile "\n".$error; } } else { - $scrout.='

Private Publication - did not synchronize database'; + $r->print('

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 "Invalid target directory, FAIL"; - } - 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.='

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 "Invalid target directory, FAIL"; + } + 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('

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'; + $r->print('

Copied old target file'); } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy old target, $!, FAIL"; + 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'; + $r->print('

Copied old metadata') } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { - return - "Failed to write old metadata copy, $!, FAIL"; + return + "Failed to write old metadata copy, $!, FAIL"; } } - - -} else { - $scrout.='

Initial version'; - print $logfile "\nInitial version"; -} + + + } else { + $r->print('

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 "\nCopied original source to ".$copyfile."\n"; - $scrout.='

Copied source file'; - } else { - print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy source, $!, FAIL"; + 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('

Created directory '.$parts[$count]); + mkdir($path,0777); } - + } + + if (copy($source,$copyfile)) { + print $logfile "\nCopied original source to ".$copyfile."\n"; + $r->print('

Copied source file'); + } else { + print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; + return "Failed to copy source, $!, FAIL"; + } + # --------------------------------------------------------------- Copy Metadata - $copyfile=$copyfile.'.meta'; - - if (copy($source.'.meta',$copyfile)) { - print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $scrout.='

Copied metadata'; - } else { - print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; - return - "Failed to write metadata copy, $!, FAIL"; - } - + $copyfile=$copyfile.'.meta'; + + if (copy($source.'.meta',$copyfile)) { + print $logfile "\nCopied original metadata to ".$copyfile."\n"; + $r->print('

Copied metadata'); + } else { + print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; + return + "Failed to write metadata copy, $!, FAIL"; + } + $r->rflush; # --------------------------------------------------- Send update notifications my @subscribed=&get_subscribed_hosts($target); foreach my $subhost (@subscribed) { - $scrout.='

Notifying host '.$subhost.':'; + $r->print('

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.='

Notifying host for metadata only '.$subhost.':'; + $r->print('

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. - '


'. - 'View Published Version'. - '

Back to Source'. - '

Back to Source Directory'; - } 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( + '


'. + 'View Published Version'. + '

Back to Source'. + '

Back to Source Directory'); + } } ######################################### @@ -1466,8 +1464,9 @@ sub batchpublish { # phase two takes # my ($source,$target,$style,$distarget,batch)=@_; # $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},... - $r->print( -'

'.&phasetwo($srcfile,$targetfile,$thisembstyle,$thisdistarget,1).'

'); + $r->print('

'); + &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); + $r->print('

'); return ''; } @@ -1476,9 +1475,9 @@ sub batchpublish { 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('

Directory '.$thisdisfn.'/

'. + $r->print('

Directory '.$thisdisfn.'

'. 'Target: '.$resdir.'
'); my $dirptr=16384; # Mask indicating a directory in stat.cmode. @@ -1711,9 +1710,8 @@ unless ($ENV{'form.phase'} eq 'two') { $r->print( '
'.&publish($thisfn,$thistarget,$thisembstyle)); } else { - $r->print( - '
'.&phasetwo($thisfn,$thistarget, - $thisembstyle,$thisdistarget)); + $r->print('
'); + &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); } }