version 1.268, 2011/10/22 15:16:20
|
version 1.294, 2014/12/12 18:27:34
|
Line 66 invocation by F<loncapa_apache.conf>:
|
Line 66 invocation by F<loncapa_apache.conf>:
|
|
|
=head1 OVERVIEW |
=head1 OVERVIEW |
|
|
Authors can only write-access the C</~authorname/> space. They can |
Authors can only write-access the C</priv/domain/authorname/> space. |
copy resources into the resource area through the publication step, |
They can copy resources into the resource area through the |
and move them back through a recover step. Authors do not have direct |
publication step, and move them back through a recover step. |
write-access to their resource space. |
Authors do not have direct write-access to their resource space. |
|
|
During the publication step, several events will be |
During the publication step, several events will be |
triggered. Metadata is gathered, where a wizard manages default |
triggered. Metadata is gathered, where a wizard manages default |
Line 102 to publication space.
|
Line 102 to publication space.
|
Many of the undocumented subroutines implement various magical |
Many of the undocumented subroutines implement various magical |
parsing shortcuts. |
parsing shortcuts. |
|
|
=over 4 |
|
|
|
=cut |
=cut |
|
|
###################################################################### |
###################################################################### |
Line 121 use HTML::LCParser;
|
Line 119 use HTML::LCParser;
|
use HTML::Entities; |
use HTML::Entities; |
use Encode::Encoder; |
use Encode::Encoder; |
use Apache::lonxml; |
use Apache::lonxml; |
use Apache::loncacc; |
|
use DBI; |
use DBI; |
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::loncommon(); |
use Apache::loncommon(); |
Line 150 my $lock;
|
Line 147 my $lock;
|
|
|
=pod |
=pod |
|
|
|
=over 4 |
|
|
=item B<metaeval> |
=item B<metaeval> |
|
|
Evaluates a string that contains metadata. This subroutine |
Evaluates a string that contains metadata. This subroutine |
Line 201 sub metaeval {
|
Line 200 sub metaeval {
|
if (defined($token->[2]->{'name'})) { |
if (defined($token->[2]->{'name'})) { |
$unikey.="\0".$token->[2]->{'name'}; |
$unikey.="\0".$token->[2]->{'name'}; |
} |
} |
foreach (@{$token->[3]}) { |
foreach my $item (@{$token->[3]}) { |
$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; |
$metadatafields{$unikey.'.'.$item}=$token->[2]->{$item}; |
if ($metadatakeys{$unikey}) { |
if ($metadatakeys{$unikey}) { |
$metadatakeys{$unikey}.=','.$_; |
$metadatakeys{$unikey}.=','.$item; |
} else { |
} else { |
$metadatakeys{$unikey}=$_; |
$metadatakeys{$unikey}=$item; |
} |
} |
} |
} |
my $newentry=$parser->get_text('/'.$entry); |
my $newentry=$parser->get_text('/'.$entry); |
Line 266 sub metaread {
|
Line 265 sub metaread {
|
my ($logfile,$fn,$prefix)=@_; |
my ($logfile,$fn,$prefix)=@_; |
unless (-e $fn) { |
unless (-e $fn) { |
print($logfile 'No file '.$fn."\n"); |
print($logfile 'No file '.$fn."\n"); |
return '<div><b>' |
return '<p class="LC_warning">' |
.&mt('No file: [_1]' |
.&mt('No file: [_1]',&Apache::loncfile::display($fn)) |
,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>'); |
.'</p>'; |
} |
} |
print($logfile 'Processing '.$fn."\n"); |
print($logfile 'Processing '.$fn."\n"); |
my $metastring; |
my $metastring; |
Line 277 sub metaread {
|
Line 276 sub metaread {
|
$metastring=join('',<$metafh>); |
$metastring=join('',<$metafh>); |
} |
} |
&metaeval($metastring,$prefix); |
&metaeval($metastring,$prefix); |
return '<div><b>' |
return '<p class="LC_info">' |
.&mt('Processed file: [_1]' |
.&mt('Processed file: [_1]',&Apache::loncfile::display($fn)) |
,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>'); |
.'</p>'; |
} |
} |
|
|
######################################### |
######################################### |
Line 294 sub coursedependencies {
|
Line 293 sub coursedependencies {
|
my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, |
my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, |
$aauthor,$regexp); |
$aauthor,$regexp); |
my %courses=(); |
my %courses=(); |
foreach (keys %evaldata) { |
foreach my $item (keys(%evaldata)) { |
if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { |
if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { |
$courses{$1}=1; |
$courses{$1}=1; |
} |
} |
} |
} |
Line 383 sub selectbox {
|
Line 382 sub selectbox {
|
} |
} |
my $selout="\n".&Apache::lonhtmlcommon::row_title($title) |
my $selout="\n".&Apache::lonhtmlcommon::row_title($title) |
.'<select name="'.$name.'">'; |
.'<select name="'.$name.'">'; |
foreach (@idlist) { |
foreach my $id (@idlist) { |
$selout.='<option value="'.$_.'"'; |
$selout.='<option value="'.$id.'"'; |
if ($_ eq $value) { |
if ($id eq $value) { |
$selout.=' selected="selected"'; |
$selout.=' selected="selected"'; |
} |
} |
$selout.='>'.&{$functionref}($_).'</option>'; |
$selout.='>'.&{$functionref}($id).'</option>'; |
} |
} |
$selout.='</select>'.&Apache::lonhtmlcommon::row_closure(); |
$selout.='</select>'.&Apache::lonhtmlcommon::row_closure(); |
return $selout; |
return $selout; |
Line 469 Currently undocumented
|
Line 468 Currently undocumented
|
######################################### |
######################################### |
######################################### |
######################################### |
sub set_allow { |
sub set_allow { |
my ($allow,$logfile,$target,$tag,$oldurl)=@_; |
my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_; |
my $newurl=&urlfixup($oldurl,$target); |
my $newurl=&urlfixup($oldurl,$target); |
my $return_url=$oldurl; |
my $return_url=$oldurl; |
print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; |
print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; |
Line 481 sub set_allow {
|
Line 480 sub set_allow {
|
($newurl !~ /^mailto:/i) && |
($newurl !~ /^mailto:/i) && |
($newurl !~ /^(?:http|https|ftp):/i) && |
($newurl !~ /^(?:http|https|ftp):/i) && |
($newurl !~ /^\#/)) { |
($newurl !~ /^\#/)) { |
|
if (($type eq 'src') || ($type eq 'href')) { |
|
if ($newurl =~ /^([^?]+)\?[^?]*$/) { |
|
$newurl = $1; |
|
} |
|
} |
$$allow{&absoluteurl($newurl,$target)}=1; |
$$allow{&absoluteurl($newurl,$target)}=1; |
} |
} |
return $return_url; |
return $return_url; |
Line 722 sub fix_ids_and_indices {
|
Line 726 sub fix_ids_and_indices {
|
foreach my $type ('src','href','background','bgimg') { |
foreach my $type ('src','href','background','bgimg') { |
foreach my $key (keys(%parms)) { |
foreach my $key (keys(%parms)) { |
if ($key =~ /^$type$/i) { |
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, |
$parms{$key}=&set_allow(\%allow,$logfile, |
$target,$tag, |
$target,$tag, |
$parms{$key}); |
$parms{$key},$type); |
} |
} |
} |
} |
} |
} |
Line 781 sub fix_ids_and_indices {
|
Line 787 sub fix_ids_and_indices {
|
} |
} |
my $newparmstring=''; |
my $newparmstring=''; |
my $endtag=''; |
my $endtag=''; |
foreach (keys %parms) { |
foreach my $parkey (keys(%parms)) { |
if ($_ eq '/') { |
if ($parkey eq '/') { |
$endtag=' /'; |
$endtag=' /'; |
} else { |
} else { |
my $quote=($parms{$_}=~/\"/?"'":'"'); |
my $quote=($parms{$parkey}=~/\"/?"'":'"'); |
$newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote; |
$newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote; |
} |
} |
} |
} |
if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; } |
if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; } |
$outstring.='<'.$tag.$newparmstring.$endtag.'>'; |
$outstring.='<'.$tag.$newparmstring.$endtag.'>'; |
if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer' |
if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' || |
|| $lctag eq 'display' || $lctag eq 'tex') { |
$lctag eq 'tex') { |
$outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); |
$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') { |
} elsif ($token->[0] eq 'E') { |
if ($token->[2]) { |
if ($token->[2]) { |
unless ($token->[1] eq 'allow') { |
unless ($token->[1] eq 'allow') { |
Line 1017 sub publish {
|
Line 1108 sub publish {
|
$outdep.= ' - <span class="LC_error">'.&mt('Currently not available'). |
$outdep.= ' - <span class="LC_error">'.&mt('Currently not available'). |
'</span>'; |
'</span>'; |
} else { |
} 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).'___'. |
my %temphash=(&Apache::lonnet::declutter($target).'___'. |
&Apache::lonnet::declutter($thisdep).'___usage' |
&Apache::lonnet::declutter($thisdep).'___usage' |
=> time); |
=> time); |
Line 1080 sub publish {
|
Line 1176 sub publish {
|
# ------------------------------------------------ Check out directory hierachy |
# ------------------------------------------------ Check out directory hierachy |
|
|
my $thisdisfn=$source; |
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--; |
$#urlparts--; |
|
|
my $currentpath='/home/'.$cuname.'/'; |
my $currentpath=$docroot.'/priv/'.$cudom.'/'.$cuname.'/'; |
|
|
my $prefix='../'x($#urlparts); |
my $prefix='../'x($#urlparts); |
foreach (@urlparts) { |
foreach my $subdir (@urlparts) { |
$currentpath.=$_.'/'; |
$currentpath.=$subdir.'/'; |
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); |
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix); |
$prefix=~s|^\.\./||; |
$prefix=~s|^\.\./||; |
} |
} |
Line 1101 sub publish {
|
Line 1197 sub publish {
|
|
|
# ------------------- Clear out parameters and stores (there should not be any) |
# ------------------- Clear out parameters and stores (there should not be any) |
|
|
foreach (keys %metadatafields) { |
foreach my $field (keys(%metadatafields)) { |
if (($_=~/^parameter/) || ($_=~/^stores/)) { |
if (($field=~/^parameter/) || ($field=~/^stores/)) { |
delete $metadatafields{$_}; |
delete $metadatafields{$field}; |
} |
} |
} |
} |
|
|
Line 1112 sub publish {
|
Line 1208 sub publish {
|
|
|
$scrout.=&metaread($logfile,$source.'.meta'); |
$scrout.=&metaread($logfile,$source.'.meta'); |
|
|
foreach (keys %metadatafields) { |
foreach my $field (keys(%metadatafields)) { |
if (($_=~/^parameter/) || ($_=~/^stores/)) { |
if (($field=~/^parameter/) || ($field=~/^stores/)) { |
$oldparmstores{$_}=1; |
$oldparmstores{$field}=1; |
delete $metadatafields{$_}; |
delete $metadatafields{$field}; |
} |
} |
} |
} |
# ------------------------------------------------------------- Save some stuff |
# ------------------------------------------------------------- Save some stuff |
my %savemeta=(); |
my %savemeta=(); |
foreach ('title') { |
if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; } |
if ($metadatafields{$_}) { $savemeta{$_}=$metadatafields{$_}; } |
|
} |
|
# ------------------------------------------ See if anything new in file itself |
# ------------------------------------------ See if anything new in file itself |
|
|
$allmeta=&parseformeta($source,$style); |
$allmeta=&parseformeta($source,$style); |
# ----------------------------------------------------------- Restore the stuff |
# ----------------------------------------------------------- Restore the stuff |
foreach (keys %savemeta) { |
foreach my $item (keys(%savemeta)) { |
$metadatafields{$_}=$savemeta{$_}; |
$metadatafields{$item}=$savemeta{$item}; |
} |
} |
} |
} |
|
|
Line 1136 sub publish {
|
Line 1230 sub publish {
|
# ---------------- Find and document discrepancies in the parameters and stores |
# ---------------- Find and document discrepancies in the parameters and stores |
|
|
my $chparms=''; |
my $chparms=''; |
foreach (sort keys %metadatafields) { |
foreach my $field (sort(keys(%metadatafields))) { |
if (($_=~/^parameter/) || ($_=~/^stores/)) { |
if (($field=~/^parameter/) || ($field=~/^stores/)) { |
unless ($_=~/\.\w+$/) { |
unless ($field=~/\.\w+$/) { |
unless ($oldparmstores{$_}) { |
unless ($oldparmstores{$field}) { |
my $disp_key = $_; |
my $disp_key = $field; |
$disp_key =~ tr/\0/_/; |
$disp_key =~ tr/\0/_/; |
print $logfile ('New: '.$disp_key."\n"); |
print $logfile ('New: '.$disp_key."\n"); |
$chparms .= $disp_key.' '; |
$chparms .= $disp_key.' '; |
Line 1154 sub publish {
|
Line 1248 sub publish {
|
} |
} |
|
|
$chparms=''; |
$chparms=''; |
foreach (sort keys %oldparmstores) { |
foreach my $olditem (sort(keys(%oldparmstores))) { |
if (($_=~/^parameter/) || ($_=~/^stores/)) { |
if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) { |
unless (($metadatafields{$_.'.name'}) || |
unless (($metadatafields{$olditem.'.name'}) || |
($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { |
($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) { |
my $disp_key = $_; |
my $disp_key = $olditem; |
$disp_key =~ tr/\0/_/; |
$disp_key =~ tr/\0/_/; |
print $logfile ('Obsolete: '.$disp_key."\n"); |
print $logfile ('Obsolete: '.$disp_key."\n"); |
$chparms.=$disp_key.' '; |
$chparms.=$disp_key.' '; |
Line 1223 sub publish {
|
Line 1317 sub publish {
|
my $intr_scrout.='<br />' |
my $intr_scrout.='<br />' |
.'<form name="pubform" action="/adm/publish" method="post">'; |
.'<form name="pubform" action="/adm/publish" method="post">'; |
unless ($env{'form.makeobsolete'}) { |
unless ($env{'form.makeobsolete'}) { |
my $thissrc=$source; |
|
$thissrc=~s{^/home/($match_username)/public_html}{/priv/$1}; |
|
$intr_scrout.='<p class="LC_warning">' |
$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.') |
.&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.') |
.'</p>' |
.'</p>' |
.'<p><input type="submit" value="' |
.'<p><input type="submit" value="' |
.&mt('Finalize Publication') |
.&mt('Finalize Publication') |
.'" /> <a href="'.$thissrc.'">'.&mt('Cancel').'</a></p>'; |
.'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>'; |
} |
} |
$intr_scrout.=&Apache::lonhtmlcommon::start_pick_box(); |
$intr_scrout.=&Apache::lonhtmlcommon::start_pick_box(); |
$intr_scrout.= |
$intr_scrout.= |
&hiddenfield('phase','two'). |
&hiddenfield('phase','two'). |
&hiddenfield('filename',$env{'form.filename'}). |
&hiddenfield('filename',$env{'form.filename'}). |
&hiddenfield('allmeta',&escape($allmeta)). |
&hiddenfield('allmeta',&escape($allmeta)). |
&hiddenfield('dependencies',join(',',keys %allow)); |
&hiddenfield('dependencies',join(',',keys(%allow))); |
unless ($env{'form.makeobsolete'}) { |
unless ($env{'form.makeobsolete'}) { |
$intr_scrout.= |
$intr_scrout.= |
&textfield('Title','title',$metadatafields{'title'}). |
&textfield('Title','title',$metadatafields{'title'}). |
Line 1482 Returns:
|
Line 1574 Returns:
|
0: fail |
0: fail |
1: success |
1: success |
|
|
|
=back |
|
|
=cut |
=cut |
|
|
#'stupid emacs |
#'stupid emacs |
Line 1596 sub phasetwo {
|
Line 1690 sub phasetwo {
|
'</span>'); |
'</span>'); |
return 0; |
return 0; |
} |
} |
foreach (sort keys %metadatafields) { |
foreach my $field (sort(keys(%metadatafields))) { |
unless ($_=~/\./) { |
unless ($field=~/\./) { |
my $unikey=$_; |
my $unikey=$field; |
$unikey=~/^([A-Za-z]+)/; |
$unikey=~/^([A-Za-z]+)/; |
my $tag=$1; |
my $tag=$1; |
$tag=~tr/A-Z/a-z/; |
$tag=~tr/A-Z/a-z/; |
print $mfh "\n\<$tag"; |
print $mfh "\n\<$tag"; |
foreach (split(/\,/,$metadatakeys{$unikey})) { |
foreach my $item (split(/\,/,$metadatakeys{$unikey})) { |
my $value=$metadatafields{$unikey.'.'.$_}; |
my $value=$metadatafields{$unikey.'.'.$item}; |
$value=~s/\"/\'\'/g; |
$value=~s/\"/\'\'/g; |
print $mfh ' '.$_.'="'.$value.'"'; |
print $mfh ' '.$item.'="'.$value.'"'; |
} |
} |
print $mfh '>'. |
print $mfh '>'. |
&HTML::Entities::encode($metadatafields{$unikey},'<>&"') |
&HTML::Entities::encode($metadatafields{$unikey},'<>&"') |
Line 1767 sub phasetwo {
|
Line 1861 sub phasetwo {
|
|
|
# ------------------------------------------------ Provide link to new resource |
# ------------------------------------------------ Provide link to new resource |
unless ($batch) { |
unless ($batch) { |
my $thissrc=$source; |
|
$thissrc=~s{^/home/($match_username)/public_html}{/priv/$1}; |
|
|
|
|
my $thissrc=&Apache::loncfile::url($source); |
my $thissrcdir=$thissrc; |
my $thissrcdir=$thissrc; |
$thissrcdir=~s/\/[^\/]+$/\//; |
$thissrcdir=~s/\/[^\/]+$/\//; |
|
|
$r->print(&Apache::loncommon::head_subbox( |
$r->print( |
&Apache::lonhtmlcommon::start_funclist(). |
&Apache::lonhtmlcommon::actionbox([ |
&Apache::lonhtmlcommon::add_item_funclist( |
|
'<a href="'.$thisdistarget.'">'. |
'<a href="'.$thisdistarget.'">'. |
&mt('View Published Version'). |
&mt('View Published Version'). |
'</a>'). |
'</a>', |
&Apache::lonhtmlcommon::add_item_funclist( |
|
'<a href="'.$thissrc.'">'. |
'<a href="'.$thissrc.'">'. |
&mt('Back to Source'). |
&mt('Back to Source'). |
'</a>'). |
'</a>', |
&Apache::lonhtmlcommon::add_item_funclist( |
|
'<a href="'.$thissrcdir.'">'. |
'<a href="'.$thissrcdir.'">'. |
&mt('Back to Source Directory'). |
&mt('Back to Source Directory'). |
'</a>'). |
'</a>']) |
&Apache::lonhtmlcommon::end_funclist()) |
|
); |
); |
} |
} |
return 1; |
return 1; |
Line 1817 sub notify {
|
Line 1906 sub notify {
|
# --------------------------------------------------- Notify subscribed courses |
# --------------------------------------------------- Notify subscribed courses |
my %courses=&coursedependencies($target); |
my %courses=&coursedependencies($target); |
my $now=time; |
my $now=time; |
foreach (keys %courses) { |
foreach my $course (keys(%courses)) { |
print $logfile "\nNotifying course ".$_.':'; |
print $logfile "\nNotifying course ".$course.':'; |
my ($cdom,$cname)=split(/\_/,$_); |
my ($cdom,$cname)=split(/\_/,$course); |
my $reply=&Apache::lonnet::cput |
my $reply=&Apache::lonnet::cput |
('versionupdate',{$target => $now},$cdom,$cname); |
('versionupdate',{$target => $now},$cdom,$cname); |
print $logfile $reply; |
print $logfile $reply; |
Line 1839 sub batchpublish {
|
Line 1928 sub batchpublish {
|
my %oldenv=%env; |
my %oldenv=%env; |
$srcfile=~s/\/+/\//g; |
$srcfile=~s/\/+/\//g; |
$targetfile=~s/\/+/\//g; |
$targetfile=~s/\/+/\//g; |
my $thisdisfn=$srcfile; |
|
$thisdisfn=~s/\/home\/korte\/public_html\///; |
|
$srcfile=~s/\/+/\//g; |
$srcfile=~s/\/+/\//g; |
|
|
my $docroot=$r->dir_config('lonDocRoot'); |
my $docroot=$r->dir_config('lonDocRoot'); |
Line 1857 sub batchpublish {
|
Line 1944 sub batchpublish {
|
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); |
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); |
|
|
$r->print('<h2>' |
$r->print('<h2>' |
.&mt('Publishing [_1]' |
.&mt('Publishing [_1]',&Apache::loncfile::display($srcfile)) |
,'<span class="LC_filename">'.$thisdisfn.'</span>') |
|
.'</h2>' |
.'</h2>' |
); |
); |
|
|
Line 1884 sub publishdirectory {
|
Line 1970 sub publishdirectory {
|
my ($r,$fn,$thisdisfn)=@_; |
my ($r,$fn,$thisdisfn)=@_; |
$fn=~s/\/+/\//g; |
$fn=~s/\/+/\//g; |
$thisdisfn=~s/\/+/\//g; |
$thisdisfn=~s/\/+/\//g; |
my $resdir= |
my $thisdisresdir=$thisdisfn; |
$Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. |
$thisdisresdir=~s/^\/priv\//\/res\//; |
$thisdisfn; |
my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir; |
$r->print(&Apache::lonhtmlcommon::start_pick_box() |
$r->print('<form name="pubdirpref" method="post" action="">' |
|
.&Apache::lonhtmlcommon::start_pick_box() |
.&Apache::lonhtmlcommon::row_title(&mt('Directory')) |
.&Apache::lonhtmlcommon::row_title(&mt('Directory')) |
.'<span class="LC_filename">'.$thisdisfn.'</span>' |
.'<span class="LC_filename">'.$thisdisfn.'</span>' |
.&Apache::lonhtmlcommon::row_closure() |
.&Apache::lonhtmlcommon::row_closure() |
.&Apache::lonhtmlcommon::row_title(&mt('Target')) |
.&Apache::lonhtmlcommon::row_title(&mt('Target')) |
.'<span class="LC_filename">'.$resdir.'</span>' |
.'<span class="LC_filename">'.$thisdisresdir.'</span>' |
); |
); |
|
|
my $dirptr=16384; # Mask indicating a directory in stat.cmode. |
my $dirptr=16384; # Mask indicating a directory in stat.cmode. |
Line 1901 sub publishdirectory {
|
Line 1988 sub publishdirectory {
|
$r->print(&Apache::lonhtmlcommon::row_closure() |
$r->print(&Apache::lonhtmlcommon::row_closure() |
.&Apache::lonhtmlcommon::row_title(&mt('Options')) |
.&Apache::lonhtmlcommon::row_title(&mt('Options')) |
); |
); |
$r->print('<form name="pubdirpref" method="post">'. |
$r->print(&hiddenfield('phase','two'). |
&hiddenfield('phase','two'). |
|
&hiddenfield('filename',$env{'form.filename'}). |
&hiddenfield('filename',$env{'form.filename'}). |
&checkbox('pubrec','include subdirectories'). |
&checkbox('pubrec','include subdirectories'). |
&checkbox('forcerepub','force republication of previously published files'). |
&checkbox('forcerepub','force republication of previously published files'). |
&checkbox('obsolete','make file(s) obsolete'). |
&checkbox('obsolete','make file(s) obsolete'). |
&checkbox('forceoverride','force directory level metadata over existing'). |
&checkbox('forceoverride','force directory level metadata over existing') |
'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>'); |
); |
$r->print(&Apache::lonhtmlcommon::row_closure(1) |
$r->print(&Apache::lonhtmlcommon::row_closure(1) |
.&Apache::lonhtmlcommon::end_pick_box() |
.&Apache::lonhtmlcommon::end_pick_box() |
|
.'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>' |
); |
); |
$lock=0; |
$lock=0; |
} else { |
} else { |
Line 1973 sub publishdirectory {
|
Line 2060 sub publishdirectory {
|
|
|
sub defaultmetapublish { |
sub defaultmetapublish { |
my ($r,$fn,$cuname,$cudom)=@_; |
my ($r,$fn,$cuname,$cudom)=@_; |
$fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//; |
|
unless (-e $fn) { |
unless (-e $fn) { |
return HTTP_NOT_FOUND; |
return HTTP_NOT_FOUND; |
} |
} |
my $target=$fn; |
my $target=$fn; |
$target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//; |
$target=~s/^\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/priv\//\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/res\//; |
|
|
|
|
&Apache::loncommon::content_type($r,'text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
Line 2021 sub defaultmetapublish {
|
Line 2107 sub defaultmetapublish {
|
$r->print($reply.'</p><br />');$r->rflush; |
$r->print($reply.'</p><br />');$r->rflush; |
} |
} |
# ------------------------------------------------------------------- Link back |
# ------------------------------------------------------------------- Link back |
my $link=$fn; |
$r->print("<a href='".&Apache::loncfile::display($fn)."'>".&mt('Back to Metadata').'</a>'); |
$link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//; |
|
$r->print("<a href='$link'>".&mt('Back to Metadata').'</a>'); |
|
$r->print(&Apache::loncommon::end_page()); |
$r->print(&Apache::loncommon::end_page()); |
return OK; |
return OK; |
} |
} |
Line 2087 sub handler {
|
Line 2171 sub handler {
|
# -------------------------------------------------------------- Check filename |
# -------------------------------------------------------------- Check filename |
|
|
my $fn=&unescape($env{'form.filename'}); |
my $fn=&unescape($env{'form.filename'}); |
($cuname,$cudom)=&Apache::loncacc::constructaccess($fn); |
($cuname,$cudom)=&Apache::lonnet::constructaccess($fn); |
# ----------------------------------------------------- Do we have permissions? |
# ----------------------------------------------------- Do we have permissions? |
unless (($cuname) && ($cudom)) { |
unless (($cuname) && ($cudom)) { |
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
Line 2152 sub handler {
|
Line 2236 sub handler {
|
# Breadcrumbs |
# Breadcrumbs |
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
&Apache::lonhtmlcommon::add_breadcrumb({ |
&Apache::lonhtmlcommon::add_breadcrumb({ |
'text' => 'Construction Space', |
'text' => 'Authoring Space', |
'href' => &Apache::loncommon::authorspace(), |
'href' => &Apache::loncommon::authorspace($fn), |
}); |
}); |
&Apache::lonhtmlcommon::add_breadcrumb({ |
&Apache::lonhtmlcommon::add_breadcrumb({ |
'text' => 'Resource Publication', |
'text' => 'Resource Publication', |
Line 2166 sub handler {
|
Line 2250 sub handler {
|
$r->print(&Apache::loncommon::start_page('Resource Publication',$js) |
$r->print(&Apache::loncommon::start_page('Resource Publication',$js) |
.&Apache::lonhtmlcommon::breadcrumbs() |
.&Apache::lonhtmlcommon::breadcrumbs() |
.&Apache::loncommon::head_subbox( |
.&Apache::loncommon::head_subbox( |
&Apache::loncommon::CSTR_pageheader()) # FIXME crumbs broken? |
&Apache::loncommon::CSTR_pageheader($docroot.$fn)) |
); |
); |
|
|
my $thisdisfn=&HTML::Entities::encode($fn,'<>&"'); |
my $thisdisfn=&HTML::Entities::encode($fn,'<>&"'); |
Line 2176 sub handler {
|
Line 2260 sub handler {
|
|
|
if ($fn=~/\/$/) { |
if ($fn=~/\/$/) { |
# -------------------------------------------------------- This is a directory |
# -------------------------------------------------------- This is a directory |
&publishdirectory($r,$fn,$thisdisfn); |
&publishdirectory($r,$docroot.$fn,$thisdisfn); |
$r->print('<hr /><a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>'); |
$r->print( |
|
'<br /><br />'. |
|
&Apache::lonhtmlcommon::actionbox([ |
|
'<a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>'])); |
} else { |
} else { |
# ---------------------- Evaluate individual file, and then output information. |
# ---------------------- Evaluate individual file, and then output information. |
$fn=~/\.(\w+)$/; |
$fn=~/\.(\w+)$/; |
Line 2227 ENDCAPTION
|
Line 2314 ENDCAPTION
|
$r->print(&Apache::lonhtmlcommon::row_closure() |
$r->print(&Apache::lonhtmlcommon::row_closure() |
.&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); |
.&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); |
$r->print(<<ENDDIFF); |
$r->print(<<ENDDIFF); |
<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"))'> |
<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 |
ENDDIFF |
$r->print(&mt('Diffs with Current Version').'</a>'); |
$r->print(&mt('Diffs with Current Version').'</a>'); |
} |
} |
Line 2246 ENDDIFF
|
Line 2333 ENDDIFF
|
} |
} |
unless ($errorcount) { |
unless ($errorcount) { |
my ($outstring,$error)= |
my ($outstring,$error)= |
&publish($fn,$thistarget,$thisembstyle); |
&publish($docroot.$fn,$docroot.$thistarget,$thisembstyle); |
$r->print($outstring); |
$r->print($outstring); |
} else { |
} else { |
$r->print('<h3 class="LC_error">'. |
$r->print('<h3 class="LC_error">'. |
Line 2254 ENDDIFF
|
Line 2341 ENDDIFF
|
'</h3>'); |
'</h3>'); |
} |
} |
} else { |
} else { |
&phasetwo($r,$fn,$thistarget,$thisembstyle,$thisdistarget); |
&phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget); |
} |
} |
} |
} |
$r->print(&Apache::loncommon::end_page()); |
$r->print(&Apache::loncommon::end_page()); |
Line 2269 __END__
|
Line 2356 __END__
|
|
|
=back |
=back |
|
|
=back |
|
|
|
=cut |
=cut |
|
|