--- loncom/publisher/lonpublisher.pm 2001/12/15 18:15:27 1.65 +++ 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.65 2001/12/15 18:15:27 harris41 Exp $ +# $Id: lonpublisher.pm,v 1.96 2002/09/17 15:01:36 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -41,7 +41,11 @@ # 12/05 Gerd Kortemeyer # 12/05 Guy Albertelli # 12/06,12/07 Gerd Kortemeyer -# 12/15 Scott Harrison +# 12/15,12/16 Scott Harrison +# 12/25 Gerd Kortemeyer +# YEAR=2002 +# 1/16,1/17 Scott Harrison +# 1/17 Gerd Kortemeyer # ### @@ -57,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 @@ -64,13 +119,14 @@ use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); -use HTML::TokeParser; +use HTML::LCParser; use Apache::lonxml; use Apache::lonhomework; use Apache::loncacc; use DBI; use Apache::lonnet(); use Apache::loncommon(); +use Apache::lonmysql; my %addid; my %nokey; @@ -83,11 +139,40 @@ 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; - my $parser=HTML::TokeParser->new(\$metastring); + my $parser=HTML::LCParser->new(\$metastring); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -126,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); @@ -143,25 +264,84 @@ 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) = - localtime(@_[0]); + localtime($timef); $mon++; $year+=1900; 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 { @@ -179,11 +359,27 @@ 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 ''; } + #javascript code needs no fixing + if ($url =~ /^javascript:/i) { return $url; } + if ($url =~ /^mailto:/i) { return $url; } + #internal document links need no fixing + if ($url =~ /^\#/) { return $url; } my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); foreach (values %Apache::lonnet::hostname) { if ($_ eq $host) { @@ -193,6 +389,25 @@ sub urlfixup { } if ($url=~/^http\:\/\//) { return $url; } $url=~s/\~$cuname/res\/$cudom\/$cuname/; + return $url; +} + +######################################### +######################################### + +=pod + +=item B + +Currently undocumented. + +=cut + +######################################### +######################################### +sub absoluteurl { + my ($url,$target)=@_; + unless ($url) { return ''; } if ($target) { $target=~s/\/[^\/]+$//; $url=&Apache::lonnet::hreflocation($target,$url); @@ -200,6 +415,394 @@ sub urlfixup { return $url; } +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### +sub set_allow { + my ($allow,$logfile,$target,$tag,$oldurl)=@_; + my $newurl=&urlfixup($oldurl,$target); + my $return_url=$oldurl; + print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; + if ($newurl ne $oldurl) { + $return_url=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; + } + if (($newurl !~ /^javascript:/i) && + ($newurl !~ /^mailto:/i) && + ($newurl !~ /^http:/i) && + ($newurl !~ /^\#/)) { + $$allow{&absoluteurl($newurl,$target)}=1; + } + return $return_url +} + +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### +sub get_subscribed_hosts { + my ($target)=@_; + my @subscribed; + my $filename; + $target=~/(.*)\/([^\/]+)$/; + my $srcf=$2; + opendir(DIR,$1); + while ($filename=readdir(DIR)) { + if ($filename=~/$srcf\.(\w+)$/) { + my $subhost=$1; + if ($subhost ne 'meta' && $subhost ne 'subscription') { + push(@subscribed,$subhost); + } + } + } + closedir(DIR); + my $sh; + if ( $sh=Apache::File->new("$target.subscription") ) { + &Apache::lonnet::logthis("opened $target.subscription"); + while (my $subline=<$sh>) { + &Apache::lonnet::logthis("Trying $subline"); + if ($subline =~ /(^\w+):/) { 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; +} + + +######################################### +######################################### + +=pod + +=item B + +Currently undocumented + +=cut + +######################################### +######################################### +sub get_max_ids_indices { + my ($content)=@_; + my $maxindex=10; + my $maxid=10; + my $needsfixup=0; + + my $parser=HTML::LCParser->new($content); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $counter; + if ($counter=$addid{$token->[1]}) { + if ($counter eq 'id') { + if (defined($token->[2]->{'id'})) { + $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; + } else { + $needsfixup=1; + } + } else { + if (defined($token->[2]->{'index'})) { + $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex; + } else { + $needsfixup=1; + } + } + } + } + } + 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)= @_; + my $token; + my $result=''; + $tag='<'.$tag.'>'; + while ($token = $$pars[-1]->get_token) { + if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) { + $result.=$token->[1]; + } elsif ($token->[0] eq 'PI') { + $result.=$token->[2]; + } elsif ($token->[0] eq 'S') { + $result.=$token->[4]; + } elsif ($token->[0] eq 'E') { + $result.=$token->[2]; + } + if ($result =~ /(.*)$tag(.*)/) { + #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2); + #&Apache::lonnet::logthis('Result is :'.$1); + $result=$1; + my $redo=$tag.$2; + push (@$pars,HTML::LCParser->new(\$redo)); + $$pars[-1]->xml_mode('1'); + last; + } + } + 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)=@_; + + my %allow; + my $content; + { + my $org=Apache::File->new($source); + $content=join('',<$org>); + } + + my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content); + + if ($needsfixup) { + print $logfile "Needs ID and/or index fixup\n". + "Max ID : $maxid (min 10)\n". + "Max Index: $maxindex (min 10)\n"; + } + my $outstring=''; + my @parser; + $parser[0]=HTML::LCParser->new(\$content); + $parser[-1]->xml_mode(1); + my $token; + while (@parser) { + while ($token=$parser[-1]->get_token) { + if ($token->[0] eq 'S') { + my $counter; + my $tag=$token->[1]; + my $lctag=lc($tag); + if ($lctag eq 'allow') { + $allow{$token->[2]->{'src'}}=1; + next; + } + my %parms=%{$token->[2]}; + $counter=$addid{$tag}; + if (!$counter) { $counter=$addid{$lctag}; } + if ($counter) { + if ($counter eq 'id') { + unless (defined($parms{'id'})) { + $maxid++; + $parms{'id'}=$maxid; + print $logfile 'ID: '.$tag.':'.$maxid."\n"; + } + } elsif ($counter eq 'index') { + unless (defined($parms{'index'})) { + $maxindex++; + $parms{'index'}=$maxindex; + print $logfile 'Index: '.$tag.':'.$maxindex."\n"; + } + } + } + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + $parms{$key}=&set_allow(\%allow,$logfile, + $target,$tag, + $parms{$key}); + } + } + } + # probably a image type

