--- loncom/publisher/lonpublisher.pm 2002/05/07 18:07:46 1.80 +++ loncom/publisher/lonpublisher.pm 2003/11/01 17:09:52 1.141 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.80 2002/05/07 18:07:46 matthew Exp $ +# $Id: lonpublisher.pm,v 1.141 2003/11/01 17:09:52 www 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 # ### @@ -61,6 +57,77 @@ ## ## ############################################################################### + +###################################################################### +###################################################################### + +=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 OVERVIEW + +Authors can only write-access the C space. They can +copy resources into the resource area through the publication step, +and move them back through a recover step. Authors do not have direct +write-access to their resource space. + +During the publication step, several events will be +triggered. Metadata is gathered, where a wizard manages default +entries on a hierarchical per-directory base: The wizard imports the +metadata (including access privileges and royalty information) from +the most recent published resource in the current directory, and if +that is not available, from the next directory above, etc. The Network +keeps all previous versions of a resource and makes them available by +an explicit version number, which is inserted between the file name +and extension, for example C, while the most recent +version does not carry a version number (C). Servers +subscribing to a changed resource are notified that a new version is +available. + +=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 @@ -70,110 +137,220 @@ 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 Apache::lonlocal; +use vars qw(%metadatafields %metadatakeys); my %addid; my %nokey; -my %metadatafields; -my %metadatakeys; - 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 ($metastring,$prefix)=@_; - my $parser=HTML::LCParser->new(\$metastring); - my $token; - while ($token=$parser->get_token) { - if ($token->[0] eq 'S') { - my $entry=$token->[1]; - my $unikey=$entry; - if (defined($token->[2]->{'package'})) { - $unikey.='_package_'.$token->[2]->{'package'}; - } - if (defined($token->[2]->{'part'})) { - $unikey.='_'.$token->[2]->{'part'}; - } - if (defined($token->[2]->{'id'})) { - $unikey.='_'.$token->[2]->{'id'}; - } - if (defined($token->[2]->{'name'})) { - $unikey.='_'.$token->[2]->{'name'}; - } - foreach (@{$token->[3]}) { - $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; - if ($metadatakeys{$unikey}) { - $metadatakeys{$unikey}.=','.$_; - } else { - $metadatakeys{$unikey}=$_; - } - } - if ($metadatafields{$unikey}) { - my $newentry=$parser->get_text('/'.$entry); - unless (($metadatafields{$unikey}=~/$newentry/) || - ($newentry eq '')) { - $metadatafields{$unikey}.=', '.$newentry; - } - } else { - $metadatafields{$unikey}=$parser->get_text('/'.$entry); - } - } - } + my $parser=HTML::LCParser->new(\$metastring); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $entry=$token->[1]; + my $unikey=$entry; + if (defined($token->[2]->{'package'})) { + $unikey.='_package_'.$token->[2]->{'package'}; + } + if (defined($token->[2]->{'part'})) { + $unikey.='_'.$token->[2]->{'part'}; + } + if (defined($token->[2]->{'id'})) { + $unikey.='_'.$token->[2]->{'id'}; + } + if (defined($token->[2]->{'name'})) { + $unikey.='_'.$token->[2]->{'name'}; + } + foreach (@{$token->[3]}) { + $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; + if ($metadatakeys{$unikey}) { + $metadatakeys{$unikey}.=','.$_; + } else { + $metadatakeys{$unikey}=$_; + } + } + my $newentry=$parser->get_text('/'.$entry); + if ($entry eq 'customdistributionfile') { + $newentry=~s/^\s*//; + if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; } + } + if ($metadatafields{$unikey}) { + unless (($metadatafields{$unikey}=~/\Q$newentry\E/) || + ($newentry eq '')) { + $metadatafields{$unikey}.=', '.$newentry; + } + } else { + $metadatafields{$unikey}=$newentry; + } + } + } } -# -------------------------------------------------------- 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)=@_; + my ($logfile,$fn,$prefix)=@_; unless (-e $fn) { - print $logfile 'No file '.$fn."\n"; - return '
No file: '.$fn.''; + 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); - $metastring=join('',<$metafh>); + my $metafh=Apache::File->new($fn); + $metastring=join('',<$metafh>); } - &metaeval($metastring); - return '
Processed file: '.$fn.''; + &metaeval($metastring,$prefix); + return '
Processed file: '.$fn.''; } -# ---------------------------- convert 'time' format into a datetime sql format -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. -# --------------------------------------------------------- Various form fields +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:
". - ''; + $value=~s/^\s+//gs; + $value=~s/\s+$//gs; + $value=~s/\s+/ /gs; + $title=&mt($title); + my $uctitle=uc($title); + return "\n

