--- loncom/publisher/lonpublisher.pm 2002/08/09 17:59:14 1.90 +++ loncom/publisher/lonpublisher.pm 2003/12/22 21:57:25 1.148 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.90 2002/08/09 17:59:14 matthew Exp $ +# $Id: lonpublisher.pm,v 1.148 2003/12/22 21:57:25 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,18 +33,14 @@ # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer # 03/23 Guy Albertelli # 03/24,03/29,04/03 Gerd Kortemeyer -# 04/16/2001 Scott Harrison # 05/03,05/05,05/07 Gerd Kortemeyer -# 05/28/2001 Scott Harrison # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer # 12/04,12/05 Guy Albertelli # 12/05 Gerd Kortemeyer # 12/05 Guy Albertelli # 12/06,12/07 Gerd Kortemeyer -# 12/15,12/16 Scott Harrison # 12/25 Gerd Kortemeyer # YEAR=2002 -# 1/16,1/17 Scott Harrison # 1/17 Gerd Kortemeyer # ### @@ -67,28 +63,62 @@ =pod -=head1 Name +=head1 NAME lonpublisher - LON-CAPA publishing handler -=head1 Synopsis +=head1 SYNOPSIS -lonpublisher takes the proper steps to add resources to the LON-CAPA +B is used by B inside B. This is the +invocation by F: + + + PerlAccessHandler Apache::lonacc + SetHandler perl-script + PerlHandler Apache::lonpublisher + ErrorDocument 403 /adm/login + ErrorDocument 404 /adm/notfound.html + ErrorDocument 406 /adm/unauthorized.html + ErrorDocument 500 /adm/errorhandler + + +=head1 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. -=head1 Description - -lonpublisher is many things to many people. -To all people it is woefully documented. -This documentation conforms to this standard. +B is many things to many people. This module publishes a file. This involves gathering metadata, versioning the file, copying file from construction space to publication space, and copying metadata from construction space to publication space. -=head2 Internal Functions +=head2 SUBROUTINES + +Many of the undocumented subroutines implement various magical +parsing shortcuts. =over 4 @@ -107,77 +137,93 @@ 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 Apache::loncfile; +use vars qw(%metadatafields %metadatakeys); my %addid; my %nokey; -my %metadatafields; -my %metadatakeys; - my $docroot; my $cuname; my $cudom; -######################################### -######################################### - =pod -=item metaeval +=item B + +Evaluates a string that contains metadata. This subroutine +stores values inside I<%metadatafields> and I<%metadatakeys>. +The hash key is a I<$unikey> corresponding to a unique id +that is descriptive of the parser location inside the XML tree. -Evaluate string with metadata +Parameters: + +=over 4 + +=item I<$metastring> + +A string that contains metadata. + +=back + +Returns: + +nothing =cut ######################################### ######################################### +# +# Modifies global %metadatafields %metadatakeys +# + 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; } + } + unless ($metadatafields{$unikey}=~/\w/) { + $metadatafields{$unikey}=$newentry; + } + } + } } ######################################### @@ -185,66 +231,97 @@ sub metaeval { =pod -=item metaread +=item B Read a metadata file +Parameters: + +=over + +=item I<$logfile> + +File output stream to output errors and warnings to. + +=item I<$fn> + +File name (including path). + +=back + +Returns: + +=over 4 + +=item Scalar string (if successful) + +XHTML text that indicates successful reading of the metadata. + +=back + =cut ######################################### ######################################### 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 '
'.&mt('No file').': '. + &Apache::loncfile::display($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 '
'.&mt('Processed file').': '. + &Apache::loncfile::display($fn).''; } ######################################### ######################################### -=pod - -=item sqltime - -Convert 'time' format into a datetime sql format - -=cut - -######################################### -######################################### -sub sqltime { - my $timef=shift @_; - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = - localtime($timef); - $mon++; $year+=1900; - return "$year-$mon-$mday $hour:$min:$sec"; +sub coursedependencies { + my $url=&Apache::lonnet::declutter(shift); + $url=~s/\.meta$//; + my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); + my $regexp=$url; + $regexp=~s/(\W)/\\$1/g; + $regexp='___'.$regexp.'___course'; + my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, + $aauthor,$regexp); + my %courses=(); + foreach (keys %evaldata) { + if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { + $courses{$1}=1; + } + } + return %courses; } - - ######################################### ######################################### + =pod -=item Form field generating functions +=item Form-field-generating subroutines. + +For input parameters, these subroutines take in values +such as I<$name>, I<$value> and other form field metadata. +The output (scalar string that is returned) is an XHTML +string which presents the form field (foreseeably inside +
tags). =over 4 -=item textfield +=item B -=item hiddenfield +=item B -=item selectbox +=item B =back @@ -254,20 +331,28 @@ sub sqltime { ######################################### 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

'; + $scrout.='

'.&mt('Dependencies').'

'; my $allowstr=''; foreach (sort(keys(%allow))) { my $thisdep=$_; @@ -759,7 +906,7 @@ sub publish { unless ($style eq 'rat') { $allowstr.="\n".''; } - $scrout.='
'; + $scrout.='
'; unless ($thisdep=~/\*/) { $scrout.=''; } @@ -769,50 +916,57 @@ sub publish { if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= - ' - Currently not available'; + $scrout.= ' - '.&mt('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/\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; } -# --------------------------------------------- Initial step done, now metadata - -# ---------------------------------------- Storage for metadata keys and fields +# -------------------------------------------- Initial step done, now metadata. +# --------------------------------------- Storage for metadata keys and fields. +# these are globals +# %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') { @@ -823,20 +977,29 @@ 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; +# ----------------------------------------------------------- Parse file itself +# read %metadatafields from file itself + + $allmeta=&parseformeta($source,$style); # ------------------------------------------------ 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) @@ -858,183 +1021,244 @@ sub publish { delete $metadatafields{$_}; } } - - } - -# -------------------------------------------------- Parse content for metadata - if ($style eq 'ssi') { - my $oldenv=$ENV{'request.uri'}; - - $ENV{'request.uri'}=$target; - $allmeta=Apache::lonxml::xmlparse(undef,'meta',$content); - $ENV{'request.uri'}=$oldenv; +# ------------------------------------------ See if anything new in file itself + + $allmeta=&parseformeta($source,$style); + } - &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.'