Dependencies

'; my $allowstr=''; - foreach (keys %allow) { + foreach (sort(keys(%allow))) { my $thisdep=$_; + if ($thisdep !~ /[^\s]/) { next; } unless ($style eq 'rat') { $allowstr.="\n".''; } @@ -387,52 +854,52 @@ 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); } } } } - $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s; + $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s; -# ------------------------------------------------------------- Write modified + #Encode any High ASCII characters + $outstring=&HTML::Entities::encode($outstring,"\200-\377"); +# ------------------------------------------------------------- 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; - if ($needsfixup) { - print $logfile "End of ID and/or index fixup\n". - "Max ID : $maxid (min 10)\n". - "Max Index: $maxindex (min 10)\n"; - } else { - print $logfile "Does not need ID and/or index fixup\n"; - } } -# --------------------------------------------- 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=(); - $scrout.='

Metadata Information

'; + + $scrout.='

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

'; # ------------------------------------------------ First, check out environment unless (-e $source.'.meta') { @@ -486,7 +953,7 @@ sub publish { my $oldenv=$ENV{'request.uri'}; $ENV{'request.uri'}=$target; - $allmeta=Apache::lonxml::xmlparse('meta',$content); + $allmeta=Apache::lonxml::xmlparse(undef,'meta',$content); $ENV{'request.uri'}=$oldenv; &metaeval($allmeta); @@ -509,7 +976,7 @@ sub publish { $chparms; } - my $chparms=''; + $chparms=''; foreach (sort keys %oldparmstores) { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless (($metadatafields{$_.'.name'}) || @@ -527,7 +994,7 @@ sub publish { # ------------------------------------------------------- Now have all metadata $scrout.= - '
'. + ''. '