$uctitle:". + "


". + ''; } sub hiddenfield { my ($name,$value)=@_; - return "\n".''; + return "\n".''; } sub selectbox { my ($title,$name,$value,$functionref,@idlist)=@_; + $title=&mt($title); my $uctitle=uc($title); + $value=(split(/\s*,\s*/,$value))[-1]; my $selout="\n

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

Dependencies

'; @@ -403,7 +878,7 @@ sub publish { unless ($style eq 'rat') { $allowstr.="\n".''; } - $scrout.='
'; + $scrout.='
'; unless ($thisdep=~/\*/) { $scrout.=''; } @@ -413,55 +888,56 @@ 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); } } } } - $allowstr=~s/\n+/\n/g; - $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s; + $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s; +### FIXME: is this really what we want? +# I dont' think so, to will corrupt any UTF-8 resources at least, +# and any encoding other than ISO-8859-1 will probably break #Encode any High ASCII characters - $outstring=&HTML::Entities::encode($outstring,"\200-\377"); -# ------------------------------------------------------------- Write modified + #$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"; + return (''.&mt('No write permission to'). + ' '.$source. + ', '.&mt('FAIL').'',1); } - 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

'; + unless ($batch) { + $scrout.='

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

'; + } # ------------------------------------------------ First, check out environment unless (-e $source.'.meta') { @@ -472,20 +948,25 @@ sub publish { $metadatafields{'author'}=~s/\s+/ /g; $metadatafields{'author'}=~s/\s+$//; $metadatafields{'owner'}=$cuname.'@'.$cudom; + $metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'. + $ENV{'user.domain'}; + $metadatafields{'authorspace'}=$cuname.'@'.$cudom; # ------------------------------------------------ Check out directory hierachy my $thisdisfn=$source; - $thisdisfn=~s/^\/home\/$cuname\///; + $thisdisfn=~s/^\/home\/\Q$cuname\E\///; my @urlparts=split(/\//,$thisdisfn); $#urlparts--; my $currentpath='/home/'.$cuname.'/'; + my $prefix='../'x($#urlparts); foreach (@urlparts) { $currentpath.=$_.'/'; - $scrout.=&metaread($logfile,$currentpath.'default.meta'); + $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); + $prefix=~s|^\.\./||; } # ------------------- Clear out parameters and stores (there should not be any) @@ -511,731 +992,862 @@ sub publish { } # -------------------------------------------------- Parse content for metadata - if ($style eq 'ssi') { - my $oldenv=$ENV{'request.uri'}; - - $ENV{'request.uri'}=$target; - $allmeta=Apache::lonxml::xmlparse('meta',$content); - $ENV{'request.uri'}=$oldenv; + if (($style eq 'ssi') || ($style eq 'prv')) { + my $dir=$source; + $dir=~s-/[^/]*$--; + my $file=$source; + $file=(split('/',$file))[-1]; + $source=&Apache::lonnet::hreflocation($dir,$file); + $allmeta=&Apache::lonnet::ssi_body($source,('grade_target' => 'meta')); &metaeval($allmeta); } # ---------------- 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.='

'.&mt('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.='

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

Keywords: - - +

KEYWORDS: + $keywords_help + + +


END - $keywordout.=''; - my $colcount=0; - 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; - } - } - } + $keywordout.='
'; + my $colcount=0; - - foreach (split(/\W+/,$metadatafields{'keywords'})) { - $keywords{$_}=1; - } + 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.= + "\n

