--- loncom/publisher/lonpublisher.pm 2002/09/16 13:05:50 1.95 +++ loncom/publisher/lonpublisher.pm 2002/10/19 06:34:15 1.104 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.95 2002/09/16 13:05:50 www Exp $ +# $Id: lonpublisher.pm,v 1.104 2002/10/19 06:34:15 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -139,9 +139,6 @@ my $docroot; my $cuname; my $cudom; -######################################### -######################################### - =pod =item B @@ -265,50 +262,31 @@ sub metaread { } ######################################### -######################################### - -=pod - -=item B - -Convert 'time' format into a datetime sql format - -Parameters: - -=over 4 - -=item I<$timef> - -Seconds since 00:00:00 UTC, January 1, 1970. - -=back - -Returns: - -=over 4 - -=item Scalar string - -MySQL-compatible datetime string. - -=back - -=cut ######################################### ######################################### -sub sqltime { - my $timef=shift @_; - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = - localtime($timef); - $mon++; $year+=1900; - return "$year-$mon-$mday $hour:$min:$sec"; -} - +sub coursedependencies { + my $url=&Apache::lonnet::declutter(shift); + $url=~s/\.meta$//; + my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); + my $regexp=$url; + $regexp=~s/(\W)/\\$1/g; + $regexp='___'.$regexp.'___course'; + my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, + $aauthor,$regexp); + my %courses=(); + foreach (keys %evaldata) { + if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { + $courses{$1}=1; + } + } + return %courses; +} ######################################### ######################################### + =pod =item Form-field-generating subroutines. @@ -469,7 +447,8 @@ sub get_subscribed_hosts { while ($filename=readdir(DIR)) { if ($filename=~/$srcf\.(\w+)$/) { my $subhost=$1; - if ($subhost ne 'meta' && $subhost ne 'subscription') { + if (($subhost ne 'meta' && $subhost ne 'subscription') && + ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) { push(@subscribed,$subhost); } } @@ -480,14 +459,17 @@ sub get_subscribed_hosts { &Apache::lonnet::logthis("opened $target.subscription"); while (my $subline=<$sh>) { &Apache::lonnet::logthis("Trying $subline"); - if ($subline =~ /(^\w+):/) { push(@subscribed,$1); } else { + if ($subline =~ /(^\w+):/) { + if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { + push(@subscribed,$1); + } + } else { &Apache::lonnet::logthis("No Match for $subline"); } } } else { &Apache::lonnet::logthis("Unable to open $target.subscription"); } - &Apache::lonnet::logthis("Got list of ".join(':',@subscribed)); return @subscribed; } @@ -805,7 +787,7 @@ I ######################################### sub publish { - my ($source,$target,$style)=@_; + my ($source,$target,$style,$batch)=@_; my $logfile; my $scrout=''; my $allmeta=''; @@ -896,10 +878,11 @@ sub publish { my %oldparmstores=(); - + unless ($batch) { $scrout.='

Metadata Information ' . Apache::loncommon::help_open_topic("Metadata_Description") . '

'; + } # ------------------------------------------------ First, check out environment unless (-e $source.'.meta') { @@ -993,6 +976,33 @@ sub publish { # ------------------------------------------------------- Now have all metadata + my %keywords=(); + + if (length($content)<500000) { + my $textonly=$content; + $textonly=~s/\//g; + $textonly=~s/\[^\<]+\<\/m\>//g; + $textonly=~s/\<[^\>]*\>//g; + $textonly=~tr/A-Z/a-z/; + $textonly=~s/[\$\&][a-z]\w*//g; + $textonly=~s/[^a-z\s]//g; + + foreach ($textonly=~m/(\w+)/g) { + unless ($nokey{$_}) { + $keywords{$_}=1; + } + } + } + + + foreach (split(/\W+/,$metadatafields{'keywords'})) { + $keywords{$_}=1; + } +# --------------------------------------------------- Now we also have keywords +# ============================================================================= +# INTERACTIVE MODE +# + unless ($batch) { $scrout.= '
'. '

'. @@ -1028,28 +1038,6 @@ function uncheckAll(field) END $keywordout.=''; my $colcount=0; - my %keywords=(); - - if (length($content)<500000) { - my $textonly=$content; - $textonly=~s/\//g; - $textonly=~s/\[^\<]+\<\/m\>//g; - $textonly=~s/\<[^\>]*\>//g; - $textonly=~tr/A-Z/a-z/; - $textonly=~s/[\$\&][a-z]\w*//g; - $textonly=~s/[^a-z\s]//g; - - foreach ($textonly=~m/(\w+)/g) { - unless ($nokey{$_}) { - $keywords{$_}=1; - } - } - } - - - foreach (split(/\W+/,$metadatafields{'keywords'})) { - $keywords{$_}=1; - } foreach (sort keys %keywords) { $keywordout.='

