--- loncom/publisher/lonpublisher.pm 2002/08/09 17:57:48 1.89 +++ loncom/publisher/lonpublisher.pm 2002/09/17 15:01:36 1.96 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.89 2002/08/09 17:57:48 matthew Exp $ +# $Id: lonpublisher.pm,v 1.96 2002/09/17 15:01:36 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,6 +61,57 @@ ## ## ############################################################################### + +###################################################################### +###################################################################### + +=pod + +=head1 NAME + +lonpublisher - LON-CAPA publishing handler + +=head1 SYNOPSIS + +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. + +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 SUBROUTINES + +Many of the undocumented subroutines implement various magical +parsing shortcuts. + +=over 4 + +=cut + +###################################################################### +###################################################################### + + package Apache::lonpublisher; # ------------------------------------------------- modules used by this module @@ -88,7 +139,36 @@ my $docroot; my $cuname; my $cudom; -# ----------------------------------------------- Evaluate string with metadata +######################################### +######################################### + +=pod + +=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 + +Returns: + +nothing + +=cut + +######################################### +######################################### sub metaeval { my $metastring=shift; @@ -131,14 +211,50 @@ sub metaeval { } } -# -------------------------------------------------------- Read a metadata file +######################################### +######################################### + +=pod + +=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 + +######################################### +######################################### 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); @@ -148,7 +264,39 @@ sub metaread { return '
Processed file: '.$fn.''; } -# ---------------------------- convert 'time' format into a datetime sql format +######################################### +######################################### + +=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) = @@ -157,17 +305,43 @@ sub sqltime { return "$year-$mon-$mday $hour:$min:$sec"; } -# --------------------------------------------------------- Various form fields +######################################### +######################################### + +=pod + +=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 B + +=item B + +=item B + +=back + +=cut + +######################################### +######################################### sub textfield { my ($title,$name,$value)=@_; return "\n

$title:
". - ''; + ''; } sub hiddenfield { my ($name,$value)=@_; - return "\n".''; + return "\n".''; } sub selectbox { @@ -185,8 +359,19 @@ sub selectbox { return $selout.''; } -# -------------------------------------------------------- Publication Step One +######################################### +######################################### + +=pod + +=item B + +Fix up a url? First step of publication + +=cut +######################################### +######################################### sub urlfixup { my ($url,$target)=@_; unless ($url) { return ''; } @@ -207,7 +392,19 @@ sub urlfixup { return $url; } +######################################### +######################################### + +=pod + +=item B +Currently undocumented. + +=cut + +######################################### +######################################### sub absoluteurl { my ($url,$target)=@_; unless ($url) { return ''; } @@ -218,6 +415,19 @@ sub absoluteurl { return $url; } +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### sub set_allow { my ($allow,$logfile,$target,$tag,$oldurl)=@_; my $newurl=&urlfixup($oldurl,$target); @@ -236,6 +446,19 @@ sub set_allow { return $return_url } +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### sub get_subscribed_hosts { my ($target)=@_; my @subscribed; @@ -262,13 +485,26 @@ sub get_subscribed_hosts { } } } 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; } +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### sub get_max_ids_indices { my ($content)=@_; my $maxindex=10; @@ -300,6 +536,19 @@ sub get_max_ids_indices { return ($needsfixup,$maxid,$maxindex); } +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### sub get_all_text_unbalanced { #there is a copy of this in lonxml.pm my($tag,$pars)= @_; @@ -329,6 +578,19 @@ sub get_all_text_unbalanced { return $result } +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### #Arguably this should all be done as a lonnet::ssi instead sub fix_ids_and_indices { my ($logfile,$source,$target)=@_; @@ -473,7 +735,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. @@ -524,6 +786,23 @@ sub store_metadata { return (undef,$status); } +######################################### +######################################### + +=pod + +=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), + +I + +=cut + +######################################### +######################################### sub publish { my ($source,$target,$style)=@_; @@ -575,15 +854,16 @@ 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' => time); $thisdep=~/^\/res\/(\w+)\/(\w+)\//; if ((defined($1)) && (defined($2))) { - &Apache::lonnet::put('resevaldata',\%temphash,$1,$2); + &Apache::lonnet::put('nohist_resevaldata',\%temphash, + $1,$2); } } } @@ -592,23 +872,24 @@ 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"; + 'No write permission to '.$source. + ', FAIL'; } - 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=(); @@ -819,8 +1100,8 @@ END $scrout.=&textfield('Publisher/Owner','owner', $metadatafields{'owner'}); -# --------------------------------------------------- Correct copyright for rat +# -------------------------------------------------- Correct copyright for rat. if ($style eq 'rat') { if ($metadatafields{'copyright'} eq 'public') { delete $metadatafields{'copyright'}; @@ -837,17 +1118,53 @@ END (&Apache::loncommon::copyrightids)); } - my $copyright_help = Apache::loncommon::help_open_topic("Publishing_Copyright"); + my $copyright_help = + Apache::loncommon::help_open_topic('Publishing_Copyright'); $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; return $scrout. - '

'; + '

