# The LearningOnline Network
# Documents
#
# $Id: londocs.pm,v 1.539 2013/04/01 19:39:13 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'; }
$name = &LONCAPA::map::qtunescape($name);
if ($name eq '') {
$name = &LONCAPA::map::qtunescape(&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);
}
}
$url = &LONCAPA::map::qtunescape($url);
$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.' Content').':::::');
}
$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('
';
return $output;
}
sub recurse_print {
my ($outputref,$dir,$deps,$display) = @_;
$$outputref .= $display->{$dir}."\n";
if (ref($deps->{$dir}) eq 'ARRAY') {
foreach my $subdir (@{$deps->{$dir}}) {
&recurse_print($outputref,$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 Options',
hide => 'Hide Options',
);
return <<"END";
function showPasteOptions(suffix) {
document.getElementById('pasteoptions_'+suffix).style.display='block';
document.getElementById('pasteoptionstext_'+suffix).innerHTML = ' $lt{'hide'}';
return;
}
function hidePasteOptions(suffix) {
document.getElementById('pasteoptions_'+suffix).style.display='none';
document.getElementById('pasteoptionstext_'+suffix).innerHTML =' $lt{'show'}';
return;
}
function showOptions(caller,suffix) {
if (document.getElementById('pasteoptionstext_'+suffix)) {
if (caller.checked) {
document.getElementById('pasteoptionstext_'+suffix).innerHTML =' $lt{'show'}';
} else {
document.getElementById('pasteoptionstext_'+suffix).innerHTML ='';
}
if (document.getElementById('pasteoptions_'+suffix)) {
document.getElementById('pasteoptions_'+suffix).style.display='none';
}
}
return;
}
END
}
sub do_paste_from_buffer {
my ($coursenum,$coursedom,$folder,$container,$errors) = @_;
# Array of items in paste buffer
my (@currpaste,%pastebuffer,%allerrors);
@currpaste = split(/,/,$env{'docs.markedcopies'});
# Early out if paste buffer is empty
if (@currpaste == 0) {
return ();
}
map { $pastebuffer{$_} = 1; } @currpaste;
# Array of items selected items to paste
my @reqpaste = &Apache::loncommon::get_env_multiple('form.pasting');
# Early out if nothing selected to paste
if (@reqpaste == 0) {
return();
}
my @topaste;
foreach my $suffix (@reqpaste) {
next if ($suffix =~ /\D/);
next unless (exists($pastebuffer{$suffix}));
push(@topaste,$suffix);
}
# Early out if nothing available to paste
if (@topaste == 0) {
return();
}
my (%msgs,%before,%after,@dopaste,%is_map,%notinsupp,%notincrs,%duplicate,
%prefixchg,%srcdom,%srcnum,%marktomove,$save_err,$lockerrors,$allresult,
%msgs);
foreach my $suffix (@topaste) {
my $url=&LONCAPA::map::qtescape($env{'docs.markedcopy_url_'.$suffix});
# 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($url)) {
$notinsupp{$suffix} = 1;
next;
}
}
if ($url =~ m{^/uploaded/($match_domain)/($match_courseid)/}) {
my $srcd = $1;
my $srcn = $2;
# 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 (($srcd ne $coursedom) || ($srcn ne $coursenum)) {
unless ($env{"user.priv.cm./$srcd/$srcn"} =~ /\Q:mdc&F\E/) {
$notincrs{$suffix} = 1;
next;
}
}
$srcdom{$suffix} = $srcd;
$srcnum{$suffix} = $srcn;
}
push(@dopaste,$suffix);
if ($url=~/\.(page|sequence)$/) {
$is_map{$suffix} = 1;
}
if ($url =~ m{^/uploaded/$match_domain/$match_courseid/([^/]+)}) {
my $oldprefix = $1;
# 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{$suffix} = 'docstosupp';
} elsif (($folder =~ /^default/) && ($oldprefix =~ /^supplemental/)) {
$prefixchg{$suffix} = 'supptodocs';
}
# If pasting an uploaded map, get list of contained uploaded maps.
if ($env{'docs.markedcopy_nested_'.$suffix}) {
my @nested;
my ($type) = ($oldprefix =~ /^(default|supplemental)/);
my @items = split(/\&/,$env{'docs.markedcopy_nested_'.$suffix});
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_'.$suffix.'_'.$item} eq 'move') {
push(@{$marktomove{$suffix}},$type.'_'.$item);
}
}
}
}
}
# Early out if nothing available to paste
if (@dopaste == 0) {
return ();
}
# Populate message hash and hashes used for main content <=> supplemental content
# changes
%msgs = &Apache::lonlocal::texthash (
notinsupp => 'Paste failed: content type is not supported within Supplemental Content',
notincrs => 'Paste failed: Item is from a different course which you do not have rights to edit.',
duplicate => 'Paste failed: only one instance of a particular published sequence or page is allowed within each course.',
);
%before = (
docstosupp => {
map => 'default',
doc => 'docs',
},
supptodocs => {
map => 'supplemental',
doc => 'supplemental',
},
);
%after = (
docstosupp => {
map => 'supplemental',
doc => 'supplemental'
},
supptodocs => {
map => 'default',
doc => 'docs',
},
);
# Retrieve information about all course maps in main content area
my $allmaps = {};
if ($folder =~ /^default/) {
$allmaps =
&Apache::loncommon::allmaps_incourse($coursedom,$coursenum,
$env{"course.$env{'request.course.id'}.home"},
$env{'request.course.id'});
}
my (@toclear,%mapurls,%lockerrs,%msgerrs,%results);
# Loop over the items to paste
foreach my $suffix (@dopaste) {
# Maps need to be copied first
my (%removefrommap,%removeparam,%addedmaps,%rewrites,%retitles,%copies,
%dbcopies,%zombies,%params,%docmoves,%mapmoves,%mapchanges,%newsubdir,
%newurls,%tomove);
if (ref($marktomove{$suffix}) eq 'ARRAY') {
map { $tomove{$_} = 1; } @{$marktomove{$suffix}};
}
my $url=&LONCAPA::map::qtescape($env{'docs.markedcopy_url_'.$suffix});
my $title=&LONCAPA::map::qtescape($env{'docs.markedcopy_title_'.$suffix});
my $oldurl = $url;
if ($is_map{$suffix}) {
# If pasting a map, check if map contains other maps
my (%hierarchy,%titles);
&contained_map_check($url,$folder,\%removefrommap,\%removeparam,
\%addedmaps,\%hierarchy,\%titles,$allmaps);
if ($url=~ m{^/uploaded/}) {
my $newurl;
unless ($env{'form.docs.markedcopy_options_'.$suffix} eq 'move') {
($newurl,my $error) =
&get_newmap_url($url,$folder,$prefixchg{$suffix},$coursedom,
$coursenum,$srcdom{$suffix},$srcnum{$suffix},
\$title,$allmaps,\%newurls);
if ($error) {
$allerrors{$suffix} = $error;
next;
}
if ($newurl ne '') {
if ($newurl ne $url) {
if ($newurl =~ /(?:default|supplemental)_(\d+).(?:sequence|page)$/) {
$newsubdir{$url} = $1;
}
$mapchanges{$url} = 1;
}
}
}
if (($srcdom{$suffix} ne $coursedom) ||
($srcnum{$suffix} ne $coursenum) ||
($prefixchg{$suffix}) || (($newurl ne '') && ($newurl ne $url))) {
unless (&url_paste_fixups($url,$folder,$prefixchg{$suffix},
$coursedom,$coursenum,$srcdom{$suffix},
$srcnum{$suffix},$allmaps,\%rewrites,
\%retitles,\%copies,\%dbcopies,
\%zombies,\%params,\%mapmoves,
\%mapchanges,\%tomove,\%newsubdir,
\%newurls)) {
$mapmoves{$url} = 1;
}
$url = $newurl;
} elsif ($env{'docs.markedcopy_nested_'.$suffix}) {
&url_paste_fixups($url,$folder,$prefixchg{$suffix},$coursedom,
$coursenum,$srcdom{$suffix},$srcnum{$suffix},
$allmaps,\%rewrites,\%retitles,\%copies,\%dbcopies,
\%zombies,\%params,\%mapmoves,\%mapchanges,
\%tomove,\%newsubdir,\%newurls);
}
} elsif ($url=~m {^/res/}) {
# published map can only exists once, so remove from paste buffer when done
push(@toclear,$suffix);
# if pasting published map (main content area only) check map not already in course
if ($folder =~ /^default/) {
if ((ref($allmaps) eq 'HASH') && ($allmaps->{$url})) {
$duplicate{$suffix} = 1;
next;
}
}
}
}
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,
);
unless ($env{'form.docs.markedcopy_options_'.$suffix} eq 'move') {
my (%lockerr,$msg);
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;
}
$results{$suffix} = $result;
$msgerrs{$suffix} = $msg;
$lockerrs{$suffix} = $lockerr{$prefix};
next;
}
if ($lockerr{$prefix}) {
$lockerrs{$suffix} = $lockerr{$prefix};
}
}
}
$title = &LONCAPA::map::qtunescape($title);
my $ext='false';
if ($url=~m{^http(|s)://}) { $ext='true'; }
if ($env{'docs.markedcopy_supplemental_'.$suffix}) {
if ($folder !~ /^supplemental/) {
(undef,undef,$title) =
&Apache::loncommon::parse_supplemental_title($env{'docs.markedcopy_supplemental_'.$suffix});
}
} else {
if ($folder=~/^supplemental/) {
$title=time.'___&&&___'.$env{'user.name'}.'___&&&___'.
$env{'user.domain'}.'___&&&___'.$title;
}
}
# 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.
unless ($is_map{$suffix}) {
my $newidx;
# Now insert the URL at the bottom
$newidx = &LONCAPA::map::getresidx(&LONCAPA::map::qtunescape($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{$suffix}) ||
($srcdom{$suffix} ne $coursedom) ||
($srcnum{$suffix} ne $coursenum) ||
($env{'form.docs.markedcopy_options_'.$suffix} 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') {
$msgs{$suffix} = &mt('Paste failed: an error occurred saving the file.');
next;
} else {
my ($newsubpath) = ($newpath =~ m{^(.*/)[^/]*$});
$newsubpath =~ s{/+$}{/};
$docmoves{$oldurl} = $newsubpath;
}
}
}
}
$LONCAPA::map::resources[$newidx]=$title.':'.&LONCAPA::map::qtunescape($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;
$allresult = 'fail';
}
}
# Apply any changes to maps, or copy dependencies for uploaded HTML pages
unless ($allresult eq 'fail') {
my %updated = (
rewrites => \%rewrites,
zombies => \%zombies,
removefrommap => \%removefrommap,
removeparam => \%removeparam,
dbcopies => \%dbcopies,
retitles => \%retitles,
);
my %info = (
newsubdir => \%newsubdir,
params => \%params,
);
if ($prefixchg{$suffix}) {
$info{'before'} = $before{$prefixchg{$suffix}};
$info{'after'} = $after{$prefixchg{$suffix}};
}
my %moves = (
copies => \%copies,
docmoves => \%docmoves,
mapmoves => \%mapmoves,
);
(my $result,$msgs{$suffix},my $lockerror) =
&apply_fixups($folder,$is_map{$suffix},$coursedom,$coursenum,$errors,
\%updated,\%info,\%moves,$prefixchg{$suffix},$oldurl,
$url,'paste');
$lockerrors .= $lockerror;
if ($result eq 'ok') {
if ($is_map{$suffix}) {
my ($errtext,$fatal) = &mapread($coursenum,$coursedom,
$folder.'.'.$container);
if ($fatal) {
$allresult = 'failread';
} else {
if ($#LONCAPA::map::order<1) {
my $idx=&LONCAPA::map::getresidx();
if ($idx<=0) { $idx=1; }
$LONCAPA::map::order[0]=$idx;
$LONCAPA::map::resources[$idx]='';
}
my $newidx = &LONCAPA::map::getresidx(&LONCAPA::map::qtunescape($url));
$LONCAPA::map::resources[$newidx]=$title.':'.&LONCAPA::map::qtunescape($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;
$allresult = 'failstore';
}
}
}
if ($env{'form.docs.markedcopy_options_'.$suffix} eq 'move') {
push(@toclear,$suffix);
}
}
}
}
&clear_from_buffer(\@toclear,\@currpaste);
my $msgsarray;
foreach my $suffix (keys(%msgs)) {
if (ref($msgs{$suffix}) eq 'ARRAY') {
$msgsarray .= join(',',@{$msgs{$suffix}});
}
}
return ($allresult,$save_err,$msgsarray,$lockerrors);
}
sub do_buffer_empty {
my @currpaste = split(/,/,$env{'docs.markedcopies'});
if (@currpaste == 0) {
return &mt('Clipboard is already empty');
}
my @toclear = &Apache::loncommon::get_env_multiple('form.pasting');
if (@toclear == 0) {
return &mt('Nothing selected to clear from clipboard');
}
my $numdel = &clear_from_buffer(\@toclear,\@currpaste);
if ($numdel) {
return &mt('[quant,_1,item] cleared from clipboard',$numdel);
} else {
return &mt('Clipboard unchanged');
}
return;
}
sub clear_from_buffer {
my ($toclear,$currpaste) = @_;
return unless ((ref($toclear) eq 'ARRAY') && (ref($currpaste) eq 'ARRAY'));
my %pastebuffer;
map { $pastebuffer{$_} = 1; } @{$currpaste};
my $numdel = 0;
foreach my $suffix (@{$toclear}) {
next if ($suffix =~ /\D/);
next unless (exists($pastebuffer{$suffix}));
my $regexp = 'docs.markedcopy_[a-z]+_'.$suffix;
if (&Apache::lonnet::delenv($regexp,1) eq 'ok') {
delete($pastebuffer{$suffix});
$numdel ++;
}
}
my $newbuffer = join(',',sort(keys(%pastebuffer)));
&Apache::lonnet::appenv({'docs.markedcopies' => $newbuffer});
return $numdel;
}
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");
}
} elsif ($env{'form.clearmarked'}) {
my $output = &do_buffer_empty();
if ($output) {
$r->print('
'.$output.'
');
}
}
$r->print($upload_output);
# Rename, cut, copy or remove a single resource
if (&handle_edit_cmd()) {
my $contentchg;
if ($env{'form.cmd'} =~ m{^(del|cut)_}) {
$contentchg = 1;
}
($errtext,$fatal)=&storemap($coursenum,$coursedom,$folder.'.'.$container,$contentchg);
return $errtext if ($fatal);
}
# Cut, copy and/or remove multiple resources
if ($env{'form.multichange'}) {
my %allchecked = (
cut => {},
remove => {},
);
my $needsupdate;
foreach my $which (keys(%allchecked)) {
$env{'form.multi'.$which} =~ s/,$//;
if ($env{'form.multi'.$which}) {
map { $allchecked{$which}{$_} = 1; } split(/,/,$env{'form.multi'.$which});
if (ref($allchecked{$which}) eq 'HASH') {
$needsupdate += scalar(keys(%{$allchecked{$which}}));
}
}
}
if ($needsupdate) {
my $haschanges = 0;
my %curr_groups = &Apache::longroup::coursegroups();
my $total = scalar(@LONCAPA::map::order) - 1;
for (my $i=$total; $i>=0; $i--) {
my $res = $LONCAPA::map::order[$i];
my ($name,$url)=split(/\:/,$LONCAPA::map::resources[$res]);
$name=&LONCAPA::map::qtescape($name);
$url=&LONCAPA::map::qtescape($url);
next unless ($name && $url);
my %denied =
&action_restrictions($coursenum,$coursedom,$url,
$env{'form.folderpath'},\%curr_groups);
foreach my $which (keys(%allchecked)) {
next if ($denied{$which});
next unless ($allchecked{$which}{$res});
if ($which eq 'remove') {
if (($url=~m|/+uploaded/\Q$coursedom\E/\Q$coursenum\E/|) &&
($url!~/$LONCAPA::assess_page_seq_re/)) {
&Apache::lonnet::removeuploadedurl($url);
} else {
&LONCAPA::map::makezombie($res);
}
splice(@LONCAPA::map::order,$i,1);
$haschanges ++;
} elsif ($which eq 'cut') {
&LONCAPA::map::makezombie($res);
splice(@LONCAPA::map::order,$i,1);
$haschanges ++;
}
}
}
if ($haschanges) {
($errtext,$fatal) =
&storemap($coursenum,$coursedom,$folder.'.'.$container,1);
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,%filters,%lists,%curr_groups);
%filters = (
canremove => [],
cancut => [],
cancopy => [],
);
%curr_groups = &Apache::longroup::coursegroups();
&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,
\%filters,\%curr_groups);
$idx++;
$shown++;
}
&Apache::loncommon::end_data_table_count();
my $need_save;
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,$need_save,"$folder.$container"));
&print_paste_buffer($r,$container,$folder,$coursedom,$coursenum);
} else {
$r->print($to_show);
}
return;
}
sub multiple_check_form {
my ($caller,$listsref) = @_;
return unless (ref($listsref) eq 'HASH');
my $output =
''.
'
'.
''.
'
';
return $output;
}
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,
$need_save,$copyfolder) = @_;
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 = '
'."\n";
if ($to_show ne '') {
my $saveform;
if ($need_save) {
my $button = &mt('Make changes');
my $path;
if ($env{'form.folderpath'}) {
$path =
&HTML::Entities::encode($env{'form.folderpath'},'<>&"');
}
$saveform = <<"END";
END
}
$form .= '
'.$to_show.'
'.$saveform."\n";
}
foreach my $field (keys(%orderhash)){
if($field ne '00'){
if($activetab eq '' || $activetab ne $field){
$active = 'style="display: none;float:left"';
}elsif($activetab eq $field){
$active = 'style="display:block;float:left"';
}
$form .= '