'; +# ============================================================================= +# BATCH MODE +# + } else { +# Transfer metadata directly to environment for stage 2 + foreach (keys %metadatafields) { + $ENV{'form.'.$_}=$metadatafields{$_}; + } + $ENV{'form.addkey'}=''; + $ENV{'form.keywords'}=''; + foreach (keys %keywords) { + if ($metadatafields{'keywords'}) { + if ($metadatafields{'keywords'}=~/$_/) { + $ENV{'form.keywords'}.=$_.','; + } + } elsif (&Apache::loncommon::keyword($_)) { + $ENV{'form.keywords'}.=$_.','; + } + } + $ENV{'form.keywords'}=~s/\,$//; + unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; } + $ENV{'form.lastrevisiondate'}=time; + if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) || + (!$ENV{'form.copyright'})) { + $ENV{'form.copyright'}='default'; + } + $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); + return $scrout; + } } ######################################### @@ -1156,253 +1174,306 @@ 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)=@_; + my ($r,$source,$target,$style,$distarget,$batch)=@_; + $source=~s/\/+/\//g; + $target=~s/\/+/\//g; + $distarget=~s/\/+/\//g; 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'}=$ENV{'form.creationdate'}; + $metadatafields{'lastrevisiondate'}=$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 ($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 "Copied original source to ".$copyfile."\n"; - $scrout.='

Copied source file'; - } else { - print $logfile "Unable 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 "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"; - } - + $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; + } + +# --------------------------------------------------- Notify subscribed courses + my %courses=&coursedependencies($target); + my $now=time; + foreach (keys %courses) { + $r->print('

Notifying course '.$_.':');$r->rflush; + print $logfile "\nNotifying host ".$_.':'; + my ($cdom,$cname)=split(/\_/,$_); + my $reply=&Apache::lonnet::cput + ('versionupdate',{$target => $now},$cdom,$cname); + $r->print($reply.'
');$r->rflush; print $logfile $reply; } - # ------------------------------------------------ Provide link to new resource - - 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'; - + 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'); + } } ######################################### sub batchpublish { - my ($r,$srcfile)=@_; + my ($r,$srcfile,$targetfile)=@_; + $srcfile=~s/\/+/\//g; + $targetfile=~s/\/+/\//g; my $thisdisfn=$srcfile; $thisdisfn=~s/\/home\/korte\/public_html\///; $srcfile=~s/\/+/\//g; + + my $docroot=$r->dir_config('lonDocRoot'); + my $thisdistarget=$targetfile; + $thisdistarget=~s/^$docroot//; + + + undef %metadatafields; + undef %metadatakeys; + %metadatafields=(); + %metadatakeys=(); + $srcfile=~/\.(\w+)$/; + my $thistype=$1; + + + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); + $r->print('

Publishing '.$thisdisfn.'

'); + +# phase one takes +# my ($source,$target,$style,$batch)=@_; + $r->print('

'.&publish($srcfile,$targetfile,$thisembstyle,1).'

'); +# phase two takes +# my ($source,$target,$style,$distarget,batch)=@_; +# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},... + $r->print('

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

'); + return ''; } ######################################### sub publishdirectory { my ($r,$fn,$thisdisfn)=@_; - $r->print('

Directory '.$thisdisfn.'/

'); + $fn=~s/\/+/\//g; + $thisdisfn=~s/\/+/\//g; + my $resdir= + $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. + $thisdisfn; + $r->print('

Directory '.$thisdisfn.'

'. + 'Target: '.$resdir.'
'); my $dirptr=16384; # Mask indicating a directory in stat.cmode. @@ -1422,7 +1493,26 @@ sub publishdirectory { } } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { - &batchpublish($r,$fn.'/'.$filename); +# find out publication status and/or exiting metadata + my $publishthis=0; + if (-e $resdir.'/'.$filename) { + my ($rdev,$rino,$rmode,$rnlink, + $ruid,$rgid,$rrdev,$rsize, + $ratime,$rmtime,$rctime, + $rblksize,$rblocks)=stat($resdir.'/'.$filename); + if ($rmtime<$cmtime) { +# previously published, modified now + $publishthis=1; + } + } else { +# never published + $publishthis=1; + } + if ($publishthis) { + &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); + } else { + $r->print('
Skipping '.$filename.'
'); + } $r->rflush(); } } @@ -1570,6 +1660,8 @@ unless ($ENV{'form.phase'} eq 'two') { $r->print('LON-CAPA Publishing'); $r->print(&Apache::loncommon::bodytag('Resource Publication')); + + my $thisfn=$fn; my $thistarget=$thisfn; @@ -1606,7 +1698,7 @@ unless ($ENV{'form.phase'} eq 'two') { if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { $r->print('
Diffs with Current Version

'); + '&versiontwo=priv" target="cat">Diffs with Current Version

'); } # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. @@ -1615,9 +1707,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); } }