'. &hiddenfield('phase','two'). &hiddenfield('filename',$ENV{'form.filename'}). @@ -539,8 +1006,29 @@ sub publish { # --------------------------------------------------- Scan content for keywords - my $keywordout='

Keywords:
'; + my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords"); + my $keywordout=<<"END"; + +

Keywords: $keywords_help + + +
+END + $keywordout.='

'; my $colcount=0; + my %keywords=(); if (length($content)<500000) { my $textonly=$content; @@ -551,22 +1039,27 @@ sub publish { $textonly=~s/[\$\&][a-z]\w*//g; $textonly=~s/[^a-z\s]//g; - my %keywords=(); foreach ($textonly=~m/(\w+)/g) { unless ($nokey{$_}) { $keywords{$_}=1; } } + } + foreach (split(/\W+/,$metadatafields{'keywords'})) { $keywords{$_}=1; } foreach (sort keys %keywords) { - $keywordout.='\n"; @@ -574,10 +1067,6 @@ sub publish { } $colcount++; } - - } else { - $keywordout.=''; - } $keywordout.='
'; if ($colcount>10) { $keywordout.="
File too long for keyword analysis
'; @@ -597,7 +1086,7 @@ sub publish { $scrout.=&selectbox('Language','language', $metadatafields{'language'}, - \&{Apache::loncommon::languagedescription}, + \&Apache::loncommon::languagedescription, (&Apache::loncommon::languageids), ); @@ -611,34 +1100,73 @@ sub publish { $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'}; } $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'}, - \&{Apache::loncommon::copyrightdescription}, + \&Apache::loncommon::copyrightdescription, (grep !/^public$/,(&Apache::loncommon::copyrightids))); } else { $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'}, - \&{Apache::loncommon::copyrightdescription}, + \&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. - '

'; + '