ABSTRACT:". + "


". + '

'; $source=~/\.(\w+)$/; $scrout.=&hiddenfield('mime',$1); - $scrout.=&selectbox('Language','language', - $metadatafields{'language'}, + my $defaultlanguage=$metadatafields{'language'}; + $defaultlanguage =~ s/\s*notset\s*//g; + $defaultlanguage =~ s/^,\s*//g; + $defaultlanguage =~ s/,\s*$//g; + + $scrout.=&selectbox('Language','language', + $defaultlanguage, \&Apache::loncommon::languagedescription, (&Apache::loncommon::languageids), - ); + ); - unless ($metadatafields{'creationdate'}) { + unless ($metadatafields{'creationdate'}) { $metadatafields{'creationdate'}=time; - } - $scrout.=&hiddenfield('creationdate',$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'}); -# --------------------------------------------------- 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, - (grep !/^public$/,(&Apache::loncommon::copyrightids))); - } - else { - $scrout.=&selectbox('Copyright/Distribution','copyright', - $metadatafields{'copyright'}, - \&Apache::loncommon::copyrightdescription, - (&Apache::loncommon::copyrightids)); + $metadatafields{'owner'}); + +# -------------------------------------------------- Correct copyright for rat. + 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; + my $uctitle=uc(&mt('Obsolete')); + $scrout.= + "\n

$uctitle:". + '

',0); +# ============================================================================= +# BATCH MODE +# + } else { +# Transfer metadata directly to environment for stage 2 + foreach (keys %metadatafields) { + $ENV{'form.'.$_}=$metadatafields{$_}; + } + $ENV{'form.addkey'}=''; + $ENV{'form.keywords'}=''; + foreach (keys %keywords) { + if ($metadatafields{'keywords'}) { + if ($metadatafields{'keywords'}=~/\Q$_\E/) { + $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); } - return $scrout. - '

'; } -# -------------------------------------------------------- Publication Step Two +######################################### +######################################### -sub phasetwo { +=pod - my ($source,$target,$style,$distarget)=@_; - my $logfile; - my $scrout=''; - unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return - 'No write permission to user directory, FAIL'; - } - print $logfile -"\n================= Publish ".localtime()." Phase Two ================\n"; +=item B - %metadatafields=(); - %metadatakeys=(); +Render second interface showing status of publication steps. +This is publication step two. - &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'})); +Parameters: - $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'}) && (ref($ENV{'form.keywords'}))) { - my @Keywords = @{$ENV{'form.keywords'}}; - foreach (@Keywords) { - $allkeywords.=','.$_; - } - } - $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"; - } +=over 4 -# -------------------------------- Synchronize entry with SQL metadata database - my $warning; +=item I<$source> - unless ($metadatafields{'copyright'} eq 'priv') { +=item I<$target> - my $dbh; +=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 + +#'stupid emacs +######################################### +######################################### +sub phasetwo { + + my ($r,$source,$target,$style,$distarget,$batch)=@_; + $source=~s/\/+/\//g; + $target=~s/\/+/\//g; + + if ($target=~/\_\_\_/) { + $r->print( + ''.&mt('Unsupported character combination'). + ' "___" '.&mt('in filename, FAIL').''); + return 0; + } + $distarget=~s/\/+/\//g; + my $logfile; + unless ($logfile=Apache::File->new('>>'.$source.'.log')) { + $r->print( + ''. + &mt('No write permission to user directory, FAIL').''); + return 0; + } + print $logfile + "\n================= Publish ".localtime()." Phase Two ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\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{'customdistributionfile'}= + $ENV{'form.customdistributionfile'}; + $metadatafields{'obsolete'}=$ENV{'form.obsolete'}; + $metadatafields{'obsoletereplacement'}= + $ENV{'form.obsoletereplacement'}; + $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; + { - 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"; - } + print $logfile "\nWrite metadata file for ".$source; + my $mfh; + unless ($mfh=Apache::File->new('>'.$source.'.meta')) { + return + ''.&mt('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('

