--- loncom/publisher/lonpublisher.pm 2002/08/09 19:49:30 1.92 +++ loncom/publisher/lonpublisher.pm 2003/03/14 16:02:49 1.117 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.92 2002/08/09 19:49:30 albertel Exp $ +# $Id: lonpublisher.pm,v 1.117 2003/03/14 16:02:49 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 # ### @@ -67,28 +63,42 @@ =pod -=head1 Name +=head1 NAME lonpublisher - LON-CAPA publishing handler -=head1 Synopsis +=head1 SYNOPSIS -lonpublisher takes the proper steps to add resources to the LON-CAPA +B is used by B inside B. This is the +invocation by F: + + + PerlAccessHandler Apache::lonacc + SetHandler perl-script + PerlHandler Apache::lonpublisher + ErrorDocument 403 /adm/login + ErrorDocument 404 /adm/notfound.html + ErrorDocument 406 /adm/unauthorized.html + ErrorDocument 500 /adm/errorhandler + + +=head1 DESCRIPTION + +B takes the proper steps to add resources to the LON-CAPA digital library. This includes updating the metadata table in the LON-CAPA database. -=head1 Description - -lonpublisher is many things to many people. -To all people it is woefully documented. -This documentation conforms to this standard. +B is many things to many people. This module publishes a file. This involves gathering metadata, versioning the file, copying file from construction space to publication space, and copying metadata from construction space to publication space. -=head2 Internal Functions +=head2 SUBROUTINES + +Many of the undocumented subroutines implement various magical +parsing shortcuts. =over 4 @@ -107,32 +117,43 @@ 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 metaeval +=item B + +Evaluates a string that contains metadata. This subroutine +stores values inside I<%metadatafields> and I<%metadatakeys>. +The hash key is a I<$unikey> corresponding to a unique id +that is descriptive of the parser location inside the XML tree. + +Parameters: + +=over 4 + +=item I<$metastring> + +A string that contains metadata. + +=back -Evaluate string with metadata +Returns: + +nothing =cut @@ -185,10 +206,34 @@ sub metaeval { =pod -=item metaread +=item B Read a metadata file +Parameters: + +=over + +=item I<$logfile> + +File output stream to output errors and warnings to. + +=item I<$fn> + +File name (including path). + +=back + +Returns: + +=over 4 + +=item Scalar string (if successful) + +XHTML text that indicates successful reading of the metadata. + +=back + =cut ######################################### @@ -196,10 +241,10 @@ Read a metadata file sub metaread { my ($logfile,$fn)=@_; unless (-e $fn) { - print $logfile 'No file '.$fn."\n"; + print($logfile 'No file '.$fn."\n"); return '
No file: '.$fn.''; } - print $logfile 'Processing '.$fn."\n"; + print($logfile 'Processing '.$fn."\n"); my $metastring; { my $metafh=Apache::File->new($fn); @@ -212,39 +257,44 @@ sub metaread { ######################################### ######################################### -=pod - -=item sqltime - -Convert 'time' format into a datetime sql format - -=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 functions +=item Form-field-generating subroutines. + +For input parameters, these subroutines take in values +such as I<$name>, I<$value> and other form field metadata. +The output (scalar string that is returned) is an XHTML +string which presents the form field (foreseeably inside +
tags). =over 4 -=item textfield +=item B -=item hiddenfield +=item B -=item selectbox +=item B =back @@ -255,12 +305,12 @@ sub sqltime { sub textfield { my ($title,$name,$value)=@_; return "\n

$title:
". - ''; + ''; } sub hiddenfield { my ($name,$value)=@_; - return "\n".''; + return "\n".''; } sub selectbox { @@ -283,7 +333,7 @@ sub selectbox { =pod -=item urlfixup +=item B Fix up a url? First step of publication @@ -316,9 +366,9 @@ sub urlfixup { =pod -=item absoluteurl +=item B -Currently undocumented +Currently undocumented. =cut @@ -339,7 +389,7 @@ sub absoluteurl { =pod -=item set_allow +=item B Currently undocumented @@ -370,7 +420,7 @@ sub set_allow { =pod -=item get_subscribed_hosts +=item B Currently undocumented @@ -388,7 +438,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); } } @@ -399,14 +450,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("Un able to open $target.subscription"); + &Apache::lonnet::logthis("Unable to open $target.subscription"); } - &Apache::lonnet::logthis("Got list of ".join(':',@subscribed)); return @subscribed; } @@ -416,7 +470,7 @@ sub get_subscribed_hosts { =pod -=item get_max_ids_indices +=item B Currently undocumented @@ -429,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; @@ -439,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; } @@ -452,7 +516,8 @@ sub get_max_ids_indices { } } } - return ($needsfixup,$maxid,$maxindex); + return ($needsfixup,$maxid,$maxindex,$duplicateids, + (keys(%duplicatedids))); } ######################################### @@ -460,7 +525,7 @@ sub get_max_ids_indices { =pod -=item get_all_text_unbalanced +=item B Currently undocumented @@ -484,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; @@ -502,7 +567,7 @@ sub get_all_text_unbalanced { =pod -=item fix_ids_and_indices +=item B Currently undocumented @@ -521,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". @@ -646,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); } ######################################### @@ -654,7 +727,7 @@ sub fix_ids_and_indices { =pod -=item store_metadata +=item B Store the metadata in the metadata table in the loncapa database. Uses lonmysql to access the database. @@ -710,9 +783,17 @@ sub store_metadata { =pod -=item publish +=item B + +This is the workhorse function of this module. This subroutine generates +backup copies, performs any automatic processing (prior to publication, +especially for rat and ssi files), -Currently undocumented. This is the workhorse function of this module. +Returns a 2 element array, the first is the string to be shown to the +user, the second is an error code, either 1 (an error occured) or 0 +(no error occurred) + +I =cut @@ -720,7 +801,7 @@ Currently undocumented. This is the wor ######################################### sub publish { - my ($source,$target,$style)=@_; + my ($source,$target,$style,$batch)=@_; my $logfile; my $scrout=''; my $allmeta=''; @@ -728,8 +809,7 @@ sub publish { my %allow=(); unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return - 'No write permission to user directory, FAIL'; + return ('No write permission to user directory, FAIL',1); } print $logfile "\n\n================= Publish ".localtime()." Phase One ================\n"; @@ -743,12 +823,14 @@ sub publish { print $logfile "Copied original file to ".$copyfile."\n"; } else { print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; - return "Failed to write backup copy, $!,FAIL"; + return ("Failed to write backup copy, $!,FAIL",1); } # ------------------------------------------------------------- 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,$error); } # ------------------------------------------------------------ Construct Allows $scrout.='

Dependencies

'; @@ -769,8 +851,8 @@ sub publish { if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= - ' - Currently not available'; + $scrout.= ' - Currently not available'. + ''; } else { my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' @@ -787,33 +869,34 @@ sub publish { #Encode any High ASCII characters $outstring=&HTML::Entities::encode($outstring,"\200-\377"); -# ------------------------------------------------------------- Write modified +# ------------------------------------------------------------- Write modified. { 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; + print($org $outstring); } $content=$outstring; } -# --------------------------------------------- Initial step done, now metadata +# -------------------------------------------- Initial step done, now metadata. -# ---------------------------------------- Storage for metadata keys and fields +# --------------------------------------- Storage for metadata keys and fields. %metadatafields=(); %metadatakeys=(); my %oldparmstores=(); - + unless ($batch) { $scrout.='

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

'; + } # ------------------------------------------------ First, check out environment unless (-e $source.'.meta') { @@ -874,63 +957,87 @@ 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=(); + + 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.= - '

'. - '

'. - &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";