--- loncom/publisher/lonpublisher.pm 2003/09/24 19:40:14 1.126.2.2 +++ loncom/publisher/lonpublisher.pm 2003/11/08 11:20:22 1.145 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.126.2.2 2003/09/24 19:40:14 albertel Exp $ +# $Id: lonpublisher.pm,v 1.145 2003/11/08 11:20:22 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -82,6 +82,26 @@ invocation by F: 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 @@ -122,6 +142,8 @@ use DBI; use Apache::lonnet(); use Apache::loncommon(); use Apache::lonmysql; +use Apache::lonlocal; +use Apache::loncfile; use vars qw(%metadatafields %metadatakeys); my %addid; @@ -159,46 +181,49 @@ nothing ######################################### ######################################### +# +# 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}=~/\Q$newentry\E/) || - ($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; + } + } + } } ######################################### @@ -239,19 +264,21 @@ XHTML text that indicates successful rea ######################################### ######################################### sub metaread { - my ($logfile,$fn)=@_; + my ($logfile,$fn,$prefix)=@_; unless (-e $fn) { print($logfile 'No file '.$fn."\n"); - return '
No file: '.$fn.''; + return '
No file: '. + &Apache::loncfile::display($fn).''; } 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: '. + &Apache::loncfile::display($fn).''; } ######################################### @@ -304,6 +331,10 @@ string which presents the form field (fo ######################################### sub textfield { my ($title,$name,$value)=@_; + $value=~s/^\s+//gs; + $value=~s/\s+$//gs; + $value=~s/\s+/ /gs; + $title=&mt($title); my $uctitle=uc($title); return "\n

$uctitle:". "


". @@ -317,6 +348,7 @@ sub hiddenfield { 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:". @@ -785,6 +817,26 @@ sub store_metadata { return (undef,$status); } + +# ============================================== Parse file itself for metadata +# +# parses a file with target meta, sets global %metadatafields %metadatakeys + +sub parseformeta { + my ($source,$style)=@_; + my $allmeta=''; + 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); + } + return $allmeta; +} + ######################################### ######################################### @@ -874,16 +926,20 @@ sub publish { } $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"); + #$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',1); + return (''.&mt('No write permission to'). + ' '.$source. + ', '.&mt('FAIL').'',1); } print($org $outstring); } @@ -893,14 +949,15 @@ sub publish { # -------------------------------------------- Initial step done, now metadata. # --------------------------------------- Storage for metadata keys and fields. - +# these are globals +# %metadatafields=(); %metadatakeys=(); my %oldparmstores=(); unless ($batch) { - $scrout.='

Metadata Information ' . + $scrout.='

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

'; } @@ -918,6 +975,10 @@ sub publish { $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; @@ -928,9 +989,11 @@ sub publish { 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) @@ -952,19 +1015,12 @@ sub publish { delete $metadatafields{$_}; } } - - } +# ------------------------------------------ See if anything new in file itself + + $allmeta=&parseformeta($source,$style); + } -# -------------------------------------------------- Parse content for metadata - if (($style eq 'ssi') || ($style eq 'prv')) { - my $oldenv=$ENV{'request.uri'}; - - $ENV{'request.uri'}=$target; - $allmeta=Apache::lonxml::xmlparse(undef,'meta',$content); - $ENV{'request.uri'}=$oldenv; - - &metaeval($allmeta); - } + # ---------------- Find and document discrepancies in the parameters and stores my $chparms=''; @@ -979,7 +1035,8 @@ sub publish { } } if ($chparms) { - $scrout.='

New parameters or stored values: '.$chparms.'

'; + $scrout.='

'.&mt('New parameters or stored values'). + ': '.$chparms.'

'; } $chparms=''; @@ -993,8 +1050,10 @@ sub publish { } } if ($chparms) { - $scrout.='