'; } -# -------------------------------------------------------- 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')) { return 'No write permission to user directory, FAIL'; @@ -658,16 +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'}; - foreach (keys %ENV) { - if ($_=~/^form\.key\.(\w+)/) { - $allkeywords.=','.$1; + if (exists($ENV{'form.keywords'})) { + if (ref($ENV{'form.keywords'})) { + $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}}); + } else { + $allkeywords .= ','.$ENV{'form.keywords'}; } } $allkeywords=~s/\W+/\,/; @@ -693,7 +1225,9 @@ sub phasetwo { $value=~s/\"/\'\'/g; print $mfh ' '.$_.'="'.$value.'"'; } - print $mfh '>'.$metadatafields{$unikey}.''; + print $mfh '>'. + &HTML::Entities::encode($metadatafields{$unikey}) + .''; } } $scrout.='

Wrote Metadata'; @@ -701,64 +1235,23 @@ sub phasetwo { } # -------------------------------- Synchronize entry with SQL metadata database - my $warning; - - unless ($metadatafields{'copyright'} eq 'priv') { - - my $dbh; - { - unless ( - $dbh = DBI->connect("DBI:mysql:loncapa","www", - $Apache::lonnet::perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) - ) { - $warning='WARNING: Cannot connect to '. - 'database!'; - } - else { - my %sqldatafields; - $sqldatafields{'url'}=$distarget; - my $sth=$dbh->prepare( - 'delete from metadata where url like binary'. - '"'.$sqldatafields{'url'}.'"'); - $sth->execute(); - foreach ('title','author','subject','keywords','notes','abstract', - 'mime','language','creationdate','lastrevisiondate','owner', - 'copyright') { - my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; - $sqldatafields{$_}=$field; - } - - $sth=$dbh->prepare('insert into metadata values ('. - '"'.delete($sqldatafields{'title'}).'"'.','. - '"'.delete($sqldatafields{'author'}).'"'.','. - '"'.delete($sqldatafields{'subject'}).'"'.','. - '"'.delete($sqldatafields{'url'}).'"'.','. - '"'.delete($sqldatafields{'keywords'}).'"'.','. - '"'.'current'.'"'.','. - '"'.delete($sqldatafields{'notes'}).'"'.','. - '"'.delete($sqldatafields{'abstract'}).'"'.','. - '"'.delete($sqldatafields{'mime'}).'"'.','. - '"'.delete($sqldatafields{'language'}).'"'.','. - '"'. - sqltime(delete($sqldatafields{'creationdate'})) - .'"'.','. - '"'. - sqltime(delete( - $sqldatafields{'lastrevisiondate'})).'"'.','. - '"'.delete($sqldatafields{'owner'}).'"'.','. - '"'.delete( - $sqldatafields{'copyright'}).'"'.')'); - $sth->execute(); - $dbh->disconnect; - $scrout.='

Synchronized SQL metadata database'; - print $logfile "\nSynchronized 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'; + print $logfile "\nSynchronized SQL metadata database"; + } else { + $warning.=$error; + print $logfile "\n".$error; + } + } else { + $scrout.='

Private Publication - did not synchronize database'; + print $logfile "\nPrivate: Did not synchronize data into ". + "SQL metadata database"; } - -} else { - $scrout.='

Private Publication - did not synchronize database'; - print $logfile "\nPrivate: Did not ynchronized SQL metadata database"; -} # ----------------------------------------------------------- Copy old versions if (-e $target) { @@ -853,59 +1346,29 @@ if (-e $target) { # --------------------------------------------------- Send update notifications -{ - - my $filename; - - $target=~/(.*)\/([^\/]+)$/; - my $srcf=$2; - opendir(DIR,$1); - while ($filename=readdir(DIR)) { - if ($filename=~/$srcf\.(\w+)$/) { - my $subhost=$1; - if ($subhost ne 'meta') { - $scrout.='

Notifying host '.$subhost.':'; - print $logfile "\nNotifying host '.$subhost.':'"; - my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); - $scrout.=$reply; - print $logfile $reply; - } - } + my @subscribed=&get_subscribed_hosts($target); + foreach my $subhost (@subscribed) { + $scrout.='

Notifying host '.$subhost.':'; + print $logfile "\nNotifying host ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + $scrout.=$reply; + print $logfile $reply; } - closedir(DIR); - -} # ---------------------------------------- Send update notifications, meta only -{ - - my $filename; - - $target=~/(.*)\/([^\/]+)$/; - my $srcf=$2.'.meta'; - opendir(DIR,$1); - while ($filename=readdir(DIR)) { - if ($filename=~/$srcf\.(\w+)$/) { - my $subhost=$1; - if ($subhost ne 'meta') { - $scrout.= - '

Notifying host for metadata only '.$subhost.':'; - print $logfile - "\nNotifying host for metadata only '.$subhost.':'"; - my $reply=&Apache::lonnet::critical( - 'update:'.$target.'.meta',$subhost); - $scrout.=$reply; - print $logfile $reply; - } - } + my @subscribedmeta=&get_subscribed_hosts("$target.meta"); + foreach my $subhost (@subscribedmeta) { + $scrout.='

Notifying host for metadata only '.$subhost.':'; + print $logfile "\nNotifying host for metadata only ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', + $subhost); + $scrout.=$reply; + print $logfile $reply; } - closedir(DIR); - -} # ------------------------------------------------ Provide link to new resource - + unless ($batch) { my $thisdistarget=$target; $thisdistarget=~s/^$docroot//; @@ -917,15 +1380,128 @@ if (-e $target) { return $warning.$scrout. - '

View Target'. + '
'. + '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'} } -# ================================================================ Main Handler +######################################### +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); +} +######################################### + +=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; @@ -937,17 +1513,8 @@ sub handler { # Get query string for limited number of parameters - foreach (split(/&/,$ENV{'QUERY_STRING'})) { - my ($name, $value) = split(/=/,$_); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - if ($name eq 'filename') { - unless ($ENV{'form.'.$name}) { - $ENV{'form.'.$name}=$value; - } - } - } - + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['filename']); # -------------------------------------------------------------- Check filename @@ -1006,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=(); @@ -1030,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::lonnet::filedescription($thistype).' '. - $thisdisfn.'

Target: '.$thisdistarget.'

'); + &Apache::loncommon::filedescription($thistype).' '. + ''.$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)); } } @@ -1091,9 +1663,9 @@ unless ($ENV{'form.phase'} eq 'two') { 1; __END__ +=pod +=back - - - +=cut