--- loncom/interface/londocs.pm 2004/11/11 22:47:55 1.149
+++ loncom/interface/londocs.pm 2023/01/20 16:30:43 1.484.2.93.2.8
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.149 2004/11/11 22:47:55 albertel Exp $
+# $Id: londocs.pm,v 1.484.2.93.2.8 2023/01/20 16:30:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,17 +30,27 @@ package Apache::londocs;
use strict;
use Apache::Constants qw(:common :http);
+use Apache::imsexport;
use Apache::lonnet;
use Apache::loncommon;
-use Apache::lonratedt;
-use Apache::lonratsrv;
+use Apache::lonhtmlcommon;
+use LONCAPA::map();
+use Apache::lonratedt();
use Apache::lonxml;
-use Apache::loncreatecourse;
+use Apache::lonclonecourse;
use Apache::lonnavmaps;
+use Apache::lonnavdisplay();
+use Apache::lonextresedit();
+use Apache::lontemplate();
+use Apache::lonsimplepage();
+use Apache::loncourserespicker();
use HTML::Entities;
+use HTML::TokeParser;
use GDBM_File;
+use File::MMagic;
use Apache::lonlocal;
use Cwd;
+use LONCAPA qw(:DEFAULT :match);
my $iconpath;
@@ -50,1214 +60,4614 @@ my $hashtied;
my %alreadyseen=();
my $hadchanges;
+my $suppchanges;
-# Available help topics
my %help=();
-# Mapread read maps into lonratedt::global arrays
-# @order and @resources, determines status
-# sets @order - pointer to resources in right order
-# sets @resources - array with the resources with correct idx
-#
sub mapread {
my ($coursenum,$coursedom,$map)=@_;
return
- &Apache::lonratedt::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
- $map);
+ &LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
+ $map);
}
sub storemap {
- my ($coursenum,$coursedom,$map)=@_;
+ my ($coursenum,$coursedom,$map,$contentchg)=@_;
+ my $report;
+ if (($contentchg) && ($map =~ /^default/)) {
+ $report = 1;
+ }
my ($outtext,$errtext)=
- &Apache::lonratedt::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
- $map,1);
+ &LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
+ $map,1,$report);
if ($errtext) { return ($errtext,2); }
-
- $hadchanges=1;
+
+ if ($map =~ /^default/) {
+ $hadchanges=1;
+ } else {
+ $suppchanges=1;
+ }
return ($errtext,0);
}
-# ----------------------------------------- Return hash with valid author names
+
sub authorhosts {
my %outhash=();
my $home=0;
my $other=0;
- foreach (keys %ENV) {
- if ($_=~/^user\.role\.(au|ca)\.(.+)$/) {
+ foreach my $key (keys(%env)) {
+ if ($key=~/^user\.role\.(au|ca)\.(.+)$/) {
my $role=$1;
my $realm=$2;
- my ($start,$end)=split(/\./,$ENV{$_});
+ my ($start,$end)=split(/\./,$env{$key});
if (($start) && ($start>time)) { next; }
if (($end) && (time>$end)) { next; }
- my $ca; my $cd;
+ my ($ca,$cd);
if ($1 eq 'au') {
- $ca=$ENV{'user.name'};
- $cd=$ENV{'user.domain'};
+ $ca=$env{'user.name'};
+ $cd=$env{'user.domain'};
} else {
- ($cd,$ca)=($realm=~/^\/(\w+)\/(\w+)$/);
+ ($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; } }
+ foreach my $id (@ids) {
+ if ($id eq $myhome) {
+ $allowed=1;
+ last;
+ }
+ }
if ($allowed) {
$home++;
- $outhash{'home_'.$ca.'@'.$cd}=1;
+ $outhash{'home_'.$ca.':'.$cd}=1;
} else {
- $outhash{'otherhome_'.$ca.'@'.$cd}=$myhome;
+ $outhash{'otherhome_'.$ca.':'.$cd}=$myhome;
$other++;
}
}
}
return ($home,$other,%outhash);
}
-# ------------------------------------------------------ Generate "dump" button
-sub dumpbutton {
- my ($home,$other,%outhash)=&authorhosts();
- if ($home+$other==0) { return ''; }
- my $output='
';
- if ($home) {
- return ' '.
- ' '.
- &Apache::loncommon::help_open_topic('Docs_Dump_Course_Docs');
+
+sub clean {
+ my ($title)=@_;
+ $title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;
+ return $title;
+}
+
+sub default_folderpath {
+ my ($coursenum,$coursedom,$navmapref) = @_;
+ return unless ($coursenum && $coursedom && ref($navmapref));
+# Check if entire course is hidden and/or encrypted
+ my ($hiddenmap,$encryptmap,$folderpath,$hiddentop);
+ my $toplevel = "uploaded/$coursedom/$coursenum/default.sequence";
+ unless (ref($$navmapref)) {
+ $$navmapref = Apache::lonnavmaps::navmap->new();
+ }
+ if (ref($$navmapref)) {
+ if (lc($$navmapref->get_mapparam(undef,$toplevel,"0.hiddenresource")) eq 'yes') {
+ my $filterFunc = sub { my $res = shift; return (!$res->randomout() && !$res->is_map()) };
+ my @resources = $$navmapref->retrieveResources($toplevel,$filterFunc,1,1);
+ unless (@resources) {
+ $hiddenmap = 1;
+ unless ($env{'request.role.adv'}) {
+ $hiddentop = 1;
+ if ($env{'form.folder'}) {
+ undef($env{'form.folder'});
+ }
+ }
+ }
+ }
+ if (lc($$navmapref->get_mapparam(undef,$toplevel,"0.encrypturl")) eq 'yes') {
+ $encryptmap = 1;
+ }
+ }
+ unless ($hiddentop) {
+ $folderpath='default&'.&escape(&mt('Main Content')).
+ '::'.$hiddenmap.':'.$encryptmap.'::';
+ }
+ if (wantarray) {
+ return ($folderpath,$hiddentop);
} else {
- return' '.
- &mt('Dump Course DOCS to Construction Space: available on other servers');
+ return $folderpath;
}
}
-# -------------------------------------------------------- Actually dump course
+sub validate_folderpath {
+ my ($supplementalflag) = @_;
+ if ($env{'form.folderpath'} ne '') {
+ my @items = split(/\&/,$env{'form.folderpath'});
+ my $badpath;
+ for (my $i=0; $i<@items; $i++) {
+ my $odd = $i%2;
+ if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
+ $badpath = 1;
+ } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
+ $badpath = 1;
+ }
+ last if ($badpath);
+ }
+ if ($badpath) {
+ delete($env{'form.folderpath'});
+ }
+ }
+ return;
+}
+
+sub validate_suppath {
+ if ($env{'form.supppath'} ne '') {
+ my @items = split(/\&/,$env{'form.supppath'});
+ my $badpath;
+ for (my $i=0; $i<@items; $i++) {
+ my $odd = $i%2;
+ if ((!$odd) && ($items[$i] !~ /^supplemental(|_\d+)$/)) {
+ $badpath = 1;
+ }
+ last if ($badpath);
+ }
+ if ($badpath) {
+ delete($env{'form.supppath'});
+ }
+ }
+ return;
+}
sub dumpcourse {
- my $r=shift;
- $r->print('Dump DOCS '.
- &Apache::loncommon::bodytag('Dump Course DOCS to Construction Space').
- ' '.
- ' '.
- &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs');
+sub print_paste_buffer {
+ my ($r,$container,$folder,$coursedom,$coursenum) = @_;
+ return if (!defined($env{'docs.markedcopies'}));
+
+ unless (($env{'form.pastemarked'}) || ($env{'form.clearmarked'})) {
+ return if ($env{'docs.markedcopies'} eq '');
+ }
+
+ my @currpaste = split(/,/,$env{'docs.markedcopies'});
+ my ($pasteitems,@pasteable);
+ my $clipboardcount = 0;
+
+# Construct identifiers for current contents of user's paste buffer
+ foreach my $suffix (@currpaste) {
+ next if ($suffix =~ /\D/);
+ my $cid = $env{'docs.markedcopy_crs_'.$suffix};
+ my $url = $env{'docs.markedcopy_url_'.$suffix};
+ my $mapidx = $env{'docs.markedcopy_map_'.$suffix};
+ if (($cid =~ /^$match_domain\_$match_courseid$/) &&
+ ($url ne '')) {
+ $clipboardcount ++;
+ my ($is_external,$othercourse,$fromsupp,$is_uploaded_map,$parent,
+ $canpaste,$nopaste,$othercrs,$areachange,$is_exttool);
+ my $extension = (split(/\./,$env{'docs.markedcopy_url_'.$suffix}))[-1];
+ if ($url =~ m{^(?:/adm/wrapper/ext|(?:http|https)(?::|:))//} ) {
+ $is_external = 1;
+ } elsif ($url =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
+ $is_exttool = 1;
+ }
+ if ($folder =~ /^supplemental/) {
+ $canpaste = &supp_pasteable($env{'docs.markedcopy_url_'.$suffix});
+ unless ($canpaste) {
+ $nopaste = &mt('Paste into Supplemental Content unavailable.');
+ }
+ } else {
+ $canpaste = 1;
+ }
+ if ($canpaste) {
+ if ($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/) {
+ $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;
+ }
+ } elsif (($url =~ m{^/res/lib/templates/\w+\.problem$}) ||
+ ($url =~ m{^/adm/($match_domain)/($match_username)/\d+/(bulletinboard|smppg|ext\.tool)$})) {
+ if ($cid ne $env{'request.course.id'}) {
+ my ($srcdom,$srcnum) = split(/_/,$cid);
+ if ($env{"user.priv.cm./$srcdom/$srcnum"} =~ /\Q:mdc&F\E/) {
+ if (($is_exttool) && ($srcdom ne $coursedom)) {
+ $canpaste = 0;
+ $nopaste = &mt('Paste from another domain unavailable.');
+ } else {
+ $othercrs = ' '.&mt('(from another course)');
+ }
+ } else {
+ $canpaste = 0;
+ $nopaste = &mt('Paste from another course unavailable.');
+ }
+ }
+ }
+ if ($canpaste) {
+ push(@pasteable,$suffix);
+ }
+ }
+ my $buffer;
+ if ($is_external) {
+ $buffer = &mt('External Resource').': '.
+ &LONCAPA::map::qtescape($env{'docs.markedcopy_title_'.$suffix}).' ('.
+ &LONCAPA::map::qtescape($url).')';
+ } elsif ($is_exttool) {
+ $buffer = &mt('External Tool').': '.
+ &LONCAPA::map::qtescape($env{'docs.markedcopy_title_'.$suffix});
+ } else {
+ my $icon = &Apache::loncommon::icon($extension);
+ if ($extension eq 'sequence' &&
+ $url =~ m{/default_\d+\.sequence$}x) {
+ $icon = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
+ $icon .= '/navmap.folder.closed.gif';
+ }
+ my $title = $env{'docs.markedcopy_title_'.$suffix};
+ if ($title eq '') {
+ ($title) = ($url =~ m{/([^/]+)$});
+ }
+ $buffer = ' '.
+ ': '.
+ &Apache::loncommon::parse_supplemental_title(
+ &LONCAPA::map::qtescape($title));
+ }
+ $pasteitems .= '';
+ my ($options,$onclick);
+ if (($canpaste) && (!$areachange) && (!$othercourse) &&
+ ($env{'docs.markedcopy_cmd_'.$suffix} eq 'cut')) {
+ if (($is_uploaded_map) ||
+ ($url =~ /(bulletinboard|smppg)$/) ||
+ ($url =~ m{^/uploaded/$coursedom/$coursenum/(?:docs|supplemental)/(.+)$})) {
+ $options = &paste_options($suffix,$is_uploaded_map,$parent);
+ $onclick= 'onclick="showOptions(this,'."'$suffix'".');" ';
+ }
+ }
+ $pasteitems .= ' '.$buffer.' ';
+ if ($nopaste) {
+ $pasteitems .= ' '.$nopaste.' ';
+ } else {
+ if ($othercrs) {
+ $pasteitems .= $othercrs;
+ }
+ if ($options) {
+ $pasteitems .= $options;
+ }
+ }
+ $pasteitems .= '
';
+ }
+ }
+ if ($pasteitems eq '') {
+ &Apache::lonnet::delenv('docs.markedcopies');
+ }
+ my ($pasteform,$form_start,$buttons,$form_end);
+ if ($pasteitems) {
+ $pasteitems .= '
';
+ $form_start = '';
+ } else {
+ $pasteitems = &mt('Clipboard is empty');
+ }
+ $r->print($form_start
+ .''
+ .''.&mt('Clipboard').(' ' x2).$buttons.' '
+ .$pasteitems
+ .' '
+ .$form_end);
}
-sub exportcourse {
- my $r=shift;
- my %discussiontime = &Apache::lonnet::dump('discussiontimes',
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
- my $numdisc = keys %discussiontime;
- my $navmap = Apache::lonnavmaps::navmap->new();
- my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);
- my $curRes;
- my $outcome;
+sub paste_options {
+ my ($suffix,$is_uploaded_map,$parent) = @_;
+ my ($copytext,$movetext);
+ if ($is_uploaded_map) {
+ $copytext = &mt('Copy to new folder');
+ $movetext = &mt('Move old');
+ } elsif ($env{'docs.markedcopy_url_'.$suffix} =~ /bulletinboard$/) {
+ $copytext = &mt('Copy to new board');
+ $movetext = &mt('Move (not posts)');
+ } elsif ($env{'docs.markedcopy_url_'.$suffix} =~ /smppg$/) {
+ $copytext = &mt('Copy to new page');
+ $movetext = &mt('Move');
+ } else {
+ $copytext = &mt('Copy to new file');
+ $movetext = &mt('Move');
+ }
+ my $output = ' '.
+ ' '.
+ ''.(' 'x 4).
+ ''.
+ ' '.
+ $copytext.' '.(' 'x2).' '.
+ '
'.
+ ' '.
+ $movetext.' ';
+ if (($is_uploaded_map) && ($env{'docs.markedcopy_nested_'.$suffix})) {
+ $output .= '
'.&mt('Folder to paste contains sub-folders').
+ ' ';
+ my @pastemaps = split(/\&/,$env{'docs.markedcopy_nested_'.$suffix});
+ my @titles = split(/\Q___&&&___\E/,$env{'docs.markedcopy_nestednames_'.$suffix});
+ my $lastdir = $parent;
+ my %depths = (
+ $lastdir => 0,
+ );
+ my (%display,%deps);
+ for (my $i=0; $i<@pastemaps; $i++) {
+ ($lastdir,my $subfolderstr) = split(/\:/,$pastemaps[$i]);
+ my ($namedir,$esctitlestr) = split(/\:/,$titles[$i]);
+ my @subfolders = split(/,/,$subfolderstr);
+ $deps{$lastdir} = \@subfolders;
+ my @subfoldertitles = map { &unescape($_); } split(/,/,$esctitlestr);
+ my $depth = $depths{$lastdir} + 1;
+ my $offset = int($depth * 4);
+ my $indent = (' ' x $offset);
+ for (my $j=0; $j<@subfolders; $j++) {
+ $depths{$subfolders[$j]} = $depth;
+ $display{$subfolders[$j]} =
+ ''.$indent.$subfoldertitles[$j].' '.
+ ''.
+ ' '.&mt('Copy to new').' '.(' ' x2).
+ ''.
+ ' '.
+ &mt('Move old').' '.
+ ' ';
+ }
+ }
+ &recurse_print(\$output,$parent,\%deps,\%display);
+ $output .= '
';
+ }
+ $output .= '
';
+ return $output;
+}
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['finishexport']);
- if ($ENV{'form.finishexport'}) {
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['archive','discussion']);
-
- my @exportitems = ();
- if (defined($ENV{'form.archive'})) {
- if (ref($ENV{'form.archive'}) eq 'ARRAY') {
- @exportitems = @{$ENV{'form.archive'}};
- } else {
- $exportitems[0] = $ENV{'form.archive'};
- }
- }
- my @discussions = ();
- if (defined($ENV{'form.discussion'})) {
- if (ref($ENV{'form.discussion'}) eq 'ARRAY') {
- @discussions = $ENV{'form.discussion'};
- } else {
- $discussions[0] = $ENV{'form.discussion'};
- }
- }
- if (@exportitems == 0 && @discussions == 0) {
- $outcome = ' As you did not select any content items or discussions for export, an IMS package has not been created. Please go back to select either content items or discussions for export';
- } else {
- my $now = time;
- my $count = 0;
- my %symbs;
- my $manifestok = 0;
- my $imsresources;
- my $tempexport;
- my $copyresult;
- my $ims_manifest = &create_ims_store($now,\$manifestok,\$outcome,\$tempexport);
- if ($manifestok) {
- &build_package($now,$navmap,\@exportitems,\@discussions,\$outcome,\$tempexport,\$copyresult,$ims_manifest);
- close($ims_manifest);
-
-#Create zip file in prtspool
- my $imszipfile = '/prtspool/'.
- $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
- time.'_'.rand(1000000000).'.zip';
-# zip can cause an sh launch which can pass along all of %ENV
-# which can be too large for /bin/sh to handle
- my %oldENV=%ENV;
- undef(%ENV);
- my $cwd = &Cwd::getcwd();
- my $imszip = '/home/httpd/'.$imszipfile;
- chdir $tempexport;
- open(OUTPUT, "zip -r $imszip * 2> /dev/null |");
- close(OUTPUT);
- chdir $cwd;
- %ENV=%oldENV;
- undef(%oldENV);
- $outcome .= 'Download the zip file from IMS course archive ';
- if ($copyresult) {
- $outcome .= 'The following errors occurred during export - '.$copyresult;
- }
- } else {
- $outcome = ' Unfortunately you will not be able to retrieve an IMS archive of this posts at this time, because there was a problem creating a manifest file. ';
- }
- }
-
- $r->print('Export Course '.
- &Apache::loncommon::bodytag('Export course to IMS or SCORM content package'));
- $r->print($outcome);
- $r->print('