--- loncom/publisher/lonpublisher.pm 2003/02/18 16:29:37 1.110 +++ loncom/publisher/lonpublisher.pm 2003/04/02 02:17:10 1.121 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.110 2003/02/18 16:29:37 www Exp $ +# $Id: lonpublisher.pm,v 1.121 2003/04/02 02:17:10 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -117,7 +117,6 @@ 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(); @@ -243,7 +242,7 @@ sub metaread { my ($logfile,$fn)=@_; unless (-e $fn) { print($logfile 'No file '.$fn."\n"); - return '
No file: '.$fn.''; + return '
No file: '.$fn.''; } print($logfile 'Processing '.$fn."\n"); my $metastring; @@ -252,7 +251,7 @@ sub metaread { $metastring=join('',<$metafh>); } &metaeval($metastring); - return '
Processed file: '.$fn.''; + return '
Processed file: '.$fn.''; } ######################################### @@ -305,7 +304,7 @@ string which presents the form field (fo ######################################### sub textfield { my ($title,$name,$value)=@_; - return "\n

$title:
". + return "\n

$title:


". ''; } @@ -318,7 +317,7 @@ sub selectbox { my ($title,$name,$value,$functionref,@idlist)=@_; my $uctitle=uc($title); my $selout="\n

$uctitle:". - "
".''; foreach (@idlist) { $selout.='

Dependencies

'; @@ -839,7 +841,7 @@ sub publish { unless ($style eq 'rat') { $allowstr.="\n".''; } - $scrout.='
'; + $scrout.='
'; unless ($thisdep=~/\*/) { $scrout.=''; } @@ -873,9 +875,8 @@ sub publish { my $org; unless ($org=Apache::File->new('>'.$source)) { print $logfile "No write permit to $source\n"; - return - 'No write permission to '.$source. - ', FAIL'; + return ('No write permission to '.$source. + ', FAIL',1); } print($org $outstring); } @@ -945,7 +946,7 @@ sub publish { } # -------------------------------------------------- Parse content for metadata - if ($style eq 'ssi') { + if (($style eq 'ssi') || ($style eq 'prv')) { my $oldenv=$ENV{'request.uri'}; $ENV{'request.uri'}=$target; @@ -956,204 +957,210 @@ sub publish { } # ---------------- Find and document discrepancies in the parameters and stores - my $chparms=''; - foreach (sort keys %metadatafields) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless ($_=~/\.\w+$/) { - unless ($oldparmstores{$_}) { - print $logfile 'New: '.$_."\n"; - $chparms.=$_.' '; - } - } - } - } - if ($chparms) { - $scrout.='

New parameters or stored values: '. - $chparms; - } + my $chparms=''; + foreach (sort keys %metadatafields) { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + unless ($_=~/\.\w+$/) { + unless ($oldparmstores{$_}) { + print $logfile 'New: '.$_."\n"; + $chparms.=$_.' '; + } + } + } + } + if ($chparms) { + $scrout.='

New parameters or stored values: '.$chparms.'

'; + } - $chparms=''; - foreach (sort keys %oldparmstores) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_.'.name'}) || - ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { - print $logfile 'Obsolete: '.$_."\n"; - $chparms.=$_.' '; - } - } - } - if ($chparms) { - $scrout.='

Obsolete parameters or stored values: '. - $chparms; - } + $chparms=''; + foreach (sort keys %oldparmstores) { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + unless (($metadatafields{$_.'.name'}) || + ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { + print $logfile 'Obsolete: '.$_."\n"; + $chparms.=$_.' '; + } + } + } + if ($chparms) { + $scrout.='

Obsolete parameters or stored values: '. + $chparms.'

'; + } # ------------------------------------------------------- Now have all metadata - my %keywords=(); + 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; - } - } - } + 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 (split(/\W+/,$metadatafields{'keywords'})) { + $keywords{$_}=1; + } # --------------------------------------------------- Now we also have keywords # ============================================================================= # INTERACTIVE MODE # - unless ($batch) { + unless ($batch) { $scrout.= - '
'. - '

'. - &hiddenfield('phase','two'). - &hiddenfield('filename',$ENV{'form.filename'}). - &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). - &hiddenfield('dependencies',join(',',keys %allow)). - &textfield('Title','title',$metadatafields{'title'}). - &textfield('Author(s)','author',$metadatafields{'author'}). - &textfield('Subject','subject',$metadatafields{'subject'}); + ''. + '

'. + &hiddenfield('phase','two'). + &hiddenfield('filename',$ENV{'form.filename'}). + &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). + &hiddenfield('dependencies',join(',',keys %allow)). + &textfield('Title','title',$metadatafields{'title'}). + &textfield('Author(s)','author',$metadatafields{'author'}). + &textfield('Subject','subject',$metadatafields{'subject'}); # --------------------------------------------------- Scan content for keywords my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); my $keywordout=<<"END";