'.&mt('Wrote Metadata').'

'); + print $logfile "\nWrote metadata"; } + +# -------------------------------- Synchronize entry with SQL metadata database -} else { - $scrout.='

Private Publication - did not synchronize database'; - print $logfile "\nPrivate: Did not synchronize data into ". - "SQL metadata database"; -} + $metadatafields{'url'} = $distarget; + $metadatafields{'version'} = 'current'; + unless ($metadatafields{'copyright'} eq 'priv') { + my ($error,$success) = &store_metadata(\%metadatafields); + if ($success) { + $r->print('

'.&mt('Synchronized SQL metadata database').'

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

'. + &mt('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 ($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=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) { + $maxversion=($1>$maxversion)?$1:$maxversion; + } + } + } + closedir(DIR); + $maxversion++; + $r->print('

Creating old version '.$maxversion.'

'); + print $logfile "\nCreating old version ".$maxversion."\n"; + + 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('

'.&mt('Copied old target file').'

'); } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy old target, $!, FAIL"; + return "".&mt('Failed to copy old target'). + ", $!, ".&mt('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('

'.&mt('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 + "". +&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""; } } - - -} else { - $scrout.='

Initial version'; - print $logfile "\nInitial version"; -} + + + } else { + $r->print('

'.&mt('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 "Copied original source to ".$copyfile."\n"; - $scrout.='

Copied source file'; - } else { - print $logfile "Unable 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('

'.&mt('Created directory').' '.$parts[$count].'

'); + mkdir($path,0777); } - + } + + if (copy($source,$copyfile)) { + print $logfile "\nCopied original source to ".$copyfile."\n"; + $r->print('

'.&mt('Copied source file').'

'); + } else { + print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; + return "". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""; + } + # --------------------------------------------------------------- Copy Metadata - $copyfile=$copyfile.'.meta'; - - if (copy($source.'.meta',$copyfile)) { - print $logfile "Copied original metadata to ".$copyfile."\n"; - $scrout.='

Copied metadata'; - } else { - print $logfile "Unable 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('

'.&mt('Copied metadata').'

'); + } else { + print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; + return + "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""; + } + $r->rflush; # --------------------------------------------------- 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) { + $r->print('

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


');$r->rflush; + 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) { + $r->print('

'. +&mt('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); + $r->print($reply.'


');$r->rflush; + print $logfile $reply; + } + +# --------------------------------------------------- Notify subscribed courses + my %courses=&coursedependencies($target); + my $now=time; + foreach (keys %courses) { + $r->print('

'.&mt('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; } - closedir(DIR); - -} - # ------------------------------------------------ Provide link to new resource - - 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'; - + unless ($batch) { + my $thisdistarget=$target; + $thisdistarget=~s/^\Q$docroot\E//; + + my $thissrc=$source; + $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/; + + my $thissrcdir=$thissrc; + $thissrcdir=~s/\/[^\/]+$/\//; + + + $r->print( + '


'. + &mt('View Published Version').''. + '

'. + &mt('Back to Source').'

'. + '

'. + &mt('Back to Source Directory').'

