--- loncom/publisher/lonpublisher.pm 2003/10/21 19:50:15 1.139 +++ loncom/publisher/lonpublisher.pm 2024/12/27 04:01:41 1.306 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.139 2003/10/21 19:50:15 albertel Exp $ +# $Id: lonpublisher.pm,v 1.306 2024/12/27 04:01:41 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,24 +25,6 @@ # # http://www.lon-capa.org/ # -# -# (TeX Content Handler -# -# 05/29/00,05/30,10/11 Gerd Kortemeyer) -# -# 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 -# 05/03,05/05,05/07 Gerd Kortemeyer -# 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/25 Gerd Kortemeyer -# YEAR=2002 -# 1/17 Gerd Kortemeyer -# ### ############################################################################### @@ -84,10 +66,10 @@ invocation by F<loncapa_apache.conf>: =head1 OVERVIEW -Authors can only write-access the C</~authorname/> 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. +Authors can only write-access the C</priv/domain/authorname/> 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 @@ -120,8 +102,6 @@ to publication space. Many of the undocumented subroutines implement various magical parsing shortcuts. -=over 4 - =cut ###################################################################### @@ -136,25 +116,35 @@ use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); use HTML::LCParser; +use HTML::Entities; +use Encode::Encoder; use Apache::lonxml; -use Apache::loncacc; use DBI; -use Apache::lonnet(); +use Apache::lonnet; use Apache::loncommon(); +use Apache::lonhtmlcommon; use Apache::lonmysql; use Apache::lonlocal; -use vars qw(%metadatafields %metadatakeys); - -my %addid; -my %nokey; - +use Apache::loncfile; +use LONCAPA::lonmetadata; +use Apache::lonmsg; +use vars qw(%metadatafields %metadatakeys %addid $readit); +use LONCAPA qw(:DEFAULT :match); + my $docroot; my $cuname; my $cudom; +my $registered_cleanup; +my $modified_urls; + +my $lock; + =pod +=over 4 + =item B<metaeval> Evaluates a string that contains metadata. This subroutine @@ -180,8 +170,12 @@ nothing ######################################### ######################################### +# +# Modifies global %metadatafields %metadatakeys +# + sub metaeval { - my $metastring=shift; + my ($metastring,$prefix)=@_; my $parser=HTML::LCParser->new(\$metastring); my $token; @@ -189,34 +183,38 @@ sub metaeval { if ($token->[0] eq 'S') { my $entry=$token->[1]; my $unikey=$entry; + next if ($entry =~ m/^(?:parameter|stores)_/); if (defined($token->[2]->{'package'})) { - $unikey.='_package_'.$token->[2]->{'package'}; + $unikey.="\0package\0".$token->[2]->{'package'}; } if (defined($token->[2]->{'part'})) { - $unikey.='_'.$token->[2]->{'part'}; + $unikey.="\0".$token->[2]->{'part'}; } if (defined($token->[2]->{'id'})) { - $unikey.='_'.$token->[2]->{'id'}; + $unikey.="\0".$token->[2]->{'id'}; } if (defined($token->[2]->{'name'})) { - $unikey.='_'.$token->[2]->{'name'}; + $unikey.="\0".$token->[2]->{'name'}; } - foreach (@{$token->[3]}) { - $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; + foreach my $item (@{$token->[3]}) { + $metadatafields{$unikey.'.'.$item}=$token->[2]->{$item}; if ($metadatakeys{$unikey}) { - $metadatakeys{$unikey}.=','.$_; + $metadatakeys{$unikey}.=','.$item; } else { - $metadatakeys{$unikey}=$_; + $metadatakeys{$unikey}=$item; } } - if ($metadatafields{$unikey}) { - my $newentry=$parser->get_text('/'.$entry); - unless (($metadatafields{$unikey}=~/\Q$newentry\E/) || - ($newentry eq '')) { - $metadatafields{$unikey}.=', '.$newentry; - } + my $newentry=$parser->get_text('/'.$entry); + if (($entry eq 'customdistributionfile') || + ($entry eq 'sourcerights')) { + $newentry=~s/^\s*//; + if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; } + } +# actually store + if ( $entry eq 'rule' && exists($metadatafields{$unikey})) { + $metadatafields{$unikey}.=','.$newentry; } else { - $metadatafields{$unikey}=$parser->get_text('/'.$entry); + $metadatafields{$unikey}=$newentry; } } } @@ -260,19 +258,23 @@ 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 '<br /><b>No file:</b> <tt>'.$fn.'</tt>'; + return '<p class="LC_warning">' + .&mt('No file: [_1]',&Apache::loncfile::display($fn)) + .'</p>'; } 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 '<br /><b>Processed file:</b> <tt>'.$fn.'</tt>'; + &metaeval($metastring,$prefix); + return '<p class="LC_info">' + .&mt('Processed file: [_1]',&Apache::loncfile::display($fn)) + .'</p>'; } ######################################### @@ -281,15 +283,14 @@ sub metaread { 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; + my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/}); + my $regexp=quotemeta($url); $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$/) { + foreach my $item (keys(%evaldata)) { + if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { $courses{$1}=1; } } @@ -313,8 +314,12 @@ string which presents the form field (fo =item B<textfield> +=item B<text_with_browse_field> + =item B<hiddenfield> +=item B<checkbox> + =item B<selectbox> =back @@ -324,34 +329,138 @@ string which presents the form field (fo ######################################### ######################################### sub textfield { - my ($title,$name,$value)=@_; + my ($title,$name,$value,$noline,$readonly)=@_; + $value=~s/^\s+//gs; + $value=~s/\s+$//gs; + $value=~s/\s+/ /gs; $title=&mt($title); - my $uctitle=uc($title); - return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:". - "</b></font></p><br />". - '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />'; + $env{'form.'.$name}=$value; + return "\n".&Apache::lonhtmlcommon::row_title($title) + .'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />' + .&Apache::lonhtmlcommon::row_closure($noline); +} + +sub text_with_browse_field { + my ($title,$name,$value,$restriction,$noline,$readonly)=@_; + $value=~s/^\s+//gs; + $value=~s/\s+$//gs; + $value=~s/\s+/ /gs; + $title=&mt($title); + $env{'form.'.$name}=$value; + my $disabled; + if ($readonly) { + $disabled = ' disabled="disabled"'; + } + my $output = + "\n".&Apache::lonhtmlcommon::row_title($title) + .'<input type="text" name="'.$name.'" size="80" value="'.$value.'"'.$disabled.' />'; + unless ($readonly) { + $output .= + '<br />' + .'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">' + .&mt('Select') + .'</a> ' + .'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">' + .&mt('Search') + .'</a>'; + } + $output .= &Apache::lonhtmlcommon::row_closure($noline); + return $output; } sub hiddenfield { my ($name,$value)=@_; + $env{'form.'.$name}=$value; return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />'; } +sub checkbox { + my ($name,$text)=@_; + return "\n<label><input type='checkbox' name='$name' /> ". + &mt($text)."</label>"; +} + sub selectbox { - my ($title,$name,$value,$functionref,@idlist)=@_; + my ($title,$name,$value,$readonly,$functionref,@idlist)=@_; $title=&mt($title); - my $uctitle=uc($title); $value=(split(/\s*,\s*/,$value))[-1]; - my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:". - '</b></font></p><br /><select name="'.$name.'">'; - foreach (@idlist) { - $selout.='<option value=\''.$_.'\''; - if ($_ eq $value) { - $selout.=' selected>'.&{$functionref}($_).'</option>'; - } - else {$selout.='>'.&{$functionref}($_).'</option>';} + if (defined($value)) { + $env{'form.'.$name}=$value; + } else { + $env{'form.'.$name}=$idlist[0]; } - return $selout.'</select>'; + my $selout="\n".&Apache::lonhtmlcommon::row_title($title) + .'<select name="'.$name.'">'; + foreach my $id (@idlist) { + $selout.='<option value="'.$id.'"'; + if ($id eq $value) { + $selout.=' selected="selected"'; + } + if ($readonly) { + $selout .= ' disabled="disabled"'; + } + $selout.='>'.&{$functionref}($id).'</option>'; + } + $selout.='</select>'.&Apache::lonhtmlcommon::row_closure(); + return $selout; +} + +sub select_level_form { + my ($value,$name)=@_; + $env{'form.'.$name}=$value; + if (!defined($value)) { $env{'form.'.$name}=0; } + return &Apache::loncommon::select_level_form($value,$name); +} + +sub common_access { + my ($name,$text,$options)=@_; + return unless (ref($options) eq 'ARRAY'); + my $formname = 'pubdirpref'; + my $chkname = 'common'.$name; + my $chkid = 'LC_'.$chkname; + my $divid = $chkid.'div'; + my $customdivid = 'LC_customfile'; + my $selname = $chkname.'select'; + my $selid = $chkid.'select'; + my $selonchange; + if ($name eq 'dist') { + $selonchange = ' onchange="showHideCustom(this,'."'$customdivid'".');"'; + } + my %lt = &Apache::lonlocal::texthash( + 'default' => 'System wide - can be used for any courses system wide', + 'domain' => 'Domain only - use limited to courses in the domain', + 'custom' => 'Customized right of use ...', + 'public' => 'Public - no authentication or authorization required for use', + 'closed' => 'Closed - XML source is closed to everyone', + 'open' => 'Open - XML source is open to people who want to use it', + 'sel' => 'Select', + ); + my $output = <<"END"; +<span class="LC_nobreak"> +<label> +<input type="checkbox" name="commonaccess" value="$name" id="$chkid" +onclick="showHideAccess(this,'$divid');" /> +$text</label></span> +<div id="$divid" style="padding:0;clear:both;margin:0;border:0;display:none"> +<select name="$selname" id="$selid" $selonchange> +<option value="" selected="selected">$lt{'sel'}</option> +END + foreach my $val (@{$options}) { + $output .= '<option value="'.$val.'">'.$lt{$val}.'</option>'."\n"; + } + $output .= ' +</select>'; + if ($name eq 'dist') { + $output .= <<"END"; +<div id="$customdivid" style="padding:0;clear:both;margin:0;border:0;display:none"> +<input type="text" name="commoncustomrights" size="60" value="" /> +<a href="javascript:openbrowser('$formname','commoncustomrights','rights');"> +$lt{'sel'}</a></div> +END + } + $output .= ' +</div> +'; } ######################################### @@ -375,15 +484,14 @@ sub urlfixup { if ($url =~ /^mailto:/i) { return $url; } #internal document links need no fixing if ($url =~ /^\#/) { return $url; } - my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); - foreach (values %Apache::lonnet::hostname) { - if ($_ eq $host) { - $url=~s/^http\:\/\///; - $url=~s/^$host//; - } + my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)}); + my @lonids = &Apache::lonnet::machine_ids($host); + if (@lonids) { + $url=~s{^(?:http|https|ftp)://}{}; + $url=~s/^\Q$host\E//; } - if ($url=~/^http\:\/\//) { return $url; } - $url=~s/\~$cuname/res\/$cudom\/$cuname/; + if ($url=~m{^(?:http|https|ftp)://}) { return $url; } + $url=~s{\Q~$cuname\E}{res/$cudom/$cuname}; return $url; } @@ -424,7 +532,7 @@ Currently undocumented ######################################### ######################################### sub set_allow { - my ($allow,$logfile,$target,$tag,$oldurl)=@_; + my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_; my $newurl=&urlfixup($oldurl,$target); my $return_url=$oldurl; print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; @@ -434,11 +542,16 @@ sub set_allow { } if (($newurl !~ /^javascript:/i) && ($newurl !~ /^mailto:/i) && - ($newurl !~ /^http:/i) && + ($newurl !~ /^(?:http|https|ftp):/i) && ($newurl !~ /^\#/)) { + if (($type eq 'src') || ($type eq 'href')) { + if ($newurl =~ /^([^?]+)\?[^?]*$/) { + $newurl = $1; + } + } $$allow{&absoluteurl($newurl,$target)}=1; } - return $return_url + return $return_url; } ######################################### @@ -461,10 +574,15 @@ sub get_subscribed_hosts { $target=~/(.*)\/([^\/]+)$/; my $srcf=$2; opendir(DIR,$1); + # cycle through listed files, subscriptions used to exist + # as "filename.lonid" while ($filename=readdir(DIR)) { - if ($filename=~/\Q$srcf\E\.(\w+)$/) { + if ($filename=~/\Q$srcf\E\.($match_lonid)$/) { my $subhost=$1; - if (($subhost ne 'meta' && $subhost ne 'subscription') && + if (($subhost ne 'meta' + && $subhost ne 'subscription' + && $subhost ne 'meta.subscription' + && $subhost ne 'tmp') && ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) { push(@subscribed,$subhost); } @@ -473,19 +591,13 @@ sub get_subscribed_hosts { closedir(DIR); my $sh; if ( $sh=Apache::File->new("$target.subscription") ) { - &Apache::lonnet::logthis("opened $target.subscription"); while (my $subline=<$sh>) { - &Apache::lonnet::logthis("Trying $subline"); - if ($subline =~ /(^\w+):/) { + if ($subline =~ /^($match_lonid):/) { if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { push(@subscribed,$1); } - } else { - &Apache::lonnet::logthis("No Match for $subline"); } } - } else { - &Apache::lonnet::logthis("Unable to open $target.subscription"); } return @subscribed; } @@ -515,13 +627,15 @@ sub get_max_ids_indices { my %duplicatedids; my $parser=HTML::LCParser->new($content); + $parser->xml_mode(1); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { my $counter; if ($counter=$addid{$token->[1]}) { if ($counter eq 'id') { - if (defined($token->[2]->{'id'})) { + if (defined($token->[2]->{'id'}) && + $token->[2]->{'id'} !~ /^\s*$/) { $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; if (exists($allids{$token->[2]->{'id'}})) { $duplicateids=1; @@ -533,7 +647,8 @@ sub get_max_ids_indices { $needsfixup=1; } } else { - if (defined($token->[2]->{'index'})) { + if (defined($token->[2]->{'index'}) && + $token->[2]->{'index'} !~ /^\s*$/) { $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex; } else { $needsfixup=1; @@ -575,11 +690,11 @@ sub get_all_text_unbalanced { } elsif ($token->[0] eq 'E') { $result.=$token->[2]; } - if ($result =~ /(.*)\Q$tag\E(.*)/s) { + if ($result =~ /\Q$tag\E/s) { + ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is; #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2); #&Apache::lonnet::logthis('Result is :'.$1); - $result=$1; - my $redo=$tag.$2; + $redo=$tag.$redo; push (@$pars,HTML::LCParser->new(\$redo)); $$pars[-1]->xml_mode('1'); last; @@ -619,7 +734,7 @@ sub fix_ids_and_indices { join(', ',@duplicatedids)); if ($duplicateids) { print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n"; - my $outstring='<font color="red">Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are: '.join(', ',@duplicatedids).'</font>'; + my $outstring='<span class="LC_error">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</span>'; return ($outstring,1); } if ($needsfixup) { @@ -628,6 +743,7 @@ sub fix_ids_and_indices { "Max Index: $maxindex (min 10)\n"; } my $outstring=''; + my $responsecounter=1; my @parser; $parser[0]=HTML::LCParser->new(\$content); $parser[-1]->xml_mode(1); @@ -642,30 +758,44 @@ sub fix_ids_and_indices { $allow{$token->[2]->{'src'}}=1; next; } + if ($lctag eq 'base') { next; } + if (($lctag eq 'part') || ($lctag eq 'problem')) { + $responsecounter=0; + } + if ($lctag=~/response$/) { $responsecounter++; } + if ($lctag eq 'import') { $responsecounter++; } my %parms=%{$token->[2]}; $counter=$addid{$tag}; if (!$counter) { $counter=$addid{$lctag}; } if ($counter) { if ($counter eq 'id') { - unless (defined($parms{'id'})) { + unless (defined($parms{'id'}) && + $parms{'id'}!~/^\s*$/) { $maxid++; $parms{'id'}=$maxid; - print $logfile 'ID: '.$tag.':'.$maxid."\n"; + print $logfile 'ID(new) : '.$tag.':'.$maxid."\n"; + } else { + print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n"; } } elsif ($counter eq 'index') { - unless (defined($parms{'index'})) { + unless (defined($parms{'index'}) && + $parms{'index'}!~/^\s*$/) { $maxindex++; $parms{'index'}=$maxindex; print $logfile 'Index: '.$tag.':'.$maxindex."\n"; } } } - foreach my $type ('src','href','background','bgimg') { - foreach my $key (keys(%parms)) { - if ($key =~ /^$type$/i) { - $parms{$key}=&set_allow(\%allow,$logfile, - $target,$tag, - $parms{$key}); + unless ($parms{'type'} eq 'zombie') { + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + next if (($lctag eq 'img') && ($type eq 'src') && + ($parms{$key} =~ m{^data\:image/gif;base64,})); + $parms{$key}=&set_allow(\%allow,$logfile, + $target,$tag, + $parms{$key},$type); + } } } } @@ -676,6 +806,7 @@ sub fix_ids_and_indices { ($lctag eq 'image')) { my $next_token=$parser[-1]->get_token(); if ($next_token->[0] eq 'T') { + $next_token->[1] =~ s/[\n\r\f]+//g; $next_token->[1]=&set_allow(\%allow,$logfile, $target,$tag, $next_token->[1]); @@ -684,8 +815,15 @@ sub fix_ids_and_indices { } if ($lctag eq 'applet') { my $codebase=''; - if (defined($parms{'codebase'})) { - my $oldcodebase=$parms{'codebase'}; + my $havecodebase=0; + foreach my $key (keys(%parms)) { + if (lc($key) eq 'codebase') { + $codebase=$parms{$key}; + $havecodebase=1; + } + } + if ($havecodebase) { + my $oldcodebase=$codebase; unless ($oldcodebase=~/\/$/) { $oldcodebase.='/'; } @@ -699,14 +837,13 @@ sub fix_ids_and_indices { } $allow{&absoluteurl($codebase,$target).'/*'}=1; } else { - foreach ('archive','code','object') { - if (defined($parms{$_})) { - my $oldurl=$parms{$_}; + foreach my $key (keys(%parms)) { + if ($key =~ /(archive|code|object)/i) { + my $oldurl=$parms{$key}; my $newurl=&urlfixup($oldurl,$target); $newurl=~s/\/[^\/]+$/\/\*/; - print $logfile 'Allow: applet '.$_.':'. - $oldurl.' allows '. - $newurl."\n"; + print $logfile 'Allow: applet '.lc($key).':'. + $oldurl.' allows '.$newurl."\n"; $allow{&absoluteurl($newurl,$target)}=1; } } @@ -714,26 +851,116 @@ sub fix_ids_and_indices { } my $newparmstring=''; my $endtag=''; - foreach (keys %parms) { - if ($_ eq '/') { + foreach my $parkey (keys(%parms)) { + if ($parkey eq '/') { $endtag=' /'; } else { - my $quote=($parms{$_}=~/\"/?"'":'"'); - $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote; + my $quote=($parms{$parkey}=~/\"/?"'":'"'); + $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote; } } if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; } $outstring.='<'.$tag.$newparmstring.$endtag.'>'; - if ($lctag eq 'm' || $lctag eq 'script' - || $lctag eq 'display' || $lctag eq 'tex') { + if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' || + $lctag eq 'tex') { $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); - } + } elsif ($lctag eq 'script') { + if ($parms{'type'} eq 'loncapa/perl') { + $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); + } else { + my $script = &get_all_text_unbalanced('/'.$lctag,\@parser); + if ($script =~ m{\.set\w+(Src|Swf)\(["']}i) { + my @srcs = split(/\.set/i,$script); + if (scalar(@srcs) > 1) { + foreach my $item (@srcs) { + if ($item =~ m{^(FlashPlayerSwf|MediaSrc|XMPSrc|ConfigurationSrc|PosterImageSrc)\((['"])(?:(?!\2).)+\2\)}is) { + my $srctype = $1; + my $quote = $2; + my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E}); + $url = &urlfixup($url); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + if ($srctype eq 'ConfigurationSrc') { + if ($url =~ m{^(.+/)configuration_express\.xml$}) { +# +# Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive. +# Not referenced directly in <main>.html or <main>_player.html files, +# so add this file to %allow (where <main> is name user gave to file/archive). +# + my $spritesheet = $1.'express_show/spritesheet.png'; + $allow{&absoluteurl($spritesheet,$target)}=1; + +# +# Camtasia 8.4: skins/express_show/spritesheet.min.css needed, and included in zip archive. +# Not referenced directly in <main>.html or <main>_player.html files, +# so add this file to %allow (where <main> is name user gave to file/archive). +# + my $spritecss = $1.'express_show/spritesheet.min.css'; + $allow{&absoluteurl($spritecss,$target)}=1; + } + } elsif ($srctype eq 'PosterImageSrc') { + if ($url =~ m{^(.+)_First_Frame\.png$}) { + my $prefix = $1; +# +# Camtasia 8.1: <main>_Thumbnails.png needed, and included in zip archive. +# Not referenced directly in <main>.html or <main>_player.html files, +# so add this file to %allow (where <main> is name user gave to file/archive). +# + my $thumbnail = $prefix.'_Thumbnails.png'; + $allow{&absoluteurl($thumbnail,$target)}=1; + } + } + } + } + } + } + } + if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) { + my $src = $2; + if ($src) { + my $url = &urlfixup($src); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + } + } + } + if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) { + my $scriptslist = $2; + my @srcs = split(/\s*,\s*/,$scriptslist); + foreach my $src (@srcs) { + if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) { + my $quote = $1; + my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/); + $url = &urlfixup($url); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + } + } + } + } + if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) { + my $src = $2; + if ($src) { + my $url = &urlfixup($src); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + } + } + } + $outstring .= $script; + } + } } elsif ($token->[0] eq 'E') { if ($token->[2]) { unless ($token->[1] eq 'allow') { $outstring.='</'.$token->[1].'>'; } - } + } + if ((($token->[1] eq 'part') || ($token->[1] eq 'problem')) + && (!$responsecounter)) { + my $outstring='<span class="LC_error">'.&mt('Found [_1] without responses. This resource cannot be published.',$token->[1]).'</span>'; + return ($outstring,1); + } } else { $outstring.=$token->[1]; } @@ -771,41 +998,97 @@ Returns: (error,status). error is undef ######################################### ######################################### sub store_metadata { - my %metadata = %{shift()}; + my %metadata = @_; my $error; # Determine if the table exists my $status = &Apache::lonmysql::check_table('metadata'); if (! defined($status)) { - $error='<font color="red">WARNING: Cannot connect to '. - 'database!</font>'; + $error='<span class="LC_error">' + .&mt('WARNING: Cannot connect to database!') + .'</span>'; &Apache::lonnet::logthis($error); return ($error,undef); } if ($status == 0) { # It would be nice to actually create the table.... - $error ='<font color="red">WARNING: The metadata table does not '. - 'exist in the LON-CAPA database.</font>'; + $error ='<span class="LC_error">' + .&mt('WARNING: The metadata table does not exist in the LON-CAPA database!') + .'</span>'; &Apache::lonnet::logthis($error); return ($error,undef); } - # Remove old value from table - $status = &Apache::lonmysql::remove_from_table - ('metadata','url',$metadata{'url'}); - if (! defined($status)) { - $error = '<font color="red">Error when removing old values from '. - 'metadata table in LON-CAPA database.</font>'; - &Apache::lonnet::logthis($error); - return ($error,undef); + my $dbh = &Apache::lonmysql::get_dbh(); + if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv')) { + # remove this entry + my $delitem = 'url = '.$dbh->quote($metadata{'url'}); + $status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem); + + } else { + $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef, + \%metadata); } - # Store data in table. - $status = &Apache::lonmysql::store_row('metadata',\%metadata); - if (! defined($status)) { - $error='<font color="red">Error occured storing new values in '. - 'metadata table in LON-CAPA database</font>'; + if (defined($status) && $status ne '') { + $error='<span class="LC_error">' + .&mt('Error occurred saving new values in metadata table in LON-CAPA database!') + .'</span>'; &Apache::lonnet::logthis($error); + &Apache::lonnet::logthis($status); return ($error,undef); } - return (undef,$status); + return (undef,'success'); +} + + +# ========================================== Parse file for errors and warnings + +sub checkonthis { + my ($r,$source)=@_; + my $uri=&Apache::lonnet::hreflocation($source); + $uri=~s/\/$//; + my $result=&Apache::lonnet::ssi_body($uri, + ('grade_target'=>'web', + 'return_only_error_and_warning_counts' => 1)); + my ($errorcount,$warningcount)=split(':',$result); + if (($errorcount) || ($warningcount)) { + $r->print('<h3>'.&mt('Warnings and Errors').'</h3>'); + $r->print('<tt>'.$uri.'</tt>:'); + $r->print('<ul>'); + if ($warningcount) { + $r->print('<li><div class="LC_warning">' + .&mt('[quant,_1,warning]',$warningcount) + .'</div></li>'); + } + if ($errorcount) { + $r->print('<li><div class="LC_error">' + .&mt('[quant,_1,error]',$errorcount) + .' <img src="/adm/lonMisc/bomb.gif" />' + .'</div></li>'); + } + $r->print('</ul>'); + } else { + #$r->print('<font color="green">'.&mt('ok').'</font>'); + } + $r->rflush(); + return ($warningcount,$errorcount); +} + +# ============================================== 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; } ######################################### @@ -820,7 +1103,7 @@ backup copies, performs any automatic pr especially for rat and ssi files), Returns a 2 element array, the first is the string to be shown to the -user, the second is an error code, either 1 (an error occured) or 0 +user, the second is an error code, either 1 (an error occurred) or 0 (no error occurred) I<Additional documentation needed.> @@ -831,7 +1114,7 @@ I<Additional documentation needed.> ######################################### sub publish { - my ($source,$target,$style,$batch)=@_; + my ($source,$target,$style,$batch,$nokeyref)=@_; my $logfile; my $scrout=''; my $allmeta=''; @@ -839,10 +1122,10 @@ sub publish { my %allow=(); unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return ('<font color="red">No write permission to user directory, FAIL</font>',1); + return ('<span class="LC_error">'.&mt('No write permission to user directory, FAIL').'</span>',1); } print $logfile -"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n"; +"\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n"; if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) { # ------------------------------------------------------- This needs processing @@ -853,7 +1136,7 @@ sub publish { print $logfile "Copied original file to ".$copyfile."\n"; } else { print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; - return ("<font color=\"red\">Failed to write backup copy, $!,FAIL</font>",1); + return ("<span class=\"LC_error\">".&mt("Failed to write backup copy, [_1], FAIL",$1)."</span>",1); } # ------------------------------------------------------------- IDs and indices @@ -863,108 +1146,138 @@ sub publish { if ($error) { return ($outstring,$error); } # ------------------------------------------------------------ Construct Allows - $scrout.='<h3>Dependencies</h3>'; + my $outdep=''; # Collect dependencies output data my $allowstr=''; - foreach (sort(keys(%allow))) { - my $thisdep=$_; + foreach my $thisdep (sort(keys(%allow))) { if ($thisdep !~ /[^\s]/) { next; } + if ($thisdep =~/\$/) { + $outdep.='<div class="LC_warning">' + .&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />' + .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt><allow></tt>') + ."</div>\n"; + } unless ($style eq 'rat') { $allowstr.="\n".'<allow src="'.$thisdep.'" />'; } - $scrout.='<br />'; - unless ($thisdep=~/\*/) { - $scrout.='<a href="'.$thisdep.'">'; + $outdep.='<div>'; + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { + $outdep.='<a href="'.$thisdep.'">'; } - $scrout.='<tt>'.$thisdep.'</tt>'; - unless ($thisdep=~/\*/) { - $scrout.='</a>'; + $outdep.='<tt>'.$thisdep.'</tt>'; + if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) { + $outdep.='</a>'; if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= ' - <font color="red">Currently not available'. - '</font>'; + $outdep.= ' - <span class="LC_error">'.&mt('Currently not available'). + '</span>'; } else { +# +# Store the fact that the dependency has been used by the target file +# Unfortunately, usage is erroneously named sequsage in lonmeta.pm +# The translation happens in lonmetadata.pm +# my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' => time); - $thisdep=~/^\/res\/(\w+)\/(\w+)\//; + $thisdep=~m{^/res/($match_domain)/($match_username)/}; if ((defined($1)) && (defined($2))) { &Apache::lonnet::put('nohist_resevaldata',\%temphash, $1,$2); } } } + $outdep.='</div><br />'; + } + + if ($outdep) { + $scrout.='<h3>'.&mt('Dependencies').'</h3>' + .$outdep } - $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s; + $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$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. { my $org; unless ($org=Apache::File->new('>'.$source)) { print $logfile "No write permit to $source\n"; - return ('<font color="red">'.&mt('No write permission to'). + return ('<span class="LC_error">'.&mt('No write permission to'). ' '.$source. - ', '.&mt('FAIL').'</font>',1); + ', '.&mt('FAIL').'</span>',1); } print($org $outstring); } $content=$outstring; } + +# ----------------------------------------------------- Course Authoring Space. + my ($courseauthor,$crsaurights,$readonly); + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + if ($source =~ m{^\Q$docroot/priv/$cdom/$cnum/\E}) { + $courseauthor = $cnum.':'.$cdom; + $crsaurights = "/res/$cdom/$cnum/default.rights"; + $readonly = 1; + } + } + # -------------------------------------------- Initial step done, now metadata. # --------------------------------------- Storage for metadata keys and fields. - +# these are globals +# %metadatafields=(); %metadatakeys=(); my %oldparmstores=(); unless ($batch) { - $scrout.='<h3>'.&mt('Metadata Information').' ' . - Apache::loncommon::help_open_topic("Metadata_Description") + $scrout.='<h3>'.&mt('Metadata').' ' . + &Apache::loncommon::help_open_topic("Metadata_Description") . '</h3>'; } # ------------------------------------------------ First, check out environment - unless (-e $source.'.meta') { - $metadatafields{'author'}=$ENV{'environment.firstname'}.' '. - $ENV{'environment.middlename'}.' '. - $ENV{'environment.lastname'}.' '. - $ENV{'environment.generation'}; + if ((!(-e $source.'.meta')) || ($env{'form.forceoverride'})) { + $metadatafields{'author'}=$env{'environment.firstname'}.' '. + $env{'environment.middlename'}.' '. + $env{'environment.lastname'}.' '. + $env{'environment.generation'}; $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; + $metadatafields{'owner'}=$cuname.':'.$cudom; # ------------------------------------------------ Check out directory hierachy my $thisdisfn=$source; - $thisdisfn=~s/^\/home\/\Q$cuname\E\///; - my @urlparts=split(/\//,$thisdisfn); + $thisdisfn=~s/^\Q$docroot\E\/priv\/\Q$cudom\E\/\Q$cuname\E\///; + my @urlparts=('.',split(/\//,$thisdisfn)); $#urlparts--; - my $currentpath='/home/'.$cuname.'/'; + my $currentpath=$docroot.'/priv/'.$cudom.'/'.$cuname.'/'; - foreach (@urlparts) { - $currentpath.=$_.'/'; - $scrout.=&metaread($logfile,$currentpath.'default.meta'); + my $prefix='../'x($#urlparts); + foreach my $subdir (@urlparts) { + $currentpath.=$subdir.'/'; + $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); + $prefix=~s|^\.\./||; } +# ----------------------------------------------------------- Parse file itself +# read %metadatafields from file itself + + $allmeta=&parseformeta($source,$style); + # ------------------- Clear out parameters and stores (there should not be any) - foreach (keys %metadatafields) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - delete $metadatafields{$_}; + foreach my $field (keys(%metadatafields)) { + if (($field=~/^parameter/) || ($field=~/^stores/)) { + delete $metadatafields{$field}; } } @@ -973,57 +1286,68 @@ sub publish { $scrout.=&metaread($logfile,$source.'.meta'); - foreach (keys %metadatafields) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - $oldparmstores{$_}=1; - delete $metadatafields{$_}; + foreach my $field (keys(%metadatafields)) { + if (($field=~/^parameter/) || ($field=~/^stores/)) { + $oldparmstores{$field}=1; + delete $metadatafields{$field}; } } - - } - -# -------------------------------------------------- Parse content for metadata - 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')); +# ------------------------------------------------------------- Save some stuff + my %savemeta=(); + if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; } +# ------------------------------------------ See if anything new in file itself + + $allmeta=&parseformeta($source,$style); +# ----------------------------------------------------------- Restore the stuff + foreach my $item (keys(%savemeta)) { + $metadatafields{$item}=$savemeta{$item}; + } + } - &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.=$_.' '; + foreach my $field (sort(keys(%metadatafields))) { + if (($field=~/^parameter/) || ($field=~/^stores/)) { + unless ($field=~/\.\w+$/) { + unless ($oldparmstores{$field}) { + my $disp_key = $field; + $disp_key =~ tr/\0/_/; + print $logfile ('New: '.$disp_key."\n"); + $chparms .= $disp_key.' '; } } } } if ($chparms) { - $scrout.='<p><b>'.&mt('New parameters or stored values'). + $scrout.='<p><b>'.&mt('New parameters or saved values'). ':</b> '.$chparms.'</p>'; } $chparms=''; - foreach (sort keys %oldparmstores) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_.'.name'}) || - ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { - print $logfile 'Obsolete: '.$_."\n"; - $chparms.=$_.' '; + foreach my $olditem (sort(keys(%oldparmstores))) { + if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) { + unless (($metadatafields{$olditem.'.name'}) || + ($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) { + my $disp_key = $olditem; + $disp_key =~ tr/\0/_/; + print $logfile ('Obsolete: '.$disp_key."\n"); + $chparms.=$disp_key.' '; } } } if ($chparms) { - $scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '. - $chparms.'</p>'; + $scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> ' + .$chparms.'</p>' + .'<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />' + .&mt('If this resource is in active use, student performance data from the previous version may become inaccessible.') + .'</p><hr />'; + } + if ($metadatafields{'copyright'} eq 'priv') { + $scrout.='<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />' + .&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.') + .'</p><hr />'; } # ------------------------------------------------------- Now have all metadata @@ -1035,41 +1359,64 @@ sub publish { $textonly=~s/\<script[^\<]+\<\/script\>//g; $textonly=~s/\<m\>[^\<]+\<\/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; - } - } - } + #this is a work simplification for german authors for present + $textonly=HTML::Entities::decode($textonly); #decode HTML-character + $textonly=Encode::Encoder::encode('utf8', $textonly); #encode to perl internal unicode + $textonly=~tr/A-ZÜÄÖ/a-züäö/; #add lowercase rule for german "Umlaute" + $textonly=~s/[\$\&][a-z]\w*//g; + $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute" + + foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces + unless ($nokeyref->{$_}) { + $keywords{$_}=1; + } + } + + + } - foreach (split(/\W+/,$metadatafields{'keywords'})) { - $keywords{$_}=1; + foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) { + $addkey=~s/\s+/ /g; + $addkey=~s/^\s//; + $addkey=~s/\s$//; + if ($addkey=~/\w/) { + $keywords{$addkey}=1; + } } # --------------------------------------------------- Now we also have keywords # ============================================================================= -# INTERACTIVE MODE -# - unless ($batch) { - $scrout.= - '<form name="pubform" action="/adm/publish" method="post">'. - '<p><input type="submit" value="Finalize Publication" /></p>'. - &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 +# interactive mode html goes into $intr_scrout +# batch mode throws away this HTML +# additionally all of the field functions have a by product of setting +# $env{'from.'..} so that it can be used by the phase two handler in +# batch mode + + my $intr_scrout.='<br />' + .'<form name="pubform" action="/adm/publish" method="post">'; + unless ($env{'form.makeobsolete'}) { + $intr_scrout.='<p class="LC_warning">' + .&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.') + .'</p>' + .'<p><input type="submit" value="' + .&mt('Finalize Publication') + .'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>'; + } + $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box(); + $intr_scrout.= + &hiddenfield('phase','two'). + &hiddenfield('filename',$env{'form.filename'}). + &hiddenfield('allmeta',&escape($allmeta)). + &hiddenfield('dependencies',join(',',keys(%allow))); + unless ($env{'form.makeobsolete'}) { + $intr_scrout.= + &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"; + my $keywords_help = &Apache::loncommon::help_open_topic("Publishing_Keywords"); + my $keywordout=<<"END"; <script> function checkAll(field) { for (i = 0; i < field.length; i++) @@ -1081,145 +1428,214 @@ function uncheckAll(field) { field[i].checked = false ; } </script> -<p><font color="#800000" face="helvetica"><b>KEYWORDS:</b></font> - $keywords_help</b> -<input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)" /> -<input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)" /> -</p> -<br /> END - $keywordout.='<table border="2"><tr>'; - my $colcount=0; + $keywordout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Keywords')) + .$keywords_help + .'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />' + .'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />' + .'</p><br />' + .&Apache::loncommon::start_data_table(); + my $cols_per_row = 10; + my $colcount=0; + my $wordcount=0; + my $numkeywords = scalar(keys(%keywords)); + + foreach my $word (sort(keys(%keywords))) { + if ($colcount == 0) { + $keywordout .= &Apache::loncommon::start_data_table_row(); + } + $colcount++; + $wordcount++; + if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) { + my $colspan = 1+$cols_per_row-$colcount; + $keywordout .= '<td colspan="'.$colspan.'">'; + } else { + $keywordout .= '<td>'; + } + $keywordout.='<label><input type="checkbox" name="keywords" value="'.$word.'"'; + if ($metadatafields{'keywords'}) { + if ($metadatafields{'keywords'}=~/\Q$word\E/) { + $keywordout.=' checked="checked"'; + $env{'form.keywords'}.=$word.','; + } + } elsif (&Apache::loncommon::keyword($word)) { + $keywordout.=' checked="checked"'; + $env{'form.keywords'}.=$word.','; + } + $keywordout.=' />'.$word.'</label></td>'; + if ($colcount == $cols_per_row) { + $keywordout.=&Apache::loncommon::end_data_table_row(); + $colcount=0; + } + } + if ($colcount > 0) { + $keywordout .= &Apache::loncommon::end_data_table_row(); + } - foreach (sort keys %keywords) { - $keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"'; - if ($metadatafields{'keywords'}) { - if ($metadatafields{'keywords'}=~/\Q$_\E/) { - $keywordout.=' checked="on"'; - } - } elsif (&Apache::loncommon::keyword($_)) { - $keywordout.=' checked="on"'; - } - $keywordout.=' />'.$_.'</td>'; - if ($colcount>10) { - $keywordout.="</tr><tr>\n"; - $colcount=0; - } - $colcount++; - } + $env{'form.keywords'}=~s/\,$//; - $keywordout.='</tr></table>'; + $keywordout.=&Apache::loncommon::end_data_table_row() + .&Apache::loncommon::end_data_table() + .&Apache::lonhtmlcommon::row_closure(); - $scrout.=$keywordout; + $intr_scrout.=$keywordout; - $scrout.=&textfield('Additional Keywords','addkey',''); + $intr_scrout.=&textfield('Additional Keywords','addkey',''); - $scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); + $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); - $scrout.= - "\n<p><font color=\"#800000\" face=\"helvetica\"><b>ABSTRACT:". - "</b></font></p><br />". - '<textarea cols="80" rows="5" name="abstract">'. - $metadatafields{'abstract'}.'</textarea></p>'; + $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Abstract')) + .'<textarea cols="80" rows="5" name="abstract">' + .$metadatafields{'abstract'} + .'</textarea>' + .&Apache::lonhtmlcommon::row_closure(); - $source=~/\.(\w+)$/; + $source=~/\.(\w+)$/; - $scrout.=&hiddenfield('mime',$1); + $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Grade Levels')) + .&mt('Lowest Grade Level:').' ' + .&select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel') +# .&Apache::lonhtmlcommon::row_closure(); +# $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Highest Grade Level')) + .' '.&mt('Highest Grade Level:').' ' + .&select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel') + .&Apache::lonhtmlcommon::row_closure(); - my $defaultlanguage=$metadatafields{'language'}; - $defaultlanguage =~ s/\s*notset\s*//g; - $defaultlanguage =~ s/^,\s*//g; - $defaultlanguage =~ s/,\s*$//g; + $intr_scrout.=&textfield('Standards','standards',$metadatafields{'standards'}); - $scrout.=&selectbox('Language','language', - $defaultlanguage, - \&Apache::loncommon::languagedescription, - (&Apache::loncommon::languageids), - ); + $intr_scrout.=&hiddenfield('mime',$1); - unless ($metadatafields{'creationdate'}) { - $metadatafields{'creationdate'}=time; - } - $scrout.=&hiddenfield('creationdate', - &Apache::loncommon::unsqltime($metadatafields{'creationdate'})); + my $defaultlanguage=$metadatafields{'language'}; + $defaultlanguage =~ s/\s*notset\s*//g; + $defaultlanguage =~ s/^,\s*//g; + $defaultlanguage =~ s/,\s*$//g; - $scrout.=&hiddenfield('lastrevisiondate',time); + $intr_scrout.=&selectbox('Language','language', + $defaultlanguage,'', + \&Apache::loncommon::languagedescription, + (&Apache::loncommon::languageids), + ); + unless ($metadatafields{'creationdate'}) { + $metadatafields{'creationdate'}=time; + } + $intr_scrout.=&hiddenfield('creationdate', + &Apache::lonmysql::unsqltime($metadatafields{'creationdate'})); - $scrout.=&textfield('Publisher/Owner','owner', - $metadatafields{'owner'}); + $intr_scrout.=&hiddenfield('lastrevisiondate',time); + my $pubowner_last; + if ($style eq 'prv') { + $pubowner_last = 1; + } + if ($courseauthor) { + $metadatafields{'owner'} = $courseauthor; + } + $intr_scrout.=&textfield('Publisher/Owner','owner', + $metadatafields{'owner'},$pubowner_last,$readonly); + +# ---------------------------------------------- Retrofix for unused copyright + if ($metadatafields{'copyright'} eq 'free') { + $metadatafields{'copyright'}='default'; + $metadatafields{'sourceavail'}='open'; + } + if ($metadatafields{'copyright'} eq 'priv') { + $metadatafields{'copyright'}='domain'; + } +# ------------------------------------------------ Dial in reasonable defaults + my $defaultoption=$metadatafields{'copyright'}; + unless ($defaultoption) { $defaultoption='default'; } + if ($courseauthor) { + $defaultoption='custom'; + $metadatafields{'customdistributionfile'}=$crsaurights; + } + my $defaultsourceoption=$metadatafields{'sourceavail'}; + unless ($defaultsourceoption) { $defaultsourceoption='closed'; } + unless ($style eq 'prv') { # -------------------------------------------------- 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<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:". - '</b></font> <input type="checkbox" name="obsolete" '; - if ($metadatafields{'obsolete'}) { - $scrout.=' checked="1" '; - } - $scrout.='/ ></p>'. - &textfield('Suggested Replacement for Obsolete File', - 'obsoletereplacement', - $metadatafields{'obsoletereplacement'}); + if ($style eq 'rat') { +# -------------------------------------- Retrofix for non-applicable copyright + if ($metadatafields{'copyright'} eq 'public') { + delete $metadatafields{'copyright'}; + $defaultoption='default'; + } + $intr_scrout.=&selectbox('Copyright/Distribution','copyright', + $defaultoption,$readonly, + \&Apache::loncommon::copyrightdescription, + (grep !/^(public|priv)$/,(&Apache::loncommon::copyrightids))); } else { - $scrout.=&hiddenfield('copyright','private'); - } - return ($scrout.'<p><input type="submit" value="'. - &mt('Finalize Publication').'" /></p></form>',0); -# ============================================================================= -# BATCH MODE -# + $intr_scrout.=&selectbox('Copyright/Distribution','copyright', + $defaultoption,$readonly, + \&Apache::loncommon::copyrightdescription, + (grep !/^priv$/,(&Apache::loncommon::copyrightids))); + } + my $copyright_help = + &Apache::loncommon::help_open_topic('Publishing_Copyright'); + my $replace=&mt('Copyright/Distribution:'); + $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge; + + $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights','',$readonly); + $intr_scrout.=&selectbox('Source Distribution','sourceavail', + $defaultsourceoption,'', + \&Apache::loncommon::source_copyrightdescription, + (&Apache::loncommon::source_copyrightids)); +# $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights'); + my $uctitle=&mt('Obsolete'); + my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':''; + $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle) + .'<input type="checkbox" name="obsolete"'.$obsolete_checked.' />' + .&Apache::lonhtmlcommon::row_closure(1); + $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File', + 'obsoletereplacement', + $metadatafields{'obsoletereplacement'},'',1); } 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); + $intr_scrout.=&hiddenfield('copyright','private'); } + } else { + $intr_scrout.= + &hiddenfield('title',$metadatafields{'title'}). + &hiddenfield('author',$metadatafields{'author'}). + &hiddenfield('subject',$metadatafields{'subject'}). + &hiddenfield('keywords',$metadatafields{'keywords'}). + &hiddenfield('abstract',$metadatafields{'abstract'}). + &hiddenfield('notes',$metadatafields{'notes'}). + &hiddenfield('mime',$metadatafields{'mime'}). + &hiddenfield('creationdate',$metadatafields{'creationdate'}). + &hiddenfield('lastrevisiondate',time). + &hiddenfield('owner',$metadatafields{'owner'}). + &hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}). + &hiddenfield('standards',$metadatafields{'standards'}). + &hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}). + &hiddenfield('language',$metadatafields{'language'}). + &hiddenfield('copyright',$metadatafields{'copyright'}). + &hiddenfield('sourceavail',$metadatafields{'sourceavail'}). + &hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}). + &hiddenfield('obsolete',1). + &text_with_browse_field('Suggested Replacement for Obsolete File', + 'obsoletereplacement', + $metadatafields{'obsoletereplacement'},'',1); + } + if (!$batch) { + $scrout.=$intr_scrout + .&Apache::lonhtmlcommon::end_pick_box() + .'<p><input type="submit" value="' + .&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication') + .'" /></p>' + .'</form>'; + } + return($scrout,0); +} + +sub getnokey { + my ($includedir) = @_; + my $nokey={}; + my $fh=Apache::File->new($includedir.'/un_keyword.tab'); + while (<$fh>) { + my $word=$_; + chomp($word); + $nokey->{$word}=1; + } + return $nokey; } ######################################### @@ -1244,16 +1660,26 @@ Parameters: =item I<$distarget> +=item I<$batch> + +=item I<$usebuffer> + =back Returns: =over 4 -=item Scalar string +=item integer or array -String contains status (errors and warnings) and information associated with -the server's attempts at publication. +if $userbuffer arg is true, and if caller wants an array +then the array ($output,$rtncode) will be returned, otherwise +just the $rtncode will be returned. $rtncode is an integer: + +0: fail +1: success + +=back =cut @@ -1262,88 +1688,231 @@ the server's attempts at publication. ######################################### sub phasetwo { - my ($r,$source,$target,$style,$distarget,$batch)=@_; + my ($r,$source,$target,$style,$distarget,$batch,$usebuffer)=@_; $source=~s/\/+/\//g; $target=~s/\/+/\//g; - - if ($target=~/\_\_\_/) { - $r->print( - '<font color="red">'.&mt('Unsupported character combination'). - ' "<tt>___</tt>" '.&mt('in filename, FAIL').'</font>'); - return 0; +# +# Unless trying to get rid of something, check name validity +# + my $output; + unless ($env{'form.obsolete'}) { + if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) { + $output = '<span class="LC_error">'. + &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>"). + '</span>'; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } + } + unless ($target=~/\.(\w+)$/) { + $output = '<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>'; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } + } + if ($target=~/\.(\d+)\.(\w+)$/) { + $output = '<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>'; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } + } } + +# +# End name check +# $distarget=~s/\/+/\//g; my $logfile; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - $r->print( - '<font color="red">'. - &mt('No write permission to user directory, FAIL').'</font>'); - return 0; + $output = '<span class="LC_error">'. + &mt('No write permission to user directory, FAIL').'</span>'; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + return 0; + } + } + + if ($source =~ /\.rights$/) { + $output = '<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } + print $logfile - "\n================= Publish ".localtime()." Phase Two ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n"; + "\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'}; + + &metaeval(&unescape($env{'form.allmeta'})); + + if ($batch) { + my %commonaccess; + map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess'); + if ($commonaccess{'dist'}) { + unless ($style eq 'prv') { + if ($env{'form.commondistselect'} eq 'custom') { + unless ($source =~ /\.rights$/) { + if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) { + $env{'form.customdistributionfile'} = $env{'form.commoncustomrights'}; + $env{'form.copyright'} = $env{'form.commondistselect'}; + } + } + } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) { + $env{'form.copyright'} = $env{'form.commondistselect'}; + } + } + } + unless ($style eq 'prv') { + if ($commonaccess{'source'}) { + if (($env{'form.commonsourceselect'} eq 'open') || ($env{'form.commonsourceselect'} eq 'closed')) { + $env{'form.sourceavail'} = $env{'form.commonsourceselect'}; + } + } + } + } + + $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{'standards'}=$env{'form.standards'}; + $metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'}; + $metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'}; $metadatafields{'customdistributionfile'}= - $ENV{'form.customdistributionfile'}; - $metadatafields{'obsolete'}=$ENV{'form.obsolete'}; + $env{'form.customdistributionfile'}; + $metadatafields{'sourceavail'}=$env{'form.sourceavail'}; + $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'}}); + $env{'form.obsoletereplacement'}; + $metadatafields{'dependencies'}=$env{'form.dependencies'}; + $metadatafields{'modifyinguser'}=$env{'user.name'}.':'. + $env{'user.domain'}; + $metadatafields{'authorspace'}=$cuname.':'.$cudom; + $metadatafields{'domain'}=$cudom; + + my $crsauthor; + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + if ($distarget =~ m{^/res/$cdom/$cnum}) { + $crsauthor = 1; + my $default_rights = "/res/$cdom/$cnum/default.rights"; + unless ($distarget eq $default_rights) { + $metadatafields{'copyright'} = 'custom'; + $metadatafields{'customdistributionfile'} = $default_rights; + } + } + } + + 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 .= ','.$env{'form.keywords'}; } } - $allkeywords=~s/\W+/\,/; - $allkeywords=~s/^\,//; + $allkeywords=~s/[\"\']//g; + $allkeywords=~s/\s*[\;\,]\s*/\,/g; + $allkeywords=~s/\s+/ /g; + $allkeywords=~s/^[ \,]//; + $allkeywords=~s/[ \,]$//; $metadatafields{'keywords'}=$allkeywords; +# check if custom distribution file is specified + if ($metadatafields{'copyright'} eq 'custom') { + my $file=$metadatafields{'customdistributionfile'}; + unless ($file=~/\.rights$/) { + $output .= '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL'). + '</span>'; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } + } + } { print $logfile "\nWrite metadata file for ".$source; my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { - return - '<font color="red">'.&mt('Could not write metadata, FAIL'). - '</font>'; - } - foreach (sort keys %metadatafields) { - unless ($_=~/\./) { - my $unikey=$_; + $output .= '<span class="LC_error">'.&mt('Could not write metadata, FAIL'). + '</span>'; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } + } + foreach my $field (sort(keys(%metadatafields))) { + unless ($field=~/\./) { + my $unikey=$field; $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.'.'.$_}; + foreach my $item (split(/\,/,$metadatakeys{$unikey})) { + my $value=$metadatafields{$unikey.'.'.$item}; $value=~s/\"/\'\'/g; - print $mfh ' '.$_.'="'.$value.'"'; + print $mfh ' '.$item.'="'.$value.'"'; } print $mfh '>'. - &HTML::Entities::encode($metadatafields{$unikey}) + &HTML::Entities::encode($metadatafields{$unikey},'<>&"') .'</'.$tag.'>'; } } - $r->print('<p>'.&mt('Wrote Metadata').'</p>'); + + $output .= '<p>'.&mt('Wrote Metadata').'</p>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } print $logfile "\nWrote metadata"; } @@ -1351,21 +1920,29 @@ sub phasetwo { $metadatafields{'url'} = $distarget; $metadatafields{'version'} = 'current'; - unless ($metadatafields{'copyright'} eq 'priv') { - my ($error,$success) = &store_metadata(\%metadatafields); + + unless ($crsauthor) { + my ($error,$success) = &store_metadata(%metadatafields); if ($success) { - $r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>'); - print $logfile "\nSynchronized SQL metadata database"; + $output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>'; + print $logfile "\nSynchronized SQL metadata database"; } else { - $r->print($error); - print $logfile "\n".$error; + $output .= $error; + print $logfile "\n".$error; } - } else { - $r->print('<p>'. - &mt('Private Publication - did not synchronize database').'</p>'); - print $logfile "\nPrivate: Did not synchronize data into ". - "SQL metadata database"; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } + } +# --------------------------------------------- Delete author resource messages + my $delresult=&Apache::lonmsg::del_url_author_res_msg($target); + $output .= '<p>'.&mt('Removing error messages:').' '.$delresult.'</p>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; } + print $logfile "\nRemoving error messages: $delresult"; # ----------------------------------------------------------- Copy old versions if (-e $target) { @@ -1375,9 +1952,21 @@ sub phasetwo { my $srcf=$2; my $srct=$3; my $srcd=$1; - unless ($srcd=~/^\/home\/httpd\/html\/res/) { + my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + unless ($srcd=~/^\Q$docroot\E\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; - return "<font color=\"red\">Invalid target directory, FAIL</font>"; + $output .= + "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>"; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } opendir(DIR,$srcd); while ($filename=readdir(DIR)) { @@ -1385,25 +1974,42 @@ sub phasetwo { unlink($srcd.'/'.$filename); unlink($srcd.'/'.$filename.'.meta'); } else { - if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) { + if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) { $maxversion=($1>$maxversion)?$1:$maxversion; } } } closedir(DIR); $maxversion++; - $r->print('<p>Creating old version '.$maxversion.'</p>'); + $output .= '<p>'.&mt('Creating old version [_1]',$maxversion).'</p>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } 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"; - $r->print('<p>'.&mt('Copied old target file').'</p>'); + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - return "<font color=\"red\">".&mt('Failed to copy old target'). - ", $!, ".&mt('FAIL')."</font>"; + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } # --------------------------------------------------------------- Copy Metadata @@ -1412,19 +2018,34 @@ sub phasetwo { if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $r->print('<p>'.&mt('Copied old metadata').'</p>') + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { - return - "<font color=\"red\">". -&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</font>"; + $output .= &Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write old metadata copy').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } } - - } else { - $r->print('<p>'.&mt('Initial version').'</p>'); + $output .= '<p>'.&mt('Initial version').'</p>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } print $logfile "\nInitial version"; } @@ -1439,103 +2060,189 @@ sub phasetwo { $path.="/$parts[$count]"; if ((-e $path)!=1) { print $logfile "\nCreating directory ".$path; - $r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>'); mkdir($path,0777); + $output .= '<p>' + .&mt('Created directory [_1]' + ,'<span class="LC_filename">'.$parts[$count].'</span>') + .'</p>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } } if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; - $r->print('<p>'.&mt('Copied source file').'</p>'); + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied source file')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - return "<font color=\"red\">". - &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>"; + $output .= &Apache::lonhtmlcommon::confirm_success( + &mt('Failed to copy source').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } +# ---------------------------------------------- Delete local tmp-preview files + unlink($copyfile.'.tmp'); # --------------------------------------------------------------- Copy Metadata $copyfile=$copyfile.'.meta'; if (copy($source.'.meta',$copyfile)) { print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $r->print('<p>'.&mt('Copied metadata').'</p>'); + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; - return - "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>"; + $output .= &Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write metadata copy').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } - $r->rflush; -# --------------------------------------------------- Send update notifications - - my @subscribed=&get_subscribed_hosts($target); - foreach my $subhost (@subscribed) { - $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush; - print $logfile "\nNotifying host ".$subhost.':'; - my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); - $r->print($reply.'</p><br />');$r->rflush; - print $logfile $reply; + unless ($usebuffer) { + $r->rflush; } - -# ---------------------------------------- Send update notifications, meta only - my @subscribedmeta=&get_subscribed_hosts("$target.meta"); - foreach my $subhost (@subscribedmeta) { - $r->print('<p>'. -&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.'</p><br />');$r->rflush; - print $logfile $reply; - } - -# --------------------------------------------------- Notify subscribed courses - my %courses=&coursedependencies($target); - my $now=time; - foreach (keys %courses) { - $r->print('<p>'.&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.'</p><br />');$r->rflush; - print $logfile $reply; +# ------------------------------------------------------------- Trigger updates + push(@{$modified_urls},[$target,$source]); + ¬ify_in_cleanup($r); + +# ---------------------------------------------------------- Clear local caches + my $thisdistarget=$target; + $thisdistarget=~s/^\Q$docroot\E//; + &Apache::lonnet::devalidate_cache_new('resversion',$target); + &Apache::lonnet::devalidate_cache_new('meta', + &Apache::lonnet::declutter($thisdistarget)); + +# ------------------------------------------------------------- Everything done + $logfile->close(); + $output .= '<p class="LC_success">'.&mt('Done').'</p>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; } + # ------------------------------------------------ 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 $thissrc=&Apache::loncfile::url($source); my $thissrcdir=$thissrc; $thissrcdir=~s/\/[^\/]+$/\//; - - $r->print( - '<hr /><a href="'.$thisdistarget.'"><font size="+2">'. - &mt('View Published Version').'</font></a>'. - '<p><a href="'.$thissrc.'"><font size=+2>'. - &mt('Back to Source').'</font></a></p>'. - '<p><a href="'.$thissrcdir. - '"><font size="+2">'. - &mt('Back to Source Directory').'</font></a></p>'); + $output .= + &Apache::lonhtmlcommon::actionbox([ + '<a href="'.$thisdistarget.'">'. + &mt('View Published Version'). + '</a>', + '<a href="'.$thissrc.'">'. + &mt('Back to Source'). + '</a>', + '<a href="'.$thissrcdir.'">'. + &mt('Back to Source Directory'). + '</a>']); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } + } + + if ($usebuffer) { + if (wantarray) { + return ($output,1); + } else { + return 1; + } + } else { + if (wantarray) { + return ('',1); + } else { + return 1; + } + } +} + +sub notify_in_cleanup { + my ($r) = @_; + unless ($registered_cleanup) { + my $handlers = $r->get_handlers('PerlCleanupHandler'); + $r->set_handlers('PerlCleanupHandler' => [\¬ify,@{$handlers}]); + $registered_cleanup=1; } } +# =============================================================== Notifications +sub notify { +# --------------------------------------------------- Send update notifications + if (ref($modified_urls) eq 'ARRAY') { + foreach my $targetsource (@{$modified_urls}){ + my ($target,$source)=@{$targetsource}; + my $logfile=Apache::File->new('>>'.$source.'.log'); + print $logfile "\nCleanup phase: Notifications\n"; + my @subscribed=&get_subscribed_hosts($target); + foreach my $subhost (@subscribed) { + print $logfile "\nNotifying host ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + print $logfile $reply; + } +# ---------------------------------------- Send update notifications, meta only + my @subscribedmeta=&get_subscribed_hosts("$target.meta"); + foreach my $subhost (@subscribedmeta) { + print $logfile "\nNotifying host for metadata only ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', + $subhost); + print $logfile $reply; + } +# --------------------------------------------------- Notify subscribed courses + my %courses=&coursedependencies($target); + my $now=time; + foreach my $course (keys(%courses)) { + print $logfile "\nNotifying course ".$course.':'; + my ($cdom,$cname)=split(/\_/,$course); + my $reply=&Apache::lonnet::cput + ('versionupdate',{$target => $now},$cdom,$cname); + print $logfile $reply; + } + print $logfile "\n============ Done ============\n"; + $logfile->close(); + } + $modified_urls = []; + } + if ($lock) { &Apache::lonnet::remove_lock($lock); } + return OK; +} + ######################################### sub batchpublish { - my ($r,$srcfile,$targetfile)=@_; - #publication pollutes %ENV with form.* values - my %oldENV=%ENV; + my ($r,$srcfile,$targetfile,$nokeyref,$usebuffer)=@_; + #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; @@ -1550,78 +2257,266 @@ sub batchpublish { my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - $r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>'); + my $output = '<h2>' + .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile)) + .'</h2>'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } # phase one takes # my ($source,$target,$style,$batch)=@_; - my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1); - $r->print('<p>'.$outstring.'</p>'); + my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1,$nokeyref); + + if ($usebuffer) { + $output .= '<p>'.$outstring.'</p>'; + } else { + $r->print('<p>'.$outstring.'</p>'); + } # phase two takes # my ($source,$target,$style,$distarget,batch)=@_; -# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},... +# $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},... if (!$error) { - $r->print('<p>'); - &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); - $r->print('</p>'); + if ($usebuffer) { + my ($result,$error) = &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1,$usebuffer); + $output .= '<p>'.$result.'</p>'; + } else { + &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); + } } - %ENV=%oldENV; - return ''; + %env=%oldenv; + if ($usebuffer) { + return $output; + } else { + return ''; + } } ######################################### sub publishdirectory { - my ($r,$fn,$thisdisfn)=@_; + my ($r,$fn,$thisdisfn,$nokeyref,$crsauthor)=@_; $fn=~s/\/+/\//g; $thisdisfn=~s/\/+/\//g; - my $resdir= - $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. - $thisdisfn; - $r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'. - 'Target: <tt>'.$resdir.'</tt><br />'); + my $thisdisresdir=$thisdisfn; + $thisdisresdir=~s/^\/priv\//\/res\//; + my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir; + $r->print('<form name="pubdirpref" method="post" action="">' + .&Apache::lonhtmlcommon::start_pick_box() + .&Apache::lonhtmlcommon::row_title(&mt('Directory')) + .'<span class="LC_filename">'.$thisdisfn.'</span>' + .&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Target')) + .'<span class="LC_filename">'.$thisdisresdir.'</span>' + ); + my %reasons = &Apache::lonlocal::texthash( + mod => 'Authoring Space file postdates published file', + modmeta => 'Authoring Space metadata file postdates published file', + unpub => 'Resource is unpublished', + ); 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'})) { + unless ($env{'form.phase'} eq 'two') { +# ask user what they want + $r->print(&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Options') + .&Apache::loncommon::help_open_topic('Publishing_Directory_Options'))); + $r->print(&hiddenfield('phase','two'). + &hiddenfield('filename',$env{'form.filename'}). + '<fieldset><legend>'.&mt('Recurse').'</legend>'. + &checkbox('pubrec','include subdirectories'). + '</fieldset>'. + '<fieldset><legend>'.&mt('Force').'</legend>'. + &checkbox('forcerepub','force republication of previously published files').'<br />'. + &checkbox('forceoverride','force directory level metadata over existing'). + '</fieldset>'. + '<fieldset><legend>'.&mt('Exclude').'</legend>'. + &checkbox('excludeunpub','exclude currently unpublished files').'<br />'. + &checkbox('excludemod','exclude modified files').'<br />'. + &checkbox('excludemodmeta','exclude files with modified metadata'). + '</fieldset>'. + '<fieldset><legend>'.&mt('Actions').'</legend>'. + &checkbox('obsolete','make file(s) obsolete').'<br />'); + unless ($crsauthor) { + $r->print(&common_access('dist',&mt('apply common copyright/distribution'), + ['default','domain','public','custom']).'<br />'); + } + $r->print(&common_access('source',&mt('apply common source availability'), + ['closed','open']). + '</fieldset>' + ); + $r->print(&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + .'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>' + ); + $lock=0; + } else { + $r->print(&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + ); + my %commonaccess; + map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess'); + unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); } + if ($lock) { + ¬ify_in_cleanup($r); + } +# actually publish things + 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,$nokeyref,$crsauthor); + } + } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && + ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { +# find out publication status and/or existing metadata + my $publishthis=0; + my $skipthis; + 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 { + if ($env{'form.excludemod'}) { + $skipthis='mod'; + } else { + $publishthis=1; + } + } + unless ($skipthis) { + my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9]; + my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9]; + if ( $meta_rmtime<$meta_cmtime ) { + if ($env{'form.excludemodmeta'}) { + $skipthis='modmeta'; + $publishthis=0; + } else { + $publishthis=1; + } + } else { + unless (&Apache::loncommon::fileembstyle($extension) eq 'prv') { + if ($commonaccess{'dist'}) { + my ($currdist,$currdistfile,$currsourceavail); + my $currdist = &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'copyright'); + if ($currdist eq 'custom') { + $currdistfile = &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'customdistributionfile'); + } + if ($env{'form.commondistselect'} eq 'custom') { + if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) { + if ($currdist eq 'custom') { + unless ($env{'form.commoncustomrights'} eq $currdistfile) { + $publishthis=1; + } + } else { + $publishthis=1; + } + } + } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) { + unless ($currdist eq $env{'form.commondistselect'}) { + $publishthis=1; + } + } + } + } + } + } + } else { # never published - $publishthis=1; - } - if ($publishthis) { - &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); - } else { - $r->print('<br />Skipping '.$filename.'<br />'); + if ($env{'form.excludeunpub'}) { + $skipthis='unpub'; + } else { + $publishthis=1; + } + } + + if ($publishthis) { + &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref); + } else { + my $reason; + if ($skipthis) { + $reason = $reasons{$skipthis}; + } else { + $reason = &mt('No changes needed to published resource or metadata'); + } + $r->print('<br />'.&mt('Skipping').' '.$filename); + if ($reason) { + $r->print(' ('.$reason.')'); + } + $r->print('<br />'); + } + $r->rflush(); } - $r->rflush(); } + closedir(DIR); } - closedir(DIR); +} + +######################################### +# publish a default.meta file + +sub defaultmetapublish { + my ($r,$fn,$cuname,$cudom)=@_; + unless (-e $fn) { + return HTTP_NOT_FOUND; + } + my $target=$fn; + $target=~s/^\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/priv\//\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/res\//; + + + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + + $r->print(&Apache::loncommon::start_page('Metadata Publication')); + +# ---------------------------------------------------------------- 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) { + mkdir($path,0777); + $r->print('<p>' + .&mt('Created directory [_1]' + ,'<span class="LC_filename">'.$parts[$count].'</span>') + .'</p>' + ); + } + } + + if (copy($fn,$copyfile)) { + $r->print('<p>'.&mt('Copied source file').'</p>'); + } else { + return "<span class=\"LC_error\">". + &mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>"; + } + +# --------------------------------------------------- Send update notifications + + my @subscribed=&get_subscribed_hosts($target); + foreach my $subhost (@subscribed) { + $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + $r->print($reply.'</p><br />');$r->rflush; + } +# ------------------------------------------------------------------- Link back + $r->print("<a href='".&Apache::loncfile::display($fn)."'>".&mt('Back to Metadata').'</a>'); + $r->print(&Apache::loncommon::end_page()); + return OK; } ######################################### @@ -1677,160 +2572,246 @@ sub handler { &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['filename']); +# -------------------------------------- Flag and buffer for registered cleanup + $registered_cleanup=0; + @{$modified_urls}=(); # -------------------------------------------------------------- Check filename - my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); + my $fn=&unescape($env{'form.filename'}); + ($cuname,$cudom)=&Apache::lonnet::constructaccess($fn); +# ----------------------------------------------------- Do we have permissions? + unless (($cuname) && ($cudom)) { + $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. + ' trying to publish file '.$env{'form.filename'}. + ' - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } +# ----------------------------------------------------------------- Get docroot + $docroot=$r->dir_config('lonDocRoot'); + + +# special publication: default.meta file + if ($fn=~/\/default.meta$/) { + return &defaultmetapublish($r,$fn,$cuname,$cudom); + } + $fn=~s/\.meta$//; - +# sanity test on the 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) { + unless (-e $docroot.$fn) { $r->log_reason($cuname.' at '.$cudom. ' trying to publish non-existing file '. - $ENV{'form.filename'}.' ('.$fn.')', + $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; - } - } - - %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. +# --------------------------------- File is there and owned, start page output &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; - $r->print('<html><head><title>LON-CAPA Publishing</title></head>'); - $r->print(&Apache::loncommon::bodytag('Resource Publication')); - - - my $thisfn=$fn; - - my $thistarget=$thisfn; - - $thistarget=~s/^\/home/$targetdir/; - $thistarget=~s/\/public\_html//; + # Breadcrumbs + &Apache::lonhtmlcommon::clear_breadcrumbs(); + my $crumbtext = 'Authoring Space'; + my $crumbhref = &Apache::loncommon::authorspace($fn); + my $crsauthor; + if ($env{'request.course.id'}) { + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + if ($crumbhref eq "/priv/$cdom/$cnum/") { + $crumbtext = 'Course Authoring Space'; + $crsauthor = 1; + } + } + &Apache::lonhtmlcommon::add_breadcrumb({ + 'text' => $crumbtext, + 'href' => $crumbhref, + }); + &Apache::lonhtmlcommon::add_breadcrumb({ + 'text' => 'Resource Publication', + 'href' => '', + }); + + my $js='<script type="text/javascript">'. + &Apache::loncommon::browser_and_searcher_javascript(). + '</script>'; + my $startargs = {}; + if ($fn=~/\/$/) { + unless ($env{'form.phase'} eq 'two') { + $startargs->{'add_entries'} = { onload => 'javascript:setDefaultAccess();' }; + $js .= <<"END"; +<script type="text/javascript"> +// <![CDATA[ +function showHideAccess(caller,div) { + if (document.getElementById(div)) { + if (caller.checked) { + document.getElementById(div).style.display='inline-block'; + } else { + document.getElementById(div).style.display='none'; + } + } +} - my $thisdistarget=$thistarget; - $thisdistarget=~s/^\Q$docroot\E//; +function showHideCustom(caller,divid) { + if (document.getElementById(divid)) { + if (caller.options[caller.selectedIndex].value == 'custom') { + document.getElementById(divid).style.display="inline-block"; + } else { + document.getElementById(divid).style.display="none"; + } + } +} +function setDefaultAccess() { + var chkids = Array('LC_commondist','LC_commonsource'); + for (var i=0; i<chkids.length; i++) { + if (document.getElementById(chkids[i])) { + document.getElementById(chkids[i]).checked = false; + } + if (document.getElementById(chkids[i]+'select')) { + document.getElementById(chkids[i]+'select').selectedIndex = 0; + } + if (document.getElementById(chkids[i]+'div')) { + document.getElementById(chkids[i]+'div').style.display = 'none'; + } + } +} +// ]]> +</script> - my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///; +END + } + } + $r->print(&Apache::loncommon::start_page('Resource Publication',$js,$startargs) + .&Apache::lonhtmlcommon::breadcrumbs() + .&Apache::loncommon::head_subbox( + &Apache::loncommon::CSTR_pageheader($docroot.$fn)) + ); + + my $thisdisfn=&HTML::Entities::encode($fn,'<>&"'); + my $thistarget=$fn; + $thistarget=~s/^\/priv\//\/res\//; + my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"'); + my $nokeyref = &getnokey($r->dir_config('lonIncludes')); if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory - &publishdirectory($r,$fn,$thisdisfn); - $r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/' - .$cuname.'/'.$thisdisfn - .'">'.&mt('Return to Directory').'</a>'); - - + &publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref,$crsauthor); + $r->print( + '<br /><br />'. + &Apache::lonhtmlcommon::actionbox([ + '<a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>'])); } else { # ---------------------- Evaluate individual file, and then output information. - $thisfn=~/\.(\w+)$/; + $fn=~/\.(\w+)$/; my $thistype=$1; my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - $r->print('<h2>'.&mt('Publishing').' '. - &Apache::loncommon::filedescription($thistype).' <tt>'); + if ($thistype eq 'page') { $thisembstyle = 'rat'; } + $r->print('<h2>' + .&mt('Publishing [_1]' + ,'<span class="LC_filename">'.$thisdisfn.'</span>') + .'</h2>' + ); + + $r->print('<h3>'.&mt('Resource Details').'</h3>'); + + $r->print(&Apache::lonhtmlcommon::start_pick_box()); + + $r->print(&Apache::lonhtmlcommon::row_title(&mt('Type')) + .&Apache::loncommon::filedescription($thistype) + .&Apache::lonhtmlcommon::row_closure() + ); + + $r->print(&Apache::lonhtmlcommon::row_title(&mt('Link to Resource')) + .'<tt>' + ); $r->print(<<ENDCAPTION); -<a href='javascript:void(window.open("/~$cuname/$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'> +<a href='javascript:void(window.open("$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'> $thisdisfn</a> ENDCAPTION - $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'. - $thisdistarget.'</tt><br />'); - - if (($cuname ne $ENV{'user.name'})||($cudom ne $ENV{'user.domain'})) { - $r->print('<h3><font color="red">'.&mt('Co-Author').': '. - $cuname.&mt(' at ').$cudom.'</font></h3>'); + $r->print('</tt>' + .&Apache::lonhtmlcommon::row_closure() + ); + + $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target')) + .'<tt>'.$thisdistarget.'</tt>' + ); + if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) { + $r->print(&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Co-Author')) + .'<span class="LC_warning">' + .&Apache::loncommon::plainname($cuname,$cudom) .' ('.$cuname.':'.$cudom.')' + .'</span>' + ); } if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { + $r->print(&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); $r->print(<<ENDDIFF); -<br /> -<a href='javascript:void(window.open("/adm/diff?filename=/~$cuname/$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'> +<a href='javascript:void(window.open("/adm/diff?filename=$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'> ENDDIFF - $r->print(&mt('Diffs with Current Version').'</a><br />'); + $r->print(&mt('Diffs with Current Version').'</a>'); } + + $r->print(&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + ); -# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. +# ---------------------- Publishing from $fn to $thistarget with $thisembstyle. - unless ($ENV{'form.phase'} eq 'two') { - my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); - $r->print('<hr />'.$outstring); + unless ($env{'form.phase'} eq 'two') { +# ---------------------------------------------------------- Parse for problems + my ($warningcount,$errorcount); + if ($thisembstyle eq 'ssi') { + ($warningcount,$errorcount)=&checkonthis($r,$fn); + } + unless ($errorcount) { + my ($outstring,$error)= + &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle,undef,$nokeyref); + $r->print($outstring); + } else { + $r->print('<h3 class="LC_error">'. + &mt('The document contains errors and cannot be published.'). + '</h3>'); + } } else { - $r->print('<hr />'); - &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); + my ($output,$error) = &phasetwo($r,$docroot.$fn,$docroot.$thistarget, + $thisembstyle,$thisdistarget); + $r->print($output); } } - $r->print('</body></html>'); + $r->print(&Apache::loncommon::end_page()); return OK; } +BEGIN { + +# ----------------------------------- Read addid.tab + unless ($readit) { + %addid=(); + + { + my $tabdir = $Apache::lonnet::perlvar{'lonTabDir'}; + my $fh=Apache::File->new($tabdir.'/addid.tab'); + while (<$fh>=~/(\w+)\s+(\w+)/) { + $addid{$1}=$2; + } + } + } + $readit=1; +} + + 1; __END__ @@ -1838,7 +2819,5 @@ __END__ =back -=back - =cut