Keywords: $keywords_help - - + + +


END - $keywordout.=''; - my $colcount=0; + $keywordout.='
'; + my $colcount=0; + + foreach (sort keys %keywords) { + $keywordout.='\n"; + $colcount=0; + } + $colcount++; + } - foreach (sort keys %keywords) { - $keywordout.='\n"; - $colcount=0; - } - $colcount++; - } - $keywordout.='
'; + if ($colcount>10) { + $keywordout.="
'; - if ($colcount>10) { - $keywordout.="
'; - $scrout.=$keywordout; + $scrout.=$keywordout; - $scrout.=&textfield('Additional Keywords','addkey',''); + $scrout.=&textfield('Additional Keywords','addkey',''); - $scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); + $scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); - $scrout.= - '

Abstract:
'; + $scrout.= + '

Abstract:

'; $source=~/\.(\w+)$/; $scrout.=&hiddenfield('mime',$1); - $scrout.=&selectbox('Language','language', - $metadatafields{'language'}, + $scrout.=&selectbox('Language','language', + $metadatafields{'language'}, \&Apache::loncommon::languagedescription, (&Apache::loncommon::languageids), - ); + ); - unless ($metadatafields{'creationdate'}) { + unless ($metadatafields{'creationdate'}) { $metadatafields{'creationdate'}=time; - } - $scrout.=&hiddenfield('creationdate', - &Apache::loncommon::unsqltime($metadatafields{'creationdate'})); + } + $scrout.=&hiddenfield('creationdate', + &Apache::loncommon::unsqltime($metadatafields{'creationdate'})); + + $scrout.=&hiddenfield('lastrevisiondate',time); - $scrout.=&hiddenfield('lastrevisiondate',time); - $scrout.=&textfield('Publisher/Owner','owner', - $metadatafields{'owner'}); + $metadatafields{'owner'}); # -------------------------------------------------- Correct copyright for rat. - if ($style eq 'rat') { - if ($metadatafields{'copyright'} eq 'public') { - delete $metadatafields{'copyright'}; + my $defaultoption=$metadatafields{'copyright'}; + unless ($defaultoption) { $defaultoption='default'; } + unless ($style eq 'prv') { + if ($style eq 'rat') { + if ($metadatafields{'copyright'} eq 'public') { + delete $metadatafields{'copyright'}; + $defaultoption='default'; + } + $scrout.=&selectbox('Copyright/Distribution','copyright', + $defaultoption, + \&Apache::loncommon::copyrightdescription, + (grep !/^public$/,(&Apache::loncommon::copyrightids))); + } else { + $scrout.=&selectbox('Copyright/Distribution','copyright', + $defaultoption, + \&Apache::loncommon::copyrightdescription, + (&Apache::loncommon::copyrightids)); + } + + my $copyright_help = + Apache::loncommon::help_open_topic('Publishing_Copyright'); + $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; + $scrout.=&textfield('Custom Distribution File','customdistributionfile', + $metadatafields{'customdistributionfile'}). + $copyright_help; + } else { + $scrout.=&hiddenfield('copyright','private'); } - $scrout.=&selectbox('Copyright/Distribution','copyright', - $metadatafields{'copyright'}, - \&Apache::loncommon::copyrightdescription, - (grep !/^public$/,(&Apache::loncommon::copyrightids))); - } - else { - $scrout.=&selectbox('Copyright/Distribution','copyright', - $metadatafields{'copyright'}, - \&Apache::loncommon::copyrightdescription, - (&Apache::loncommon::copyrightids)); - } - - my $copyright_help = - Apache::loncommon::help_open_topic('Publishing_Copyright'); - $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; - return $scrout. - '

'; + return ($scrout.'

',0); # ============================================================================= # BATCH MODE # - } else { + } else { # Transfer metadata directly to environment for stage 2 - foreach (keys %metadatafields) { - $ENV{'form.'.$_}=$metadatafields{$_}; + 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,0); } - $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; - } } ######################################### @@ -1202,14 +1209,14 @@ sub phasetwo { if ($target=~/\_\_\_/) { $r->print( - 'Unsupported character combination "___" in filename, FAIL'); + 'Unsupported character combination "___" in filename, FAIL'); return 0; } $distarget=~s/\/+/\//g; my $logfile; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { $r->print( - 'No write permission to user directory, FAIL'); + 'No write permission to user directory, FAIL'); return 0; } print $logfile @@ -1231,6 +1238,8 @@ sub phasetwo { $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; $metadatafields{'owner'}=$ENV{'form.owner'}; $metadatafields{'copyright'}=$ENV{'form.copyright'}; + $metadatafields{'customdistributionfile'}= + $ENV{'form.customdistributionfile'}; $metadatafields{'dependencies'}=$ENV{'form.dependencies'}; my $allkeywords=$ENV{'form.addkey'}; @@ -1250,7 +1259,7 @@ sub phasetwo { my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { return - 'Could not write metadata, FAIL'; + 'Could not write metadata, FAIL'; } foreach (sort keys %metadatafields) { unless ($_=~/\./) { @@ -1269,7 +1278,7 @@ sub phasetwo { .''; } } - $r->print('

