--- loncom/publisher/lonpublisher.pm 2002/10/03 15:02:22 1.98 +++ loncom/publisher/lonpublisher.pm 2003/02/18 23:13:54 1.111 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.98 2002/10/03 15:02:22 www Exp $ +# $Id: lonpublisher.pm,v 1.111 2003/02/18 23:13:54 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,18 +33,14 @@ # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer # 03/23 Guy Albertelli # 03/24,03/29,04/03 Gerd Kortemeyer -# 04/16/2001 Scott Harrison # 05/03,05/05,05/07 Gerd Kortemeyer -# 05/28/2001 Scott Harrison # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer # 12/04,12/05 Guy Albertelli # 12/05 Gerd Kortemeyer # 12/05 Guy Albertelli # 12/06,12/07 Gerd Kortemeyer -# 12/15,12/16 Scott Harrison # 12/25 Gerd Kortemeyer # YEAR=2002 -# 1/16,1/17 Scott Harrison # 1/17 Gerd Kortemeyer # ### @@ -121,27 +117,21 @@ use File::Copy; use Apache::Constants qw(:common :http :methods); use HTML::LCParser; use Apache::lonxml; -use Apache::lonhomework; use Apache::loncacc; use DBI; use Apache::lonnet(); use Apache::loncommon(); use Apache::lonmysql; +use vars qw(%metadatafields %metadatakeys); my %addid; my %nokey; -my %metadatafields; -my %metadatakeys; - my $docroot; my $cuname; my $cudom; -######################################### -######################################### - =pod =item B @@ -267,48 +257,27 @@ 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. @@ -492,7 +461,6 @@ sub get_subscribed_hosts { } else { &Apache::lonnet::logthis("Unable to open $target.subscription"); } - &Apache::lonnet::logthis("Got list of ".join(':',@subscribed)); return @subscribed; } @@ -515,6 +483,10 @@ sub get_max_ids_indices { my $maxindex=10; my $maxid=10; my $needsfixup=0; + my $duplicateids=0; + + my %allids; + my %duplicatedids; my $parser=HTML::LCParser->new($content); my $token; @@ -525,6 +497,12 @@ sub get_max_ids_indices { if ($counter eq 'id') { if (defined($token->[2]->{'id'})) { $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; + if (exists($allids{$token->[2]->{'id'}})) { + $duplicateids=1; + $duplicatedids{$token->[2]->{'id'}}=1; + } else { + $allids{$token->[2]->{'id'}}=1; + } } else { $needsfixup=1; } @@ -538,7 +516,8 @@ sub get_max_ids_indices { } } } - return ($needsfixup,$maxid,$maxindex); + return ($needsfixup,$maxid,$maxindex,$duplicateids, + (keys(%duplicatedids))); } ######################################### @@ -570,7 +549,7 @@ sub get_all_text_unbalanced { } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } - if ($result =~ /(.*)$tag(.*)/) { + if ($result =~ /(.*)\Q$tag\E(.*)/s) { #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2); #&Apache::lonnet::logthis('Result is :'.$1); $result=$1; @@ -607,8 +586,16 @@ sub fix_ids_and_indices { $content=join('',<$org>); } - my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content); + my ($needsfixup,$maxid,$maxindex,$duplicateids,@duplicatedids)= + &get_max_ids_indices(\$content); + print $logfile ("Got $needsfixup,$maxid,$maxindex,$duplicateids--". + join(', ',@duplicatedids)); + if ($duplicateids) { + print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n"; + my $outstring='Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are: '.join(', ',@duplicatedids).''; + return ($outstring,1); + } if ($needsfixup) { print $logfile "Needs ID and/or index fixup\n". "Max ID : $maxid (min 10)\n". @@ -732,7 +719,7 @@ sub fix_ids_and_indices { print $logfile "Does not need ID and/or index fixup\n"; } - return ($outstring,%allow); + return ($outstring,0,%allow); } ######################################### @@ -837,8 +824,10 @@ sub publish { } # ------------------------------------------------------------- IDs and indices - my $outstring; - ($outstring,%allow)=&fix_ids_and_indices($logfile,$source,$target); + my ($outstring,$error); + ($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source, + $target); + if ($error) { return $outstring; } # ------------------------------------------------------------ Construct Allows $scrout.='

Dependencies

'; @@ -959,7 +948,9 @@ sub publish { my $oldenv=$ENV{'request.uri'}; $ENV{'request.uri'}=$target; + $Apache::lonxml::debug=1; $allmeta=Apache::lonxml::xmlparse(undef,'meta',$content); + $Apache::lonxml::debug=0; $ENV{'request.uri'}=$oldenv; &metaeval($allmeta); @@ -1104,7 +1095,8 @@ END unless ($metadatafields{'creationdate'}) { $metadatafields{'creationdate'}=time; } - $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'}); + $scrout.=&hiddenfield('creationdate', + &Apache::loncommon::unsqltime($metadatafields{'creationdate'})); $scrout.=&hiddenfield('lastrevisiondate',time); @@ -1196,248 +1188,269 @@ 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)=@_; + $source=~s/\/+/\//g; + $target=~s/\/+/\//g; + + if ($target=~/\_\_\_/) { + $r->print( + 'Unsupported character combination "___" in filename, FAIL'); + return 0; + } + $distarget=~s/\/+/\//g; my $logfile; - my $scrout=''; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return - 'No write permission to user directory, FAIL'; + $r->print( + 'No write permission to user directory, FAIL'); + return 0; } 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 (-l $srcd.'/'.$filename) { - unlink($srcd.'/'.$filename); - } 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; + } + +# --------------------------------------------------- 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 - 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'); + } } ######################################### sub batchpublish { my ($r,$srcfile,$targetfile)=@_; + $srcfile=~s/\/+/\//g; + $targetfile=~s/\/+/\//g; my $thisdisfn=$srcfile; $thisdisfn=~s/\/home\/korte\/public_html\///; $srcfile=~s/\/+/\//g; @@ -1465,8 +1478,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 ''; } @@ -1474,10 +1488,12 @@ sub batchpublish { sub publishdirectory { my ($r,$fn,$thisdisfn)=@_; + $fn=~s/\/+/\//g; + $thisdisfn=~s/\/+/\//g; 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. @@ -1665,6 +1681,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; @@ -1701,7 +1719,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. @@ -1710,9 +1728,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); } }