'.&mt('Warning!'). + '

'. + &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'

'; + } # ------------------------------------------------------- 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 $KEYWORDS=&mt('KEYWORDS'); + my $CheckAll=&mt('check all'); + my $UncheckAll=&mt('uncheck all'); my $keywordout=<<"END"; -

Keywords: $keywords_help - - +

$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

".&mt('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 + $metadatafields{'owner'}); - 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)); - } - - my $copyright_help = Apache::loncommon::help_open_topic("Publishing_Copyright"); - $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; - return $scrout. - '

'; +# -------------------------------------------------- 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); + } } ######################################### @@ -1042,260 +1266,435 @@ END =pod -=item phasetwo +=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 +#'stupid emacs ######################################### ######################################### sub phasetwo { - my ($source,$target,$style,$distarget)=@_; + 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; - my $scrout=''; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return - 'No write permission to user directory, FAIL'; + $r->print( + ''. + &mt('No write permission to user directory, FAIL').''); + return 0; } print $logfile -"\n================= Publish ".localtime()." Phase Two ================\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{'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"; - } - + "\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; + + { + 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 - 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'; + if ($success) { + $r->print('

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

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

Private Publication - did not synchronize database'; + $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 @subscribed=&get_subscribed_hosts($target); foreach my $subhost (@subscribed) { - $scrout.='

Notifying host '.$subhost.':'; + $r->print('

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


');$r->rflush; print $logfile $reply; } - + # ---------------------------------------- Send update notifications, meta only my @subscribedmeta=&get_subscribed_hosts("$target.meta"); foreach my $subhost (@subscribedmeta) { - $scrout.='

Notifying host for metadata only '.$subhost.':'; + $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); - $scrout.=$reply; + $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; } - # ------------------------------------------------ Provide link to new resource + 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').'