Wrote Metadata'); + $r->print('

Wrote Metadata

'); print $logfile "\nWrote metadata"; } @@ -1280,14 +1289,14 @@ sub phasetwo { unless ($metadatafields{'copyright'} eq 'priv') { my ($error,$success) = &store_metadata(\%metadatafields); if ($success) { - $r->print('

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

Synchronized SQL metadata database

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

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"; } @@ -1302,7 +1311,7 @@ sub phasetwo { my $srcd=$1; unless ($srcd=~/^\/home\/httpd\/html\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; - return "Invalid target directory, FAIL"; + return "Invalid target directory, FAIL"; } opendir(DIR,$srcd); while ($filename=readdir(DIR)) { @@ -1310,24 +1319,24 @@ sub phasetwo { unlink($srcd.'/'.$filename); unlink($srcd.'/'.$filename.'.meta'); } else { - if ($filename=~/$srcf\.(\d+)\.$srct$/) { + if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) { $maxversion=($1>$maxversion)?$1:$maxversion; } } } closedir(DIR); $maxversion++; - $r->print('

Creating old version '.$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"; - $r->print('

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 @@ -1336,18 +1345,18 @@ sub phasetwo { if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $r->print('

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"; + "Failed to write old metadata copy, $!, FAIL"; } } } else { - $r->print('

Initial version'); + $r->print('

Initial version

'); print $logfile "\nInitial version"; } @@ -1362,17 +1371,17 @@ sub phasetwo { $path.="/$parts[$count]"; if ((-e $path)!=1) { print $logfile "\nCreating directory ".$path; - $r->print('

Created directory '.$parts[$count]); + $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'); + $r->print('

Copied source file

'); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy source, $!, FAIL"; + return "Failed to copy source, $!, FAIL"; } # --------------------------------------------------------------- Copy Metadata @@ -1381,11 +1390,11 @@ sub phasetwo { if (copy($source.'.meta',$copyfile)) { print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $r->print('

Copied metadata'); + $r->print('

Copied metadata

'); } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; return - "Failed to write metadata copy, $!, FAIL"; + "Failed to write metadata copy, $!, FAIL"; } $r->rflush; # --------------------------------------------------- Send update notifications @@ -1395,7 +1404,7 @@ sub phasetwo { $r->print('

Notifying host '.$subhost.':');$r->rflush; print $logfile "\nNotifying host ".$subhost.':'; my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); - $r->print($reply.'
');$r->rflush; + $r->print($reply.'


');$r->rflush; print $logfile $reply; } @@ -1407,7 +1416,7 @@ sub phasetwo { print $logfile "\nNotifying host for metadata only ".$subhost.':'; my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', $subhost); - $r->print($reply.'
');$r->rflush; + $r->print($reply.'


');$r->rflush; print $logfile $reply; } @@ -1420,7 +1429,7 @@ sub phasetwo { my ($cdom,$cname)=split(/\_/,$_); my $reply=&Apache::lonnet::cput ('versionupdate',{$target => $now},$cdom,$cname); - $r->print($reply.'
');$r->rflush; + $r->print($reply.'


');$r->rflush; print $logfile $reply; } # ------------------------------------------------ Provide link to new resource @@ -1436,11 +1445,11 @@ sub phasetwo { $r->print( - '
'. + '
'. 'View Published Version'. - '

Back to Source'. + '

Back to Source

'. '

Back to Source Directory'); + '">Back to Source Directory

'); } } @@ -1473,13 +1482,16 @@ sub batchpublish { # phase one takes # my ($source,$target,$style,$batch)=@_; - $r->print('

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

'); + my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1); + $r->print('

'.$outstring.'

'); # 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('

'); + if (!$error) { + $r->print('

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

'); + } return ''; } @@ -1594,7 +1606,7 @@ sub handler { # -------------------------------------------------------------- Check filename - my $fn=$ENV{'form.filename'}; + my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); unless ($fn) { @@ -1708,7 +1720,7 @@ unless ($ENV{'form.phase'} eq 'two') { $r->print('

Publishing '. &Apache::loncommon::filedescription($thistype).' '. ''.$thisdisfn. - '

Target: '.$thisdistarget.'

'); + 'Target: '.$thisdistarget.'
'); if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { $r->print('

Co-Author: '.$cuname.' at '.$cudom. @@ -1718,19 +1730,18 @@ 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. unless ($ENV{'form.phase'} eq 'two') { - $r->print( - '


'.&publish($thisfn,$thistarget,$thisembstyle)); + my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); + $r->print('
'.$outstring); } else { $r->print('
'); &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); - } - + } } $r->print('');