'; } -# -------------------------------------------------------- Publication Step Two +######################################### +######################################### + +=pod + +=item B + +Render second interface showing status of publication steps. +This is publication step two. + +Parameters: + +=over 4 + +=item I<$source> +=item I<$target> + +=item I<$style> + +=item I<$distarget> + +=back + +Returns: + +=over 4 + +=item Scalar string + +String contains status (errors and warnings) and information associated with +the server's attempts at publication. + +=cut + +######################################### +######################################### sub phasetwo { - my ($source,$target,$style,$distarget)=@_; + my ($source,$target,$style,$distarget,$batch)=@_; my $logfile; my $scrout=''; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { @@ -869,17 +1186,20 @@ sub phasetwo { $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{'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'}) && (ref($ENV{'form.keywords'}))) { - my @Keywords = @{$ENV{'form.keywords'}}; - foreach (@Keywords) { - $allkeywords.=','.$_; + if (exists($ENV{'form.keywords'})) { + if (ref($ENV{'form.keywords'})) { + $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}}); + } else { + $allkeywords .= ','.$ENV{'form.keywords'}; } } $allkeywords=~s/\W+/\,/; @@ -920,7 +1240,7 @@ sub phasetwo { $metadatafields{'version'} = 'current'; unless ($metadatafields{'copyright'} eq 'priv') { my ($error,$success) = &store_metadata(\%metadatafields); - if (! $success) { + if ($success) { $scrout.='

Synchronized SQL metadata database'; print $logfile "\nSynchronized SQL metadata database"; } else { @@ -1048,7 +1368,7 @@ if (-e $target) { } # ------------------------------------------------ Provide link to new resource - + unless ($batch) { my $thisdistarget=$target; $thisdistarget=~s/^$docroot//; @@ -1060,15 +1380,128 @@ if (-e $target) { return $warning.$scrout. - '

View Published Version'. + '
'. + 'View Published Version'. '

Back to Source'. '

Back to Source Directory'; + '">Back to Source Directory'; + } +} + +######################################### + +sub batchpublish { + my ($r,$srcfile)=@_; + my $thisdisfn=$srcfile; + $thisdisfn=~s/\/home\/korte\/public_html\///; + $srcfile=~s/\/+/\//g; + + + undef %metadatafields; + undef %metadatakeys; + %metadatafields=(); + %metadatakeys=(); + + $r->print('

Publishing '.$thisdisfn.'

'); +# phase two takes +# my ($source,$target,$style,$distarget,batch)=@_; +# $ENV{'form.allmeta'} + +} + +######################################### +sub publishdirectory { + my ($r,$fn,$thisdisfn)=@_; + 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. + + opendir(DIR,$fn); + my @files=sort(readdir(DIR)); + foreach my $filename (@files) { + my ($cdev,$cino,$cmode,$cnlink, + $cuid,$cgid,$crdev,$csize, + $catime,$cmtime,$cctime, + $cblksize,$cblocks)=stat($fn.'/'.$filename); + + my $extension=''; + if ($filename=~/\.(\w+)$/) { $extension=$1; } + if ($cmode&$dirptr) { + if (($filename!~/^\./) && ($ENV{'form.pubrec'})) { + &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename); + } + } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && + ($filename!~/^[\#\.]/) && ($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); + } else { + $r->print('
Skipping '.$filename.'
'); + } + $r->rflush(); + } + } + closedir(DIR); } +######################################### -# ================================================================ Main Handler +=pod + +=item B + +A basic outline of the handler subroutine follows. + +=over 4 + +=item * + +Get query string for limited number of parameters. + +=item * + +Check filename. + +=item * + +File is there and owned, init lookup tables. + +=item * + +Start page output. + +=item * + +Evaluate individual file, and then output information. + +=item * + +Publishing from $thisfn to $thistarget with $thisembstyle. +=back + +=cut + +######################################### +######################################### sub handler { my $r=shift; @@ -1140,7 +1573,7 @@ sub handler { unless ($ENV{'form.phase'} eq 'two') { -# --------------------------------- File is there and owned, init lookup tables +# -------------------------------- File is there and owned, init lookup tables. %addid=(); @@ -1164,56 +1597,61 @@ unless ($ENV{'form.phase'} eq 'two') { } -# ----------------------------------------------------------- Start page output +# ---------------------------------------------------------- Start page output. $r->content_type('text/html'); $r->send_http_header; $r->print('LON-CAPA Publishing'); - $r->print( - ''); + $r->print(&Apache::loncommon::bodytag('Resource Publication')); my $thisfn=$fn; - -# ------------------------------------------------------------- Individual file - { - $thisfn=~/\.(\w+)$/; - my $thistype=$1; - my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - my $thistarget=$thisfn; + my $thistarget=$thisfn; - $thistarget=~s/^\/home/$targetdir/; - $thistarget=~s/\/public\_html//; + $thistarget=~s/^\/home/$targetdir/; + $thistarget=~s/\/public\_html//; + + my $thisdistarget=$thistarget; + $thisdistarget=~s/^$docroot//; + + my $thisdisfn=$thisfn; + $thisdisfn=~s/^\/home\/$cuname\/public_html\///; - my $thisdistarget=$thistarget; - $thisdistarget=~s/^$docroot//; + if ($fn=~/\/$/) { +# -------------------------------------------------------- This is a directory + &publishdirectory($r,$fn,$thisdisfn); - my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/$cuname\/public_html\///; + } else { +# ---------------------- Evaluate individual file, and then output information. + $thisfn=~/\.(\w+)$/; + my $thistype=$1; + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); $r->print('

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

Target: '.$thisdistarget.'

'); + ''.$thisdisfn. + 'Target: '.$thisdistarget.'

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

Co-Author: '.$cuname.' at '.$cudom. - '

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

Co-Author: '.$cuname.' at '.$cudom. + '

'); } if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { - $r->print('
Diffs with Current Version

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

'); } -# ------------ We are publishing from $thisfn to $thistarget with $thisembstyle +# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. unless ($ENV{'form.phase'} eq 'two') { $r->print( - '

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