'); + } +} - my $thisdistarget=$target; - $thisdistarget=~s/^$docroot//; +######################################### - my $thissrc=$source; - $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/; +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 $thissrcdir=$thissrc; - $thissrcdir=~s/\/[^\/]+$/\//; + my $docroot=$r->dir_config('lonDocRoot'); + my $thisdistarget=$targetfile; + $thisdistarget=~s/^\Q$docroot\E//; - return $warning.$scrout. - '
View Published Version'. - '

Back to Source'. - '

Back to Source Directory'; + %metadatafields=(); + %metadatakeys=(); + $srcfile=~/\.(\w+)$/; + my $thistype=$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 ''; +} ######################################### + +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); +} ######################################### =pod -=item handler +=item B A basic outline of the handler subroutine follows. =over 4 -=item Get query string for limited number of parameters +=item * + +Get query string for limited number of parameters. -=item Check filename +=item * -=item File is there and owned, init lookup tables +Check filename. -=item Start page output +=item * -=item Individual file +File is there and owned, init lookup tables. -=item publish from $thisfn to $thistarget with $thisembstyle +=item * + +Start page output. + +=item * + +Evaluate individual file, and then output information. + +=item * + +Publishing from $thisfn to $thistarget with $thisembstyle. =back @@ -1304,13 +1703,13 @@ A basic outline of the handler subroutin ######################################### ######################################### sub handler { - my $r=shift; + my $r=shift; - if ($r->header_only) { - $r->content_type('text/html'); - $r->send_http_header; - return OK; - } + if ($r->header_only) { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + return OK; + } # Get query string for limited number of parameters @@ -1319,141 +1718,156 @@ sub handler { # -------------------------------------------------------------- Check filename - my $fn=$ENV{'form.filename'}; + my $fn=&Apache::lonnet::unescape($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 ($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 (-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; + } + } -unless ($ENV{'form.phase'} eq 'two') { + %nokey=(); -# --------------------------------- File is there and owned, init lookup tables + { + my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); + while (<$fh>) { + my $word=$_; + chomp($word); + $nokey{$word}=1; + } + } - %addid=(); + } - { - my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab'); - while (<$fh>=~/(\w+)\s+(\w+)/) { - $addid{$1}=$2; - } - } +# ---------------------------------------------------------- Start page output. - %nokey=(); + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; - { - my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); - while (<$fh>) { - my $word=$_; - chomp($word); - $nokey{$word}=1; - } - } + $r->print('LON-CAPA Publishing'); + $r->print(&Apache::loncommon::bodytag('Resource Publication')); -} -# ----------------------------------------------------------- Start page output + my $thisfn=$fn; - $r->content_type('text/html'); - $r->send_http_header; + my $thistarget=$thisfn; + + $thistarget=~s/^\/home/$targetdir/; + $thistarget=~s/\/public\_html//; - $r->print('LON-CAPA Publishing'); - $r->print( - ''); - my $thisfn=$fn; - -# ------------------------------------------------------------- Individual file - { - $thisfn=~/\.(\w+)$/; - my $thistype=$1; - my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); + my $thisdistarget=$thistarget; + $thisdistarget=~s/^\Q$docroot\E//; - my $thistarget=$thisfn; - - $thistarget=~s/^\/home/$targetdir/; - $thistarget=~s/\/public\_html//; + my $thisdisfn=$thisfn; + $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///; - my $thisdistarget=$thistarget; - $thisdistarget=~s/^$docroot//; + if ($fn=~/\/$/) { +# -------------------------------------------------------- This is a directory + &publishdirectory($r,$fn,$thisdisfn); + $r->print('
'.&mt('Done').'
'.&mt('Return to Directory').''); - my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/$cuname\/public_html\///; - $r->print('

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

Target: '.$thisdistarget.'

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

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 + if (($cuname ne $ENV{'user.name'})||($cudom ne $ENV{'user.domain'})) { + $r->print('

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

'); + } - unless ($ENV{'form.phase'} eq 'two') { - $r->print( - '
'.&publish($thisfn,$thistarget,$thisembstyle)); - } else { - $r->print( - '
'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); - } + if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { + $r->print(< + +ENDDIFF + $r->print(&mt('Diffs with Current Version').'
'); + } + +# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. - } - $r->print(''); + 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(''); - return OK; + return OK; } 1; @@ -1463,5 +1877,7 @@ __END__ =back +=back + =cut 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.