'); + } } -# ================================================================ Main Handler - -sub handler { - my $r=shift; - - if ($r->header_only) { - $r->content_type('text/html'); - $r->send_http_header; - return OK; - } - -# Get query string for limited number of parameters - - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['filename']); - -# -------------------------------------------------------------- Check filename - - my $fn=$ENV{'form.filename'}; - - - unless ($fn) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish empty filename', $r->filename); - return HTTP_NOT_FOUND; - } - - ($cuname,$cudom)= - &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); - unless (($cuname) && ($cudom)) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish file '.$ENV{'form.filename'}. - ' ('.$fn.') - not authorized', - $r->filename); - return HTTP_NOT_ACCEPTABLE; - } - - unless (&Apache::lonnet::homeserver($cuname,$cudom) - eq $r->dir_config('lonHostID')) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish file '.$ENV{'form.filename'}. - ' ('.$fn.') - not homeserver ('. - &Apache::lonnet::homeserver($cuname,$cudom).')', - $r->filename); - return HTTP_NOT_ACCEPTABLE; - } - - $fn=~s/^http\:\/\/[^\/]+//; - $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/; - - my $targetdir=''; - $docroot=$r->dir_config('lonDocRoot'); - if ($1 ne $cuname) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish unowned file '.$ENV{'form.filename'}. - ' ('.$fn.')', - $r->filename); - return HTTP_NOT_ACCEPTABLE; - } else { - $targetdir=$docroot.'/res/'.$cudom; - } - - - unless (-e $fn) { - $r->log_reason($cuname.' at '.$cudom. - ' trying to publish non-existing file '.$ENV{'form.filename'}. - ' ('.$fn.')', - $r->filename); - return HTTP_NOT_FOUND; - } - -unless ($ENV{'form.phase'} eq 'two') { +######################################### -# --------------------------------- File is there and owned, init lookup tables +sub batchpublish { + my ($r,$srcfile,$targetfile)=@_; + #publication pollutes %ENV with form.* values + my %oldENV=%ENV; + $srcfile=~s/\/+/\//g; + $targetfile=~s/\/+/\//g; + my $thisdisfn=$srcfile; + $thisdisfn=~s/\/home\/korte\/public_html\///; + $srcfile=~s/\/+/\//g; + + my $docroot=$r->dir_config('lonDocRoot'); + my $thisdistarget=$targetfile; + $thisdistarget=~s/^\Q$docroot\E//; + + + %metadatafields=(); + %metadatakeys=(); + $srcfile=~/\.(\w+)$/; + my $thistype=$1; - %addid=(); - { - my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab'); - while (<$fh>=~/(\w+)\s+(\w+)/) { - $addid{$1}=$2; - } - } - - %nokey=(); - - { - my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); - while (<$fh>) { - my $word=$_; - chomp($word); - $nokey{$word}=1; - } - } + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); + + $r->print('

'.&mt('Publishing').' '.$thisdisfn.'