Obsolete parameters or stored values: '. - $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 @@ -1146,10 +1205,22 @@ END $scrout.=&textfield('Custom Distribution File','customdistributionfile', $metadatafields{'customdistributionfile'}). $copyright_help; + my $uctitle=uc(&mt('Obsolete')); + $scrout.= + "\n

$uctitle:". + '

',0); + return ($scrout.'

',0); # ============================================================================= # BATCH MODE # @@ -1227,14 +1298,16 @@ sub phasetwo { if ($target=~/\_\_\_/) { $r->print( - 'Unsupported character combination "___" in filename, FAIL'); + ''.&mt('Unsupported character combination'). + ' "___" '.&mt('in filename, FAIL').''); return 0; } $distarget=~s/\/+/\//g; my $logfile; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { $r->print( - 'No write permission to user directory, FAIL'); + ''. + &mt('No write permission to user directory, FAIL').''); return 0; } print $logfile @@ -1258,6 +1331,9 @@ sub phasetwo { $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'}; @@ -1277,7 +1353,8 @@ sub phasetwo { my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { return - 'Could not write metadata, FAIL'; + ''.&mt('Could not write metadata, FAIL'). + ''; } foreach (sort keys %metadatafields) { unless ($_=~/\./) { @@ -1296,7 +1373,7 @@ sub phasetwo { .''; } } - $r->print('

Wrote Metadata

'); + $r->print('

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

'); print $logfile "\nWrote metadata"; } @@ -1307,14 +1384,15 @@ sub phasetwo { unless ($metadatafields{'copyright'} eq 'priv') { my ($error,$success) = &store_metadata(\%metadatafields); if ($success) { - $r->print('

Synchronized SQL metadata database

'); + $r->print('

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

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

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"; } @@ -1351,10 +1429,11 @@ sub phasetwo { if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; - $r->print('

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 @@ -1363,18 +1442,19 @@ sub phasetwo { if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $r->print('

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

Initial version

'); + $r->print('

'.&mt('Initial version').'

'); print $logfile "\nInitial version"; } @@ -1389,17 +1469,18 @@ sub phasetwo { $path.="/$parts[$count]"; if ((-e $path)!=1) { print $logfile "\nCreating directory ".$path; - $r->print('

Created directory '.$parts[$count].'

'); + $r->print('

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

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

Copied source file

'); + $r->print('

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

'); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - return "Failed to copy source, $!, FAIL"; + return "". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""; } # --------------------------------------------------------------- Copy Metadata @@ -1408,18 +1489,18 @@ sub phasetwo { if (copy($source.'.meta',$copyfile)) { print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $r->print('

Copied metadata

'); + $r->print('

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

'); } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; return - "Failed to write metadata copy, $!, FAIL"; + "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""; } $r->rflush; # --------------------------------------------------- Send update notifications my @subscribed=&get_subscribed_hosts($target); foreach my $subhost (@subscribed) { - $r->print('

Notifying host '.$subhost.':');$r->rflush; + $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; @@ -1430,7 +1511,8 @@ sub phasetwo { my @subscribedmeta=&get_subscribed_hosts("$target.meta"); foreach my $subhost (@subscribedmeta) { - $r->print('

Notifying host for metadata only '.$subhost.':');$r->rflush; + $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); @@ -1442,7 +1524,7 @@ sub phasetwo { my %courses=&coursedependencies($target); my $now=time; foreach (keys %courses) { - $r->print('

Notifying course '.$_.':');$r->rflush; + $r->print('

'.&mt('Notifying course').' '.$_.':');$r->rflush; print $logfile "\nNotifying host ".$_.':'; my ($cdom,$cname)=split(/\_/,$_); my $reply=&Apache::lonnet::cput @@ -1464,10 +1546,12 @@ sub phasetwo { $r->print( '

'. - 'View Published Version'. - '

Back to Source

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

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

'. '

Back to Source Directory

'); + '">'. + &mt('Back to Source Directory').'

'); } } @@ -1475,6 +1559,8 @@ sub phasetwo { sub batchpublish { my ($r,$srcfile,$targetfile)=@_; + #publication pollutes %ENV with form.* values + my %oldENV=%ENV; $srcfile=~s/\/+/\//g; $targetfile=~s/\/+/\//g; my $thisdisfn=$srcfile; @@ -1486,17 +1572,15 @@ sub batchpublish { $thisdistarget=~s/^\Q$docroot\E//; - undef %metadatafields; - undef %metadatakeys; - %metadatafields=(); - %metadatakeys=(); - $srcfile=~/\.(\w+)$/; - my $thistype=$1; + %metadatafields=(); + %metadatakeys=(); + $srcfile=~/\.(\w+)$/; + my $thistype=$1; - my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - $r->print('

Publishing '.$thisdisfn.'

'); + $r->print('

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

'); # phase one takes # my ($source,$target,$style,$batch)=@_; @@ -1510,6 +1594,7 @@ sub batchpublish { &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); $r->print('

'); } + %ENV=%oldENV; return ''; } @@ -1520,53 +1605,53 @@ sub publishdirectory { $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, + $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!~/\~$/)) { + 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 $publishthis=0; + if (-e $resdir.'/'.$filename) { my ($rdev,$rino,$rmode,$rnlink, - $ruid,$rgid,$rrdev,$rsize, - $ratime,$rmtime,$rctime, - $rblksize,$rblocks)=stat($resdir.'/'.$filename); + $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 { + } else { # never published - $publishthis=1; - } - if ($publishthis) { + $publishthis=1; + } + if ($publishthis) { &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); - } else { - $r->print('
Skipping '.$filename.'
'); - } - $r->rflush(); - } - } - closedir(DIR); + } else { + $r->print('
Skipping '.$filename.'
'); + } + $r->rflush(); + } + } + closedir(DIR); } ######################################### @@ -1609,13 +1694,13 @@ Publishing from $thisfn to $thistarget w ######################################### ######################################### 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 @@ -1624,146 +1709,156 @@ sub handler { # -------------------------------------------------------------- Check filename - my $fn=&Apache::lonnet::unescape($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') { + unless ($ENV{'form.phase'} eq 'two') { # -------------------------------- File is there and owned, init lookup tables. - %addid=(); + %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 $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; + } + } + + } # ---------------------------------------------------------- Start page output. - $r->content_type('text/html'); - $r->send_http_header; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; - $r->print('LON-CAPA Publishing'); - $r->print(&Apache::loncommon::bodytag('Resource Publication')); + $r->print('LON-CAPA Publishing'); + $r->print(&Apache::loncommon::bodytag('Resource Publication')); - my $thisfn=$fn; + my $thisfn=$fn; - my $thistarget=$thisfn; + my $thistarget=$thisfn; - $thistarget=~s/^\/home/$targetdir/; - $thistarget=~s/\/public\_html//; + $thistarget=~s/^\/home/$targetdir/; + $thistarget=~s/\/public\_html//; - my $thisdistarget=$thistarget; - $thisdistarget=~s/^\Q$docroot\E//; + my $thisdistarget=$thistarget; + $thisdistarget=~s/^\Q$docroot\E//; - my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///; + my $thisdisfn=$thisfn; + $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///; - if ($fn=~/\/$/) { + if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory - &publishdirectory($r,$fn,$thisdisfn); + &publishdirectory($r,$fn,$thisdisfn); + $r->print('
'.&mt('Done').'
'.&mt('Return to Directory').''); - } else { + + } else { # ---------------------- Evaluate individual file, and then output information. - $thisfn=~/\.(\w+)$/; - my $thistype=$1; - my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - - $r->print('

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

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

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

'); + } + + if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { + $r->print(< + +ENDDIFF + $r->print(&mt('Diffs with Current Version').'
'); + } # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. - 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(''); + 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;