# The LearningOnline Network
# Documents
#
# $Id: londocs.pm,v 1.537 2013/03/17 14:27:34 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::londocs;
use strict;
use Apache::Constants qw(:common :http);
use Apache::imsexport;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhtmlcommon;
use LONCAPA::map();
use Apache::lonratedt();
use Apache::lonxml;
use Apache::lonclonecourse;
use Apache::lonnavmaps;
use Apache::lonnavdisplay();
use Apache::lonextresedit();
use HTML::Entities;
use HTML::TokeParser;
use GDBM_File;
use Apache::lonlocal;
use Cwd;
use LONCAPA qw(:DEFAULT :match);
my $iconpath;
my %hash;
my $hashtied;
my %alreadyseen=();
my $hadchanges;
my %help=();
sub mapread {
my ($coursenum,$coursedom,$map)=@_;
return
&LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
$map);
}
sub storemap {
my ($coursenum,$coursedom,$map,$contentchg)=@_;
my $report;
if (($contentchg) && ($map =~ /^default/)) {
$report = 1;
}
my ($outtext,$errtext)=
&LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
$map,1,$report);
if ($errtext) { return ($errtext,2); }
$hadchanges=1;
return ($errtext,0);
}
sub authorhosts {
my %outhash=();
my $home=0;
my $other=0;
foreach my $key (keys(%env)) {
if ($key=~/^user\.role\.(au|ca)\.(.+)$/) {
my $role=$1;
my $realm=$2;
my ($start,$end)=split(/\./,$env{$key});
if (($start) && ($start>time)) { next; }
if (($end) && (time>$end)) { next; }
my ($ca,$cd);
if ($1 eq 'au') {
$ca=$env{'user.name'};
$cd=$env{'user.domain'};
} else {
($cd,$ca)=($realm=~/^\/($match_domain)\/($match_username)$/);
}
my $allowed=0;
my $myhome=&Apache::lonnet::homeserver($ca,$cd);
my @ids=&Apache::lonnet::current_machine_ids();
foreach my $id (@ids) {
if ($id eq $myhome) {
$allowed=1;
last;
}
}
if ($allowed) {
$home++;
$outhash{'home_'.$ca.':'.$cd}=1;
} else {
$outhash{'otherhome_'.$ca.':'.$cd}=$myhome;
$other++;
}
}
}
return ($home,$other,%outhash);
}
sub clean {
my ($title)=@_;
$title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;
return $title;
}
sub dumpcourse {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
$r->print(&Apache::loncommon::start_page('Dump '.$crstype.' Content to Authoring Space')."\n".
&Apache::lonhtmlcommon::breadcrumbs('Dump '.$crstype.' Content to Authoring Space')."\n");
$r->print(&startContentScreen('tools'));
my ($home,$other,%outhash)=&authorhosts();
unless ($home) {
$r->print(&endContentScreen());
return '';
}
my $origcrsid=$env{'request.course.id'};
my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) {
# Do the dumping
unless ($outhash{'home_'.$env{'form.authorspace'}}) {
$r->print(&endContentScreen());
return '';
}
my ($ca,$cd)=split(/\:/,$env{'form.authorspace'});
$r->print('
'.&mt('Copying Files').'
');
my $title=$env{'form.authorfolder'};
$title=&clean($title);
my %replacehash=();
foreach my $key (keys(%env)) {
if ($key=~/^form\.namefor\_(.+)/) {
$replacehash{$1}=$env{$key};
}
}
my $crs='/uploaded/'.$env{'request.course.id'}.'/';
$crs=~s/\_/\//g;
foreach my $item (keys(%replacehash)) {
my $newfilename=$title.'/'.$replacehash{$item};
$newfilename=~s/\.(\w+)$//;
my $ext=$1;
$newfilename=&clean($newfilename);
$newfilename.='.'.$ext;
my @dirs=split(/\//,$newfilename);
my $path=$r->dir_config('lonDocRoot')."/priv/$cd/$ca";
my $makepath=$path;
my $fail=0;
for (my $i=0;$i<$#dirs;$i++) {
$makepath.='/'.$dirs[$i];
unless (-e $makepath) {
unless(mkdir($makepath,0777)) { $fail=1; }
}
}
$r->print(' '.$item.' => '.$newfilename.': ');
if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) {
if ($item=~/\.(sequence|page|html|htm|xml|xhtml)$/) {
print $fh &Apache::lonclonecourse::rewritefile(
&Apache::lonclonecourse::readfile($env{'request.course.id'},$item),
(%replacehash,$crs => '')
);
} else {
print $fh
&Apache::lonclonecourse::readfile($env{'request.course.id'},$item);
}
$fh->close();
} else {
$fail=1;
}
if ($fail) {
$r->print(''.&mt('fail').'');
} else {
$r->print(''.&mt('ok').'');
}
}
} else {
$r->print(&mt('Searching ...').' ');
$r->rflush();
# Input form
$r->print('');
}
$r->print(&endContentScreen());
}
sub group_import {
my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_;
my ($donechk,$allmaps,%hierarchy,%titles,%addedmaps,%removefrommap,
%removeparam,$importuploaded,$fixuperrors);
$allmaps = {};
while (@files) {
my ($name, $url, $residx) = @{ shift(@files) };
if (($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$})
&& ($caller eq 'londocs')
&& (!&Apache::lonnet::stat_file($url))) {
my $errtext = '';
my $fatal = 0;
my $newmapstr = '';
$env{'form.output'}=$newmapstr;
my $result=&Apache::lonnet::finishuserfileupload($coursenum,$coursedom,
'output',$1.$2);
if ($result !~ m{^/uploaded/}) {
$errtext.='Map not saved: A network error occurred when trying to save the new map. ';
$fatal = 2;
}
if ($fatal) {
return ($errtext,$fatal);
}
}
if ($url) {
if (($caller eq 'londocs') &&
($folder =~ /^default/)) {
if (($url =~ /\.(page|sequence)$/) && (!$donechk)) {
my $chome = &Apache::lonnet::homeserver($coursenum,$coursedom);
my $cid = $coursedom.'_'.$coursenum;
$allmaps =
&Apache::loncommon::allmaps_incourse($coursedom,$coursenum,
$chome,$cid);
$donechk = 1;
}
if ($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$}) {
&contained_map_check($url,$folder,\%removefrommap,\%removeparam,
\%addedmaps,\%hierarchy,\%titles,$allmaps);
$importuploaded = 1;
} elsif ($url =~ m{^/res/.+\.(page|sequence)$}) {
next if ($allmaps->{$url});
}
}
if (!$residx
|| defined($LONCAPA::map::zombies[$residx])) {
$residx = &LONCAPA::map::getresidx($url,$residx);
push(@LONCAPA::map::order, $residx);
}
my $ext = 'false';
if ($url=~m{^http://} || $url=~m{^https://}) { $ext = 'true'; }
$url = &LONCAPA::map::qtunescape($url);
$name = &LONCAPA::map::qtunescape($name);
if ($name eq '') {
$name = &mt('Web Page');
}
if ($url =~ m{^/uploaded/$coursedom/$coursenum/((?:docs|supplemental)/(?:default|\d+))/new\.html$}) {
my $filepath = $1;
my $fname = $name;
if ($fname =~ /^\W+$/) {
$fname = 'web';
} else {
$fname =~ s/\W/_/g;
}
if (length($fname > 15)) {
$fname = substr($fname,0,14);
}
my $initialtext = &mt('Replace with your own content.');
my $newhtml = <$name
$initialtext
END
$env{'form.output'}=$newhtml;
my $result =
&Apache::lonnet::finishuserfileupload($coursenum,$coursedom,
'output',
"$filepath/$residx/$fname.html");
if ($result =~ m{^/uploaded/}) {
$url = $result;
if ($filepath =~ /^supplemental/) {
$name = time.'___&&&___'.$env{'user.name'}.'___&&&___'.
$env{'user.domain'}.'___&&&___'.$name;
}
} else {
return (&mt('Failed to save new web page.'),1);
}
}
$LONCAPA::map::resources[$residx] =
join(':', ($name, $url, $ext, 'normal', 'res'));
}
}
if ($importuploaded) {
my %import_errors;
my %updated = (
removefrommap => \%removefrommap,
removeparam => \%removeparam,
);
my ($result,$msgsarray,$lockerror) =
&apply_fixups($folder,1,$coursedom,$coursenum,\%import_errors,\%updated);
if (keys(%import_errors) > 0) {
$fixuperrors =
'
'."\n".
&mt('The following files are either dependencies of a web page or references within a folder and/or composite page for which errors occurred during import:')."\n".
'
'."\n";
foreach my $key (sort(keys(%import_errors))) {
$fixuperrors .= '
'.$key.'
'."\n";
}
$fixuperrors .= '
'."\n";
}
if (ref($msgsarray) eq 'ARRAY') {
if (@{$msgsarray} > 0) {
$fixuperrors .= '
'.
join(' ',@{$msgsarray}).
'
';
}
}
if ($lockerror) {
$fixuperrors .= '
'.
$lockerror.
'
';
}
}
my ($errtext,$fatal) =
&storemap($coursenum, $coursedom, $folder.'.'.$container,1);
return ($errtext,$fatal,$fixuperrors);
}
sub log_docs {
return &Apache::lonnet::write_log('course','docslog',@_);
}
{
my @oldresources=();
my @oldorder=();
my $parmidx;
my %parmaction=();
my %parmvalue=();
my $changedflag;
sub snapshotbefore {
@oldresources=@LONCAPA::map::resources;
@oldorder=@LONCAPA::map::order;
$parmidx=undef;
%parmaction=();
%parmvalue=();
$changedflag=0;
}
sub remember_parms {
my ($idx,$parameter,$action,$value)=@_;
$parmidx=$idx;
$parmaction{$parameter}=$action;
$parmvalue{$parameter}=$value;
$changedflag=1;
}
sub log_differences {
my ($plain)=@_;
my %storehash=('folder' => $plain,
'currentfolder' => $env{'form.folder'});
if ($parmidx) {
$storehash{'parameter_res'}=$oldresources[$parmidx];
foreach my $parm (keys(%parmaction)) {
$storehash{'parameter_action_'.$parm}=$parmaction{$parm};
$storehash{'parameter_value_'.$parm}=$parmvalue{$parm};
}
}
my $maxidx=$#oldresources;
if ($#LONCAPA::map::resources>$#oldresources) {
$maxidx=$#LONCAPA::map::resources;
}
for (my $idx=0; $idx<=$maxidx; $idx++) {
if ($LONCAPA::map::resources[$idx] ne $oldresources[$idx]) {
$storehash{'before_resources_'.$idx}=$oldresources[$idx];
$storehash{'after_resources_'.$idx}=$LONCAPA::map::resources[$idx];
$changedflag=1;
}
if ($LONCAPA::map::order[$idx] ne $oldorder[$idx]) {
$storehash{'before_order_res_'.$idx}=$oldresources[$oldorder[$idx]];
$storehash{'after_order_res_'.$idx}=$LONCAPA::map::resources[$LONCAPA::map::order[$idx]];
$changedflag=1;
}
}
$storehash{'maxidx'}=$maxidx;
if ($changedflag) { &log_docs(\%storehash); }
}
}
sub docs_change_log {
my ($r,$coursenum,$coursedom,$folder,$allowed,$crstype,$iconpath)=@_;
my $supplementalflag=($env{'form.folderpath'}=~/^supplemental/);
my $js = ''."\n";
$r->print(&Apache::loncommon::start_page('Content Change Log',$js));
$r->print(&Apache::lonhtmlcommon::breadcrumbs('Content Change Log'));
$r->print(&startContentScreen(($supplementalflag?'suppdocs':'docs')));
my %orderhash;
my $container='sequence';
my $pathitem;
if ($env{'form.folderpath'} =~ /\:1$/) {
$container='page';
}
my $folderpath=$env{'form.folderpath'};
if ($folderpath eq '') {
$folderpath = 'default&'.&escape(&mt('Main '.$crstype.' Documents').':::::');
}
$pathitem = '';
my $readfile="/uploaded/$coursedom/$coursenum/$folder.$container";
my $jumpto = $readfile;
$jumpto =~ s{^/}{};
my $tid = 1;
if ($supplementalflag) {
$tid = 2;
}
my ($breadcrumbtrail) =
&Apache::lonhtmlcommon::docs_breadcrumbs($allowed,$crstype,1);
$r->print($breadcrumbtrail.
&generate_edit_table($tid,\%orderhash,undef,$iconpath,$jumpto,
$readfile));
my %docslog=&Apache::lonnet::dump('nohist_docslog',
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
if ((keys(%docslog))[0]=~/^error\:/) { undef(%docslog); }
my %saveable_parameters = ('show' => 'scalar',);
&Apache::loncommon::store_course_settings('docs_log',
\%saveable_parameters);
&Apache::loncommon::restore_course_settings('docs_log',
\%saveable_parameters);
if (!$env{'form.show'}) { $env{'form.show'}=10; }
# FIXME: internationalization seems wrong here
my %lt=('hiddenresource' => 'Resources hidden',
'encrypturl' => 'URL hidden',
'randompick' => 'Randomly pick',
'randomorder' => 'Randomly ordered',
'set' => 'set to',
'del' => 'deleted');
my $filter = &Apache::loncommon::display_filter('docslog')."\n".
$pathitem."\n".
''.
(' 'x2).'';
$r->print('
'.
&Apache::loncommon::end_data_table_header_row());
my $shown=0;
foreach my $id (sort { $docslog{$b}{'exe_time'}<=>$docslog{$a}{'exe_time'} } (keys(%docslog))) {
if ($env{'form.displayfilter'} eq 'currentfolder') {
if ($docslog{$id}{'logentry'}{'currentfolder'} ne $folder) { next; }
}
my @changes=keys(%{$docslog{$id}{'logentry'}});
if ($env{'form.displayfilter'} eq 'containing') {
my $wholeentry=$docslog{$id}{'exe_uname'}.':'.$docslog{$id}{'exe_udom'}.':'.
&Apache::loncommon::plainname($docslog{$id}{'exe_uname'},$docslog{$id}{'exe_udom'});
foreach my $key (@changes) {
$wholeentry.=':'.$docslog{$id}{'logentry'}{$key};
}
if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
}
my $count = 0;
my $time =
&Apache::lonlocal::locallocaltime($docslog{$id}{'exe_time'});
my $plainname =
&Apache::loncommon::plainname($docslog{$id}{'exe_uname'},
$docslog{$id}{'exe_udom'});
my $about_me_link =
&Apache::loncommon::aboutmewrapper($plainname,
$docslog{$id}{'exe_uname'},
$docslog{$id}{'exe_udom'});
my $send_msg_link='';
if ((($docslog{$id}{'exe_uname'} ne $env{'user.name'})
|| ($docslog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
$send_msg_link =' '.
&Apache::loncommon::messagewrapper(&mt('Send message'),
$docslog{$id}{'exe_uname'},
$docslog{$id}{'exe_udom'});
}
$r->print(&Apache::loncommon::start_data_table_row());
$r->print('
');
my $is_supp = 0;
if ($docslog{$id}{'logentry'}{'currentfolder'} =~ /^supplemental/) {
$is_supp = 1;
}
# Before
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
my $oldname=(split(/\:/,$docslog{$id}{'logentry'}{'before_resources_'.$idx}))[0];
my $newname=(split(/\:/,$docslog{$id}{'logentry'}{'after_resources_'.$idx}))[0];
if ($oldname ne $newname) {
my $shown = &LONCAPA::map::qtescape($oldname);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title($shown);
}
$r->print($shown);
}
}
$r->print('
');
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
if ($docslog{$id}{'logentry'}{'before_order_res_'.$idx}) {
my $shown = &LONCAPA::map::qtescape((split(/\:/,$docslog{$id}{'logentry'}{'before_order_res_'.$idx}))[0]);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title($shown);
}
$r->print('
'.$shown.'
');
}
}
$r->print('
');
# After
$r->print('
');
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
my $oldname=(split(/\:/,$docslog{$id}{'logentry'}{'before_resources_'.$idx}))[0];
my $newname=(split(/\:/,$docslog{$id}{'logentry'}{'after_resources_'.$idx}))[0];
if ($oldname ne '' && $oldname ne $newname) {
my $shown = &LONCAPA::map::qtescape($newname);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title(&LONCAPA::map::qtescape($newname));
}
$r->print($shown);
}
}
$r->print('
');
for (my $idx=0;$idx<=$docslog{$id}{'logentry'}{'maxidx'};$idx++) {
if ($docslog{$id}{'logentry'}{'after_order_res_'.$idx}) {
my $shown = &LONCAPA::map::qtescape((split(/\:/,$docslog{$id}{'logentry'}{'after_order_res_'.$idx}))[0]);
if ($is_supp) {
$shown = &Apache::loncommon::parse_supplemental_title($shown);
}
$r->print('
'.$shown.'
');
}
}
$r->print('
');
if ($docslog{$id}{'logentry'}{'parameter_res'}) {
$r->print(&LONCAPA::map::qtescape((split(/\:/,$docslog{$id}{'logentry'}{'parameter_res'}))[0]).':
');
foreach my $parameter ('randompick','hiddenresource','encrypturl','randomorder') {
if ($docslog{$id}{'logentry'}{'parameter_action_'.$parameter}) {
# FIXME: internationalization seems wrong here
$r->print('
'.&Apache::loncommon::end_data_table_row());
$shown++;
if (!($env{'form.show'} eq &mt('all')
|| $shown<=$env{'form.show'})) { last; }
}
$r->print(&Apache::loncommon::end_data_table()."\n".
&makesimpleeditform($pathitem)."\n".
'');
$r->print(&endContentScreen());
}
sub update_paste_buffer {
my ($coursenum,$coursedom,$folder) = @_;
return if (!defined($env{'form.markcopy'}));
return if (!defined($env{'form.copyfolder'}));
return if ($env{'form.markcopy'} < 0);
my ($errtext,$fatal) = &mapread($coursenum,$coursedom,
$env{'form.copyfolder'});
return if ($fatal);
# Mark for copying
my ($title,$url)=split(':',$LONCAPA::map::resources[$LONCAPA::map::order[$env{'form.markcopy'}]]);
if (&is_supplemental_title($title)) {
&Apache::lonnet::appenv({'docs.markedcopy_supplemental' => $title});
($title) = &Apache::loncommon::parse_supplemental_title($title);
} elsif ($env{'docs.markedcopy_supplemental'}) {
&Apache::lonnet::delenv('docs.markedcopy_supplemental');
}
$url=~s{http(:|:)//https(:|:)//}{https$2//};
(my $cmd,undef)=split('_',$env{'form.cmd'});
my %addtoenv = (
'docs.markedcopy_title' => $title,
'docs.markedcopy_url' => $url,
'docs.markedcopy_cmd' => $cmd,
);
&Apache::lonnet::delenv('docs.markedcopy_nested');
&Apache::lonnet::delenv('docs.markedcopy_nestednames');
if ($url =~ m{^/uploaded/$match_domain/$match_courseid/(default|supplemental)_?(\d*)\.(page|sequence)$}) {
my $prefix = $1;
my $subdir =$2;
if ($subdir eq '') {
$subdir = $prefix;
}
my (%addedmaps,%removefrommap,%removeparam,%hierarchy,%titles,%allmaps);
&contained_map_check($url,$folder,\%removefrommap,\%removeparam,\%addedmaps,
\%hierarchy,\%titles,\%allmaps);
if (ref($hierarchy{$url}) eq 'HASH') {
my ($nested,$nestednames);
&recurse_uploaded_maps($url,$subdir,\%hierarchy,\%titles,\$nested,\$nestednames);
$nested =~ s/\&$//;
$nestednames =~ s/\Q___&&&___\E$//;
if ($nested ne '') {
$addtoenv{'docs.markedcopy_nested'} = $nested;
}
if ($nestednames ne '') {
$addtoenv{'docs.markedcopy_nestednames'} = $nestednames;
}
}
}
&Apache::lonnet::appenv(\%addtoenv);
delete($env{'form.markcopy'});
}
sub recurse_uploaded_maps {
my ($url,$dir,$hierarchy,$titlesref,$nestref,$namesref) = @_;
if (ref($hierarchy->{$url}) eq 'HASH') {
my @maps = map { $hierarchy->{$url}{$_}; } sort { $a <=> $b } (keys(%{$hierarchy->{$url}}));
my @titles = map { $titlesref->{$url}{$_}; } sort { $a <=> $b } (keys(%{$titlesref->{$url}}));
my (@uploaded,@names,%shorter);
for (my $i=0; $i<@maps; $i++) {
my ($inner) = ($maps[$i] =~ m{^/uploaded/$match_domain/$match_courseid/(?:default|supplemental)_(\d+)\.(?:page|sequence)$});
if ($inner ne '') {
push(@uploaded,$inner);
push(@names,&escape($titles[$i]));
$shorter{$maps[$i]} = $inner;
}
}
$$nestref .= "$dir:".join(',',@uploaded).'&';
$$namesref .= "$dir:".(join(',',@names)).'___&&&___';
foreach my $map (@maps) {
if ($shorter{$map} ne '') {
&recurse_uploaded_maps($map,$shorter{$map},$hierarchy,$titlesref,$nestref,$namesref);
}
}
}
return;
}
sub print_paste_buffer {
my ($r,$container,$folder,$coursedom,$coursenum) = @_;
return if (!defined($env{'docs.markedcopy_url'}));
my ($is_external,$othercourse,$fromsupp,$is_uploaded_map,$parent);
my $extension = (split(/\./,$env{'docs.markedcopy_url'}))[-1];
if ($env{'docs.markedcopy_url'} =~ m{^(?:/adm/wrapper/ext|(?:http|https)(?::|:))//} ) {
$is_external = 1;
}
my ($canpaste,$nopaste,$othercrs,$areachange);
if ($folder =~ /^supplemental/) {
$canpaste = &supp_pasteable($env{'docs.markedcopy_url'});
unless ($canpaste) {
$nopaste = &mt('Paste into Supplemental Content unavailable for this type of content.');
}
} else {
$canpaste = 1;
}
if ($canpaste) {
if ($env{'docs.markedcopy_url'} =~ m{^/uploaded/($match_domain)/($match_courseid)/(.+)$}) {
my $srcdom = $1;
my $srcnum = $2;
my $rem = $3;
if (($srcdom ne $coursedom) || ($srcnum ne $coursenum)) {
$othercourse = 1;
if ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {
if ($canpaste) {
$othercrs = ' '.&mt('(from another course).');
}
} else {
$canpaste = 0;
$nopaste = &mt('Paste from another course unavailable.')
}
}
if ($rem =~ m{^(default|supplemental)_?(\d*)\.(?:page|sequence)$}) {
my $prefix = $1;
$parent = $2;
if ($folder !~ /^\Q$prefix\E/) {
$areachange = 1;
}
$is_uploaded_map = 1;
}
}
}
$r->print('');
}
sub recurse_print {
my ($r,$dir,$deps,$display) = @_;
$r->print($display->{$dir}."\n");
if (ref($deps->{$dir}) eq 'ARRAY') {
foreach my $subdir (@{$deps->{$dir}}) {
&recurse_print($r,$subdir,$deps,$display);
}
}
}
sub supp_pasteable {
my ($url) = @_;
if (($url =~ m{^(?:/adm/wrapper/ext|(?:http|https)(?::|:))//}) ||
(($url =~ /\.sequence$/) && ($url =~ m{^/uploaded/})) ||
($url =~ m{^/uploaded/$match_domain/$match_courseid/(docs|supplemental)/(default|\d+)/\d+/}) ||
($url =~ m{^/adm/$match_domain/$match_username/aboutme}) ||
($url =~ m{^/public/$match_domain/$match_courseid/syllabus})) {
return 1;
}
return;
}
sub paste_popup_js {
my %lt = &Apache::lonlocal::texthash(
show => 'Show Paste Options',
hide => 'Hide Paste Options',
);
return <<"END";
function showPasteOptions() {
document.getElementById('pasteoptions').style.display='block';
document.getElementById('pasteoptions').style.textAlign='left';
document.getElementById('pasteoptions').style.textFace='normal';
document.getElementById('pasteoptionstext').innerHTML ='$lt{'hide'} ';
return;
}
function hidePasteOptions() {
document.getElementById('pasteoptions').style.display='none';
document.getElementById('pasteoptionstext').innerHTML ='$lt{'show'}';
return;
}
END
}
sub do_paste_from_buffer {
my ($coursenum,$coursedom,$folder,$container,$errors) = @_;
# Early out if paste buffer is empty
if (!$env{'form.pastemarked'}) {
return ();
}
# Supplemental content may only include certain types of content
# Early out if pasted content is not supported in Supplemental area
if ($folder =~ /^supplemental/) {
unless (&supp_pasteable($env{'docs.markedcopy_url'})) {
return (&mt('Paste failed: content type is not supported within Supplemental Content'));
}
}
# Prepare to paste resource at end of list
my $url=&LONCAPA::map::qtescape($env{'docs.markedcopy_url'});
my $title=&LONCAPA::map::qtescape($env{'docs.markedcopy_title'});
my ($is_map,$srcdom,$srcnum,$prefixchg,%before,%after,%mapchanges,%tomove);
if ($url=~/\.(page|sequence)$/) {
$is_map = 1;
}
if ($url =~ m{^/uploaded/($match_domain)/($match_courseid)/([^/]+)}) {
$srcdom = $1;
$srcnum = $2;
my $oldprefix = $3;
# When paste buffer was populated using an active role in a different course
# check for mdc privilege in the course from which the resource was pasted
if (($srcdom ne $coursedom) || ($srcnum ne $coursenum)) {
unless ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {
return (&mt('Paste failed: Item is from a different course which you do not have rights to edit.'));
}
}
# When pasting content from Main Content to Supplemental Content and vice versa
# URLs will contain different paths (which depend on whether pasted item is
# a folder/page or a document.
if (($folder =~ /^supplemental/) && (($oldprefix =~ /^default/) || ($oldprefix eq 'docs'))) {
$prefixchg = 1;
%before = ( map => 'default',
doc => 'docs');
%after = ( map => 'supplemental',
doc => 'supplemental' );
} elsif (($folder =~ /^default/) && ($oldprefix =~ /^supplemental/)) {
$prefixchg = 1;
%before = ( map => 'supplemental',
doc => 'supplemental');
%after = ( map => 'default',
doc => 'docs');
}
# If pasting an uploaded map, get list of contained uploaded maps.
my @nested;
if ($env{'docs.markedcopy_nested'}) {
my ($type) = ($oldprefix =~ /^(default|supplemental)/);
my @items = split(/\&/,$env{'docs.markedcopy_nested'});
my @deps = map { /\d+:([\d,]+$)/ } @items;
foreach my $dep (@deps) {
if ($dep =~ /,/) {
push(@nested,split(/,/,$dep));
} else {
push(@nested,$dep);
}
}
foreach my $item (@nested) {
if ($env{'form.docs.markedcopy_'.$item} eq 'move') {
$tomove{$type.'_'.$item} = 1;
}
}
}
}
# Maps need to be copied first
my ($oldurl,%removefrommap,%removeparam,%addedmaps,%rewrites,%retitles,%copies,
%dbcopies,%zombies,%params,%docmoves,%mapmoves,%newsubdir,%newurls);
$oldurl = $url;
if ($is_map) {
# If pasting a map, check if map contains other maps
my ($allmaps,%hierarchy,%titles);
$allmaps = {};
if ($folder =~ /^default/) {
$allmaps =
&Apache::loncommon::allmaps_incourse($coursedom,$coursenum,
$env{"course.$env{'request.course.id'}.home"},
$env{'request.course.id'});
}
&contained_map_check($url,$folder,\%removefrommap,\%removeparam,
\%addedmaps,\%hierarchy,\%titles,$allmaps);
if ($url=~ m{^/uploaded/}) {
my $newurl;
unless ($env{'form.docs.markedcopy_options'} eq 'move') {
($newurl,my $error) =
&get_newmap_url($url,$folder,$prefixchg,$coursedom,$coursenum,
$srcdom,$srcnum,\$title,$allmaps,\%newurls);
if ($error) {
return ($error);
}
if ($newurl ne '') {
if ($newurl ne $url) {
if ($newurl =~ /(?:default|supplemental)_(\d+).(?:sequence|page)$/) {
$newsubdir{$url} = $1;
}
$mapchanges{$url} = 1;
}
}
}
if (($srcdom ne $coursedom) || ($srcnum ne $coursenum) || ($prefixchg) ||
(($newurl ne '') && ($newurl ne $url))) {
unless (&url_paste_fixups($url,$folder,$prefixchg,$coursedom,
$coursenum,$srcdom,$srcnum,$allmaps,
\%rewrites,\%retitles,\%copies,\%dbcopies,
\%zombies,\%params,\%mapmoves,\%mapchanges,\%tomove,
\%newsubdir,\%newurls)) {
$mapmoves{$url} = 1;
}
$url = $newurl;
} elsif ($env{'docs.markedcopy_nested'}) {
&url_paste_fixups($url,$folder,$prefixchg,$coursedom,$coursenum,
$srcdom,$srcnum,$allmaps,\%rewrites,
\%retitles,\%copies,\%dbcopies,\%zombies,\%params,\%mapmoves,
\%mapchanges,\%tomove,\%newsubdir,\%newurls);
}
} elsif ($url=~m {^/res/}) {
# published maps can only exists once, so remove it from paste buffer when done
&Apache::lonnet::delenv('docs.markedcopy');
# if pasting published map (main content are only) check map is not already in course
if ($folder =~ /^default/) {
if ((ref($allmaps) eq 'HASH') && ($allmaps->{$url})) {
return (&mt('Paste failed: only one instance of a particular published sequence or page is allowed within each course.'));
}
}
}
}
my $lockerrors;
if ($url=~ m{/(bulletinboard|smppg)$}) {
my $prefix = $1;
#need to copy the db contents to a new one, unless this is a move.
my %info = (
src => $url,
cdom => $coursedom,
cnum => $coursenum,
);
my (%lockerr,$msg);
unless ($env{'form.docs.markedcopy_options'} eq 'move') {
my ($newurl,$result,$errtext) =
&dbcopy(\%info,$coursedom,$coursenum,\%lockerr);
if ($result eq 'ok') {
$url = $newurl;
$title=&mt('Copy of').' '.$title;
} else {
if ($prefix eq 'smppg') {
$msg = &mt('Paste failed: An error occurred when copying the simple page.').' '.$errtext;
} elsif ($prefix eq 'bulletinboard') {
$msg = &mt('Paste failed: An error occurred when copying the bulletin board.').' '.$errtext;
}
return ($result,undef,[$msg],$lockerr{$prefix});
}
if ($lockerr{$prefix}) {
$lockerrors = $lockerr{$prefix};
}
}
}
$title = &LONCAPA::map::qtunescape($title);
my $ext='false';
if ($url=~m{^http(|s)://}) { $ext='true'; }
$url = &LONCAPA::map::qtunescape($url);
# For uploaded files (excluding pages/sequences) path in copied file is changed
# if paste is from Main to Supplemental (or vice versa), or if pasting between
# courses.
my $newidx;
unless ($is_map) {
# Now insert the URL at the bottom
$newidx = &LONCAPA::map::getresidx($url);
if ($url =~ m{^/uploaded/$match_domain/$match_courseid/(?:docs|supplemental)/(.+)$}) {
my $relpath = $1;
if ($relpath ne '') {
my ($prefix,$subdir,$rem) = ($relpath =~ m{^(default|\d+)/(\d+)/(.+)$});
my ($newloc,$newdocsdir) = ($folder =~ /^(default|supplemental)_?(\d*)/);
my $newprefix = $newloc;
if ($newloc eq 'default') {
$newprefix = 'docs';
}
if ($newdocsdir eq '') {
$newdocsdir = 'default';
}
if (($prefixchg) ||
($srcdom ne $coursedom) || ($srcnum ne $coursenum) ||
($env{'form.docs.markedcopy_options'} ne 'move')) {
my $newpath = "$newprefix/$newdocsdir/$newidx/$rem";
$url =
&Apache::lonclonecourse::writefile($env{'request.course.id'},$newpath,
&Apache::lonnet::getfile($oldurl));
if ($url eq '/adm/notfound.html') {
return (&mt('Paste failed: an error occurred saving the file.'));
} else {
my ($newsubpath) = ($newpath =~ m{^(.*/)[^/]*$});
$newsubpath =~ s{/+$}{/};
$docmoves{$oldurl} = $newsubpath;
}
}
}
}
}
# Apply any changes to maps, or copy dependencies for uploaded HTML pages
my ($result,$save_err);
my %updated = (
rewrites => \%rewrites,
zombies => \%zombies,
removefrommap => \%removefrommap,
removeparam => \%removeparam,
dbcopies => \%dbcopies,
retitles => \%retitles,
);
my %info = (
newsubdir => \%newsubdir,
params => \%params,
before => \%before,
after => \%after,
);
my %moves = (
copies => \%copies,
docmoves => \%docmoves,
mapmoves => \%mapmoves,
);
($result,my $msgsarray,my $lockerror) =
&apply_fixups($folder,$is_map,$coursedom,$coursenum,$errors,
\%updated,\%info,\%moves,$prefixchg,$oldurl,$url,'paste');
$lockerrors .= $lockerror;
if ($result eq 'ok') {
if ($is_map) {
my ($errtext,$fatal) = &mapread($coursenum,$coursedom,
$folder.'.'.$container);
return ($errtext,$save_err,$msgsarray,$lockerrors) if ($fatal);
if ($#LONCAPA::map::order<1) {
my $idx=&LONCAPA::map::getresidx();
if ($idx<=0) { $idx=1; }
$LONCAPA::map::order[0]=$idx;
$LONCAPA::map::resources[$idx]='';
}
$newidx = &LONCAPA::map::getresidx($url);
}
if ($env{'docs.markedcopy_supplemental'}) {
if ($folder !~ /^supplemental/) {
(undef,undef,$title) =
&Apache::loncommon::parse_supplemental_title($env{'docs.markedcopy_supplemental'});
}
} else {
if ($folder=~/^supplemental/) {
$title=time.'___&&&___'.$env{'user.name'}.'___&&&___'.
$env{'user.domain'}.'___&&&___'.$title;
}
}
$LONCAPA::map::resources[$newidx]= $title.':'.$url.':'.$ext.':normal:res';
push(@LONCAPA::map::order, $newidx);
# Store the result
my ($errtext,$fatal) =
&storemap($coursenum,$coursedom,$folder.'.'.$container,1);
if ($fatal) {
$save_err = $errtext;
}
}
if ($env{'form.docs.markedcopy_options'} eq 'move') {
&Apache::lonnet::delenv('docs.markedcopy');
&Apache::lonnet::delenv('docs.markedcopy_nested');
&Apache::lonnet::delenv('docs.markedcopy_nestednames');
}
return ($result,$save_err,$msgsarray,$lockerrors);
}
sub get_newmap_url {
my ($url,$folder,$prefixchg,$coursedom,$coursenum,$srcdom,$srcnum,
$titleref,$allmaps,$newurls) = @_;
my $newurl;
if ($url=~ m{^/uploaded/}) {
$$titleref=&mt('Copy of').' '.$$titleref;
}
my $now = time;
my $suffix=$$.int(rand(100)).$now;
my ($oldid,$ext) = ($url=~/^(.+)\.(\w+)$/);
if ($oldid =~ m{^(/uploaded/$match_domain/$match_courseid/)(\D+)(\d+)$}) {
my $path = $1;
my $prefix = $2;
my $ancestor = $3;
if (length($ancestor) > 10) {
$ancestor = substr($ancestor,-10,10);
}
my $newid;
if ($prefixchg) {
if ($folder =~ /^supplemental/) {
$prefix =~ s/^default/supplemental/;
} else {
$prefix =~ s/^supplemental/default/;
}
}
if (($srcdom eq $coursedom) && ($srcnum eq $coursenum)) {
$newurl = $path.$prefix.$ancestor.$suffix.'.'.$ext;
} else {
$newurl = "/uploaded/$coursedom/$coursenum/$prefix".$now.'.'.$ext;
}
my $counter = 0;
my $is_unique = &uniqueness_check($newurl);
if ($folder =~ /^default/) {
if ($allmaps->{$newurl}) {
$is_unique = 0;
}
}
while ((!$is_unique || $allmaps->{$newurl} || $newurls->{$newurl}) && ($counter < 100)) {
$counter ++;
$suffix ++;
if (($srcdom eq $coursedom) && ($srcnum eq $coursenum)) {
$newurl = $path.$prefix.$ancestor.$suffix.'.'.$ext;
} else {
$newurl = "/uploaded/$coursedom/$coursenum/$prefix".$ancestor.$suffix.'.'.$ext;
}
$is_unique = &uniqueness_check($newurl);
}
if ($is_unique) {
$newurls->{$newurl} = 1;
} else {
if ($url=~/\.page$/) {
return (undef,&mt('Paste failed: an error occurred creating a unique URL for the composite page'));
} else {
return (undef,&mt('Paste failed: an error occurred creating a unique URL for the folder'));
}
}
}
return ($newurl);
}
sub dbcopy {
my ($dbref,$coursedom,$coursenum,$lockerrorsref) = @_;
my ($url,$result,$errtext);
my $url = $dbref->{'src'};
if (ref($dbref) eq 'HASH') {
if ($url =~ m{/(smppg|bulletinboard)$}) {
my $prefix = $1;
if (($dbref->{'cdom'} =~ /^$match_domain$/) &&
($dbref->{'cnum'} =~ /^$match_courseid$/)) {
my $db_name;
my $marker = (split(m{/},$url))[4];
$marker=~s/\D//g;
if ($dbref->{'src'} =~ m{/smppg$}) {
$db_name =
&Apache::lonsimplepage::get_db_name($url,$marker,
$dbref->{'cdom'},
$dbref->{'cnum'});
} else {
$db_name = 'bulletinpage_'.$marker;
}
my ($suffix,$freedlock,$error) =
&Apache::lonnet::get_timebased_id($prefix,'num','templated',
$coursedom,$coursenum,
'concat');
if (!$suffix) {
if ($prefix eq 'smppg') {
$errtext = &mt('Failed to acquire a unique timestamp-based suffix when copying a simple page [_1].',$url);
} else {
$errtext = &mt('Failed to acquire a unique timestamp-based suffix when copying a bulletin board [_1].',$url);
}
if ($error) {
$errtext .= ' '.$error;
}
} else {
#need to copy the db contents to a new one.
my %contents=&Apache::lonnet::dump($db_name,
$dbref->{'cdom'},
$dbref->{'cnum'});
if (exists($contents{'uploaded.photourl'})) {
my $photo = $contents{'uploaded.photourl'};
my ($subdir,$fname) =
($photo =~ m{^/uploaded/$match_domain/$match_courseid/+(bulletin|simplepage)/(?:|\d+/)([^/]+)$});
my $newphoto;
if ($fname ne '') {
my $content = &Apache::lonnet::getfile($photo);
unless ($content eq '-1') {
$env{'form.'.$suffix.'.photourl'} = $content;
$newphoto =
&Apache::lonnet::finishuserfileupload($coursenum,$coursedom,$suffix.'.photourl',"$subdir/$suffix/$fname");
delete($env{'form.'.$suffix.'.photourl'});
}
}
if ($newphoto =~ m{^/uploaded/}) {
$contents{'uploaded.photourl'} = $newphoto;
}
}
$db_name =~ s{_\d*$ }{_$suffix}x;
$result=&Apache::lonnet::put($db_name,\%contents,
$coursedom,$coursenum);
if ($result eq 'ok') {
$url =~ s{/(\d*)/(smppg|bulletinboard)$}{/$suffix/$2}x;
}
}
if (($freedlock ne 'ok') && (ref($lockerrorsref) eq 'HASH')) {
$lockerrorsref->{$prefix} =
'
'.
&mt('There was a problem removing a lockfile.');
if ($prefix eq 'smppg') {
$lockerrorsref->{$prefix} .=
&mt('This will prevent creation of additional simple pages in this course.');
} else {
$lockerrorsref->{$prefix} .= &mt('This will prevent creation of additional bulletin boards in this course.');
}
$lockerrorsref->{$prefix} .= &mt('Please contact the domain coordinator for your LON-CAPA domain.').'
');
}
if ($save_error ne '') {
return $save_error;
}
if ($paste_res ne 'ok') {
$r->print('
'.$paste_res.'
');
}
if (keys(%paste_errors) > 0) {
$r->print('
'."\n".
&mt('The following files are either dependencies of a web page or references within a folder and/or composite page which could not be copied during the paste operation:')."\n".
'
'."\n");
foreach my $key (sort(keys(%paste_errors))) {
$r->print('
'.$key.'
'."\n");
}
$r->print('
'."\n");
}
}
$r->print($upload_output);
if (&handle_edit_cmd()) {
my $contentchg;
if ($env{'form.cmd'} =~ /^(del|cut)_/) {
$contentchg = 1;
}
($errtext,$fatal)=&storemap($coursenum,$coursedom,$folder.'.'.$container,$contentchg);
return $errtext if ($fatal);
}
# Group import/search
if ($env{'form.importdetail'}) {
my @imports;
foreach my $item (split(/\&/,$env{'form.importdetail'})) {
if (defined($item)) {
my ($name,$url,$residx)=
map { &unescape($_); } split(/\=/,$item);
if ($url =~ m{^\Q/uploaded/$coursedom/$coursenum/\E(default|supplemental)_new\.(sequence|page)$}) {
my ($suffix,$errortxt,$locknotfreed) =
&new_timebased_suffix($coursedom,$coursenum,'map',$1,$2);
if ($locknotfreed) {
$r->print($locknotfreed);
}
if ($suffix) {
$url =~ s/_new\./_$suffix./;
} else {
return $errortxt;
}
} elsif ($url =~ m{^/adm/$match_domain/$match_username/new/(smppg|bulletinboard)$}) {
my $type = $1;
my ($suffix,$errortxt,$locknotfreed) =
&new_timebased_suffix($coursedom,$coursenum,$type);
if ($locknotfreed) {
$r->print($locknotfreed);
}
if ($suffix) {
$url =~ s{^(/adm/$match_domain/$match_username)/new}{$1/$suffix};
} else {
return $errortxt;
}
} elsif ($url =~ m{^/uploaded/$coursedom/$coursenum/(docs|supplemental)/(default|\d+)/new.html$}) {
if ($supplementalflag) {
next unless ($1 eq 'supplemental');
if ($folder eq 'supplemental') {
next unless ($2 eq 'default');
} else {
next unless ($folder eq 'supplemental_'.$2);
}
} else {
next unless ($1 eq 'docs');
if ($folder eq 'default') {
next unless ($2 eq 'default');
} else {
next unless ($folder eq 'default_'.$2);
}
}
}
push(@imports, [$name, $url, $residx]);
}
}
($errtext,$fatal,my $fixuperrors) =
&group_import($coursenum, $coursedom, $folder,$container,
'londocs',@imports);
return $errtext if ($fatal);
if ($fixuperrors) {
$r->print($fixuperrors);
}
}
# Loading a complete map
if ($env{'form.loadmap'}) {
if ($env{'form.importmap'}=~/\w/) {
foreach my $res (&Apache::lonsequence::attemptread(&Apache::lonnet::filelocation('',$env{'form.importmap'}))) {
my ($title,$url,$ext,$type)=split(/\:/,$res);
my $idx=&LONCAPA::map::getresidx($url);
$LONCAPA::map::resources[$idx]=$res;
$LONCAPA::map::order[$#LONCAPA::map::order+1]=$idx;
}
($errtext,$fatal)=&storemap($coursenum,$coursedom,
$folder.'.'.$container,1);
return $errtext if ($fatal);
} else {
$r->print('
'.&mt('No map selected.').'
');
}
}
&log_differences($plain);
}
# ---------------------------------------------------------------- End commands
# ---------------------------------------------------------------- Print screen
my $idx=0;
my $shown=0;
if (($ishidden) || ($isencrypted) || ($randompick>=0) || ($is_random_order)) {
$r->print('
'
.&mt('Caution: this folder is set to randomly pick a subset'
.' of resources. Adding or removing resources from this'
.' folder will change the set of resources that the'
.' students see, resulting in spurious or missing credit'
.' for completed problems, not limited to ones you'
.' modify. Do not modify the contents of this folder if'
.' it is in active student use.')
.'
'
);
}
if ($is_random_order) {
$r->print('
'
.&mt('Caution: this folder is set to randomly order its'
.' contents. Adding or removing resources from this folder'
.' will change the order of resources shown.')
.'
'
);
}
$r->print('
');
}
my ($to_show,$output,@allidx,@allmapidx);
&Apache::loncommon::start_data_table_count(); #setup a row counter
foreach my $res (@LONCAPA::map::order) {
my ($name,$url)=split(/\:/,$LONCAPA::map::resources[$res]);
$name=&LONCAPA::map::qtescape($name);
$url=&LONCAPA::map::qtescape($url);
unless ($name) { $name=(split(/\//,$url))[-1]; }
unless ($name) { $idx++; next; }
push(@allidx,$res);
if ($url =~ m{/uploaded/.+\.(page|sequence)$}) {
push(@allmapidx,$res);
}
$output .= &entryline($idx,$name,$url,$folder,$allowed,$res,
$coursenum,$coursedom,$crstype,
$pathitem,$supplementalflag,$container);
$idx++;
$shown++;
}
&Apache::loncommon::end_data_table_count();
if (($allowed) || ($supplementalflag && $folder eq 'supplemental')) {
my $toolslink = '
'
}
}
my $tid = 1;
if ($supplementalflag) {
$tid = 2;
}
if ($allowed) {
my $readfile="/uploaded/$coursedom/$coursenum/$folder.$container";
$r->print(&generate_edit_table($tid,$orderhash,$to_show,$iconpath,$jumpto,
$readfile));
&print_paste_buffer($r,$container,$folder,$coursedom,$coursenum);
} else {
$r->print($to_show);
}
return;
}
sub process_file_upload {
my ($upload_output,$coursenum,$coursedom,$allfiles,$codebase,$uploadcmd) = @_;
# upload a file, if present
my ($parseaction,$showupload,$nextphase,$mimetype);
if ($env{'form.parserflag'}) {
$parseaction = 'parse';
}
my $folder=$env{'form.folder'};
if ($folder eq '') {
$folder='default';
}
if ( ($folder=~/^$uploadcmd/) || ($uploadcmd eq 'default') ) {
my $errtext='';
my $fatal=0;
my $container='sequence';
if ($env{'form.folderpath'} =~ /:1$/) {
$container='page';
}
($errtext,$fatal)=
&mapread($coursenum,$coursedom,$folder.'.'.$container);
if ($#LONCAPA::map::order<1) {
$LONCAPA::map::order[0]=1;
$LONCAPA::map::resources[1]='';
}
my $destination = 'docs/';
if ($folder =~ /^supplemental/) {
$destination = 'supplemental/';
}
if (($folder eq 'default') || ($folder eq 'supplemental')) {
$destination .= 'default/';
} elsif ($folder =~ /^(default|supplemental)_(\d+)$/) {
$destination .= $2.'/';
}
if ($fatal) {
$$upload_output = '
'.&mt('The uploaded file has not been stored as an error occurred reading the contents of the current folder.').'
';
return;
}
# this is for a course, not a user, so set context to coursedoc.
my $newidx=&LONCAPA::map::getresidx();
$destination .= $newidx;
my $url=&Apache::lonnet::userfileupload('uploaddoc','coursedoc',$destination,
$parseaction,$allfiles,
$codebase,undef,undef,undef,undef,
undef,undef,\$mimetype);
if ($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E.*/([^/]+)$}) {
my $stored = $1;
$showupload = '
'.
&mt('It is recommended that you use an up-to-date virus scanner before handling this file.')."
".
&entryline(0,&mt("Click to download or use your browser's Save Link function"),$showdoc).'
');
}
}
$r->print(&Apache::loncommon::end_page());
return OK;
}
sub embedded_form_elems {
my ($phase,$primaryurl,$newidx) = @_;
my $folderpath = &HTML::Entities::encode($env{'form.folderpath'},'<>&"');
return <
STATE
}
sub embedded_destination {
my $folder=$env{'form.folder'};
my $destination = 'docs/';
if ($folder =~ /^supplemental/) {
$destination = 'supplemental/';
}
if (($folder eq 'default') || ($folder eq 'supplemental')) {
$destination .= 'default/';
} elsif ($folder =~ /^(default|supplemental)_(\d+)$/) {
$destination .= $2.'/';
}
$destination .= $env{'form.newidx'};
my $dir_root = '/userfiles';
return ($destination,$dir_root);
}
sub return_to_editor {
my $actionurl = '/adm/coursedocs';
return '
'."\n".
''."\n".
''.&mt('Return to Editor').
'';
}
sub decompression_info {
my ($destination,$dir_root) = &embedded_destination();
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $container='sequence';
my ($pathitem,$hiddenelem);
my @hiddens = ('newidx','comment','position','folderpath');
if ($env{'form.folderpath'} =~ /\:1$/) {
$container='page';
}
unshift(@hiddens,$pathitem);
foreach my $item (@hiddens) {
if ($env{'form.'.$item}) {
$hiddenelem .= ''."\n";
}
}
return ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,
$hiddenelem);
}
sub decompression_phase_one {
my ($dir,$file,$warning,$error,$output);
my ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,$hiddenelem)=
&decompression_info();
if ($env{'form.archiveurl'} !~ m{^/uploaded/\Q$docudom/$docuname/\E(?:docs|supplemental)/(?:default|\d+).*/([^/]+)$}) {
$error = &mt('Archive file "[_1]" not in the expected location.',$env{'form.archiveurl'});
} else {
my $file = $1;
$output =
&Apache::loncommon::process_decompression($docudom,$docuname,$file,
$destination,$dir_root,
$hiddenelem);
if ($env{'form.autoextract_camtasia'}) {
$output .= &remove_archive($docudom,$docuname,$container);
}
}
if ($error) {
$output .= '
'.&mt('Not extracted.').' '.
$error.'
'."\n";
}
if ($warning) {
$output .= '
'.$warning.'
'."\n";
}
return $output;
}
sub decompression_phase_two {
my ($destination,$dir_root,$londocroot,$docudom,$docuname,$container,$hiddenelem)=
&decompression_info();
my $output;
if ($env{'form.archivedelete'}) {
$output = &remove_archive($docudom,$docuname,$container);
}
$output .=
&Apache::loncommon::process_extracted_files('coursedocs',$docudom,$docuname,
$destination,$dir_root,$hiddenelem);
return $output;
}
sub remove_archive {
my ($docudom,$docuname,$container) = @_;
my $map = $env{'form.folder'}.'.'.$container;
my ($output,$delwarning,$delresult,$url);
my ($errtext,$fatal) = &mapread($docuname,$docudom,$map);
if ($fatal) {
if ($container eq 'page') {
$delwarning = &mt('An error occurred retrieving the contents of the current page.');
} else {
$delwarning = &mt('An error occurred retrieving the contents of the current folder.');
}
$delwarning .= &mt('As a result the archive file has not been removed.');
} else {
my $currcmd = $env{'form.cmd'};
my $position = $env{'form.position'};
if ($position > 0) {
$env{'form.cmd'} = 'del_'.$position;
my ($title,$url,@rrest) =
split(/:/,$LONCAPA::map::resources[$LONCAPA::map::order[$position]]);
if (&handle_edit_cmd($docuname,$docudom)) {
($errtext,$fatal) = &storemap($docuname,$docudom,$map,1);
if ($fatal) {
if ($container eq 'page') {
$delwarning = &mt('An error occurred updating the contents of the current page.');
} else {
$delwarning = &mt('An error occurred updating the contents of the current folder.');
}
} else {
$delresult = &mt('Archive file removed.');
}
}
}
$env{'form.cmd'} = $currcmd;
}
if ($delwarning) {
$output = '
'.
$delwarning.
'
';
}
if ($delresult) {
$output .= '
'.
$delresult.
'
';
}
return $output;
}
sub generate_admin_menu {
my ($crstype) = @_;
my $lc_crstype = lc($crstype);
my ($home,$other,%outhash)=&authorhosts();
my %lt=&Apache::lonlocal::texthash (
'vc' => 'Verify Content',
'cv' => 'Check/Set Resource Versions',
'ls' => 'List Resource Identifiers',
'imse' => 'Export contents to IMS Archive',
'dcd' => "Dump $crstype Content to Authoring Space",
);
my ($candump,$dumpurl);
if ($home + $other > 0) {
$candump = 'F';
if ($home) {
$dumpurl = "javascript:injectData(document.courseverify,'dummy','dumpcourse','$lt{'dcd'}')";
} else {
my @hosts;
foreach my $aurole (keys(%outhash)) {
unless(grep(/^\Q$outhash{$aurole}\E/,@hosts)) {
push(@hosts,$outhash{$aurole});
}
}
if (@hosts == 1) {
my $switchto = '/adm/switchserver?otherserver='.$hosts[0].
'&role='.
&HTML::Entities::encode($env{'request.role'},'"<>&').'&origurl='.
&HTML::Entities::encode('/adm/coursedocs?dumpcourse=1','"<>&');
$dumpurl = "javascript:dump_needs_switchserver('$switchto')";
} else {
$dumpurl = "javascript:choose_switchserver_window()";
}
}
}
my @menu=
({ categorytitle=>'Administration',
items =>[
{ linktext => $lt{'vc'},
url => "javascript:injectData(document.courseverify,'dummy','verify','$lt{'vc'}')",
permission => 'F',
help => 'Verify_Content',
icon => 'verify.png',
linktitle => 'Verify contents can be retrieved/rendered',
},
{ linktext => $lt{'cv'},
url => "javascript:injectData(document.courseverify,'dummy','versions','$lt{'cv'}')",
permission => 'F',
help => 'Check_Resource_Versions',
icon => 'resversion.png',
linktitle => "View version information for resources in your $lc_crstype, and fix/unfix use of specific versions",
},
{ linktext => $lt{'ls'},
url => "javascript:injectData(document.courseverify,'dummy','listsymbs','$lt{'ls'}')",
permission => 'F',
#help => '',
icon => 'symbs.png',
linktitle => "List the unique identifier used for each resource instance in your $lc_crstype"
},
]
},
{ categorytitle=>'Export',
items =>[
{ linktext => $lt{'imse'},
url => "javascript:injectData(document.courseverify,'dummy','exportcourse','$lt{'imse'}')",
permission => 'F',
help => 'Docs_Export_Course_Docs',
icon => 'imsexport.png',
linktitle => $lt{'imse'},
},
{ linktext => $lt{'dcd'},
url => $dumpurl,
permission => $candump,
#help => '',
icon => 'dump.png',
linktitle => $lt{'dcd'},
},
]
});
return '
';
}
sub generate_edit_table {
my ($tid,$orderhash_ref,$to_show,$iconpath,$jumpto,$readfile) = @_;
return unless(ref($orderhash_ref) eq 'HASH');
my %orderhash = %{$orderhash_ref};
my $form;
my $activetab;
my $active;
if (($env{'form.active'} ne '') && ($env{'form.active'} ne 'aa')) {
$activetab = $env{'form.active'};
}
my $backicon = $iconpath.'clickhere.gif';
my $backtext = &mt('Exit Editor');
$form = '