'); +# phase one takes +# my ($source,$target,$style,$batch)=@_; + 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'},... + if (!$error) { + $r->print('

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

'); + } + %ENV=%oldENV; + return ''; } -# ----------------------------------------------------------- Start page output +######################################### - $r->content_type('text/html'); - $r->send_http_header; - - $r->print('LON-CAPA Publishing'); - $r->print( - ''); - my $thisfn=$fn; - -# ------------------------------------------------------------- Individual file - { - $thisfn=~/\.(\w+)$/; - my $thistype=$1; - my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - - my $thistarget=$thisfn; - - $thistarget=~s/^\/home/$targetdir/; - $thistarget=~s/\/public\_html//; - - my $thisdistarget=$thistarget; - $thisdistarget=~s/^$docroot//; - - my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/$cuname\/public_html\///; - - $r->print('

Publishing '. - &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 (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { - $r->print('
Diffs with Current Version

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


'.&publish($thisfn,$thistarget,$thisembstyle)); - } else { - $r->print( - '
'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); - } - - } - $r->print(''); - - return OK; +sub publishdirectory { + my ($r,$fn,$thisdisfn)=@_; + $fn=~s/\/+/\//g; + $thisdisfn=~s/\/+/\//g; + 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) || ($ENV{'form.forcerepub'})) { +# previously published, modified now + $publishthis=1; + } + } else { +# never published + $publishthis=1; + } + if ($publishthis) { + &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); + } else { + $r->print('
Skipping '.$filename.'
'); + } + $r->rflush(); + } + } + closedir(DIR); } +######################################### -1; -__END__ +=pod -=head1 NAME +=item B -Apache::lonpublisher - Publication Handler +A basic outline of the handler subroutine follows. -=head1 SYNOPSIS +=over 4 -Invoked by /etc/httpd/conf/srm.conf: +=item * - - 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 - +Get query string for limited number of parameters. -=head1 INTRODUCTION +=item * -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. +Check filename. -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. +=item * -=head1 HANDLER SUBROUTINE +File is there and owned, init lookup tables. -This routine is called by Apache and mod_perl. +=item * -=over 4 +Start page output. =item * -Get query string for limited number of parameters +Evaluate individual file, and then output information. =item * -Check filename +Publishing from $thisfn to $thistarget with $thisembstyle. -=item * +=back -File is there and owned, init lookup tables +=cut -=item * +######################################### +######################################### +sub handler { + my $r=shift; -Start page output + if ($r->header_only) { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + return OK; + } -=item * +# Get query string for limited number of parameters -Individual file + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['filename']); -=item * +# -------------------------------------------------------------- Check filename -publish from $thisfn to $thistarget with $thisembstyle + my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); -=back + + unless ($fn) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish empty filename', $r->filename); + return HTTP_NOT_FOUND; + } + + ($cuname,$cudom)= + &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); + unless (($cuname) && ($cudom)) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } -=head1 OTHER SUBROUTINES + unless (&Apache::lonnet::homeserver($cuname,$cudom) + eq $r->dir_config('lonHostID')) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not homeserver ('. + &Apache::lonnet::homeserver($cuname,$cudom).')', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } -=over 4 + $fn=~s/^http\:\/\/[^\/]+//; + $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/; -=item * + my $targetdir=''; + $docroot=$r->dir_config('lonDocRoot'); + if ($1 ne $cuname) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish unowned file '. + $ENV{'form.filename'}.' ('.$fn.')', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } else { + $targetdir=$docroot.'/res/'.$cudom; + } + + + unless (-e $fn) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish non-existing file '. + $ENV{'form.filename'}.' ('.$fn.')', + $r->filename); + return HTTP_NOT_FOUND; + } + + unless ($ENV{'form.phase'} eq 'two') { + +# -------------------------------- File is there and owned, init lookup tables. + + %addid=(); + + { + my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab'); + while (<$fh>=~/(\w+)\s+(\w+)/) { + $addid{$1}=$2; + } + } -metaeval() : Evaluate string with metadata + %nokey=(); -=item * + { + my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); + while (<$fh>) { + my $word=$_; + chomp($word); + $nokey{$word}=1; + } + } -metaread() : Read a metadata file + } -=item * +# ---------------------------------------------------------- Start page output. -sqltime() : convert 'time' format into a datetime sql format + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; -=item * + $r->print('LON-CAPA Publishing'); + $r->print(&Apache::loncommon::bodytag('Resource Publication')); -textfield() : form field -=item * + my $thisfn=$fn; -hiddenfield() : form field + my $thistarget=$thisfn; + + $thistarget=~s/^\/home/$targetdir/; + $thistarget=~s/\/public\_html//; -=item * + my $thisdistarget=$thistarget; + $thisdistarget=~s/^\Q$docroot\E//; -selectbox() : form field + my $thisdisfn=$thisfn; + $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///; -=item * + if ($fn=~/\/$/) { +# -------------------------------------------------------- This is a directory + &publishdirectory($r,$fn,$thisdisfn); + $r->print('
'.&mt('Done').'
'.&mt('Return to Directory').''); -urlfixup() : fixup URL (Publication Step One) -=item * + } else { +# ---------------------- Evaluate individual file, and then output information. + $thisfn=~/\.(\w+)$/; + my $thistype=$1; + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); + $r->print('

'.&mt('Publishing').' '. + &Apache::loncommon::filedescription($thistype).' '); + + $r->print(< +$thisdisfn +ENDCAPTION + $r->print('

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

'.&mt('Co-Author').': '. + $cuname.&mt(' at ').$cudom.'

'); + } -publish() : publish (Publication Step One) + if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { + $r->print(< + +ENDDIFF + $r->print(&mt('Diffs with Current Version').'
'); + } + +# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. -=item * + unless ($ENV{'form.phase'} eq 'two') { + my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); + $r->print('
'.$outstring); + } else { + $r->print('
'); + &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); + } + } + $r->print(''); -phasetwo() : render second interface showing status of publication steps -(Publication Step Two) + return OK; +} + +1; +__END__ + +=pod + +=back =back =cut +