--- loncom/interface/londocs.pm 2002/07/31 14:56:36 1.4
+++ loncom/interface/londocs.pm 2024/12/20 15:15:04 1.712
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.4 2002/07/31 14:56:36 www Exp $
+# $Id: londocs.pm,v 1.712 2024/12/20 15:15:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -29,88 +29,10300 @@
package Apache::londocs;
use strict;
-use Apache::Constants qw(:common);
+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 Apache::lontemplate();
+use Apache::lonsimplepage();
+use Apache::lonhomework();
+use Apache::lonpublisher();
+use Apache::loncourserespicker();
+use HTML::Entities;
+use HTML::TokeParser;
+use GDBM_File;
+use File::MMagic;
+use File::Copy;
+use Apache::lonlocal;
+use Cwd;
+use UUID::Tiny ':std';
+use LONCAPA qw(:DEFAULT :match);
-sub handler {
- my $r = shift;
- $r->content_type('text/html');
- $r->send_http_header;
- return OK if $r->header_only;
+my $iconpath;
+
+my %hash;
+
+my $hashtied;
+my %alreadyseen=();
+
+my $hadchanges;
+my $suppchanges;
-# does this user have privileges to post, etc?
- my $allowed=&Apache::lonnet::allowed('srm',$ENV{'request.course.id'});
- if ($allowed) {
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['remove'])
+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); }
-# get course data
- my $coursenum=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
- my $coursedom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ if ($map =~ /^default/) {
+ $hadchanges=1;
+ } elsif ($contentchg) {
+ $suppchanges=1;
+ }
+ return ($errtext,0);
+}
-# upload a file
- if (($ENV{'form.uploaddoc.filename'}) && ($allowed)) {
- my $id=time.'_'.$ENV{'user.name'}.'_'.$ENV{'user.domain'};
- my $url=&Apache::lonnet::userfileupload('uploaddoc');
- if ($url=~/^error\:/) {
- } else {
- my $comment=$ENV{'form.comment'};
- $comment=~s/\\<\;/g;
- $comment=~s/\>/\>\;/g;
- &Apache::lonnet::put('coursedocs',
- { $id.'.url' => $url,
- $id.'.comment' => $comment },
- $coursedom,$coursenum);
- }
- }
-
-# delete a file
- if ($ENV{'form.remove'}=~/$ENV{'user.name'}\_$ENV{'user.domain'}$/) {
- my $id=$ENV{'form.remove'};
- &Apache::lonnet::del('coursedocs',
- [$id.'.url',$id.'.comment'],
- $coursedom,$coursenum);
- }
-# print screen
- $r->print(< '.&mt('No author or co-author roles on this server.').' '.&mt('Selected Authoring Space is not on this server.').' '.&mt('No author or co-author roles on this server.').' '.
+ &mt('You do not have permission to copy files and/or directories from Course Authoring Space.').
+ ' '.&mt('Selected Authoring Space is not on this server.').' '.&mt('After removal of disallowed characters target sub-directory name was blank.').' '.&mt('After replacement of non-alphanumeric characters with _ in target sub-directory name, nothing but underscores was left.').' '.&mt('No files or directories selected for copying').' '.&mt('Copy to: [_1]',
+ ''.$desturl.'/'.$subdir.'').
+ ' '.
+ &endContentScreen());
+ return '';
+ }
+ if (keys(%dirs_to_make)) {
+ if ($is_course_home) {
+ unless (-e $desttop.'/'.$subdir) {
+ mkdir($desttop.'/'.$subdir,0755);
+ }
+ if (-e $desttop.'/'.$subdir) {
+ foreach my $dir (sort(keys(%dirs_to_make))) {
+ my @dirs=split(/\//,$dir);
+ my $path="$desttop/$subdir";
+ my $makepath=$path;
+ my $fail;
+ for (my $i=0;$i<@dirs;$i++) {
+ $makepath.='/'.$dirs[$i];
+ unless (-e $makepath) {
+ unless (mkdir($makepath,0755)) {
+ $fail = 1;
+ last;
+ }
+ if (($i == scalar(@dirs)-1) && (!$fail)) {
+ $newdir{$dir} = 1;
+ }
+ }
+ }
+ if ($fail) {
+ $r->print(' '.&mt('Target directory: [_1] does not exist, and could not be created.',
+ ''.$desturl.'/'.$subdir.'/'.$dir.'').
+ ' '.&mt('Target directory: [_1] does not exist, and could not be created.',
+ ''.$desturl.'/'.$subdir.'/'.$path.'').
+ ' '.&mt('Target file: [_1] already exists -- not overwriting.',
+ ''.$desturl.'/'.$subdir.'/'.$file.'').
+ ' '.&mt('Target directory: [_1] name is already in a use for a file -- not overwriting.',
+ ''.$desturl.'/'.$subdir.'/'.$file.'').
+ ' '.&mt('No files or sub-directories copied').' '.&mt('Created the following directories in [_1]:',''.$desturl.'/'.$subdir.'').
+ ''.&mt('Copying Files').'
');
+ my $title=$env{'form.authorfolder'};
+ $title=&clean($title);
+ my ($navmap,$errormsg) =
+ &Apache::loncourserespicker::get_navmap_object($crstype,'dumpdocs');
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my (%maps,%resources,%titles);
+ if (!ref($navmap)) {
+ $r->print($errormsg.
+ &endContentScreen());
+ return '';
+ } else {
+ &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
+ 'dumpdocs',$cdom,$cnum);
+ }
+ my @todump = &Apache::loncommon::get_env_multiple('form.archive');
+ my (%tocopy,%replacehash,%lookup,%deps,%display,%result,%depresult,%simpleproblems,%simplepages,
+ %newcontent,%has_simpleprobs);
+ foreach my $item (sort {$a <=> $b} (@todump)) {
+ my $name = $env{'form.namefor_'.$item};
+ if ($resources{$item}) {
+ my ($map,$id,$res) = &Apache::lonnet::decode_symb($resources{$item});
+ if ($res =~ m{^uploaded/$cdom/$cnum/\E((?:docs|supplemental)/.+)$}) {
+ $tocopy{$1} = $name;
+ $display{$item} = $1;
+ $lookup{$1} = $item;
+ } elsif ($res eq 'lib/templates/simpleproblem.problem') {
+ $simpleproblems{$item} = {
+ symb => $resources{$item},
+ name => $name,
+ };
+ $display{$item} = 'simpleproblem_'.$name;
+ if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(.+)$}) {
+ $has_simpleprobs{$1}{$id} = $item;
+ }
+ } elsif ($res =~ m{^adm/$match_domain/$match_username/(\d+)/smppg}) {
+ my $marker = $1;
+ my $db_name = &Apache::lonsimplepage::get_db_name($res,$marker,$cdom,$cnum);
+ $simplepages{$item} = {
+ res => $res,
+ title => $titles{$item},
+ db => $db_name,
+ marker => $marker,
+ symb => $resources{$item},
+ name => $name,
+ };
+ $display{$item} = '/'.$res;
+ }
+ } elsif ($maps{$item}) {
+ if ($maps{$item} =~ m{^\Quploaded/$cdom/$cnum/\E((?:default|supplemental)_\d+\.(?:sequence|page))$}) {
+ $tocopy{$1} = $name;
+ $display{$item} = $1;
+ $lookup{$1} = $item;
+ }
+ } else {
+ next;
+ }
+ }
+ my $crs='/uploaded/'.$env{'request.course.id'}.'/';
+ $crs=~s/\_/\//g;
+ my $mm = new File::MMagic;
+ my $prefix = "/uploaded/$cdom/$cnum/";
+ %replacehash = %tocopy;
+ foreach my $item (sort(keys(%simpleproblems))) {
+ my $content = &Apache::imsexport::simpleproblem($simpleproblems{$item}{'symb'});
+ $newcontent{$display{$item}} = $content;
+ }
+ my $gateway = Apache::lonhtmlgateway->new('web');
+ foreach my $item (sort(keys(%simplepages))) {
+ if (ref($simplepages{$item}) eq 'HASH') {
+ my $pagetitle = $simplepages{$item}{'title'};
+ my %fields = &Apache::lonnet::dump($simplepages{$item}{'db'},$cdom,$cnum);
+ my %contents;
+ foreach my $field (keys(%fields)) {
+ if ($field =~ /^(?:aaa|bbb|ccc)_(\w+)$/) {
+ my $name = $1;
+ my $msg = $fields{$field};
+ if ($name eq 'webreferences') {
+ if ($msg =~ m{^https?://}) {
+ $contents{$name} = ''.$msg.'';
+ }
+ } else {
+ $msg = &Encode::decode('utf8',$msg);
+ $msg = $gateway->process_outgoing_html($msg,1);
+ $contents{$name} = $msg;
+ }
+ } elsif ($field eq 'uploaded.photourl') {
+ my $marker = $simplepages{$item}{marker};
+ if ($fields{$field} =~ m{^\Q$prefix\E(simplepage/$marker/.+)$}) {
+ my $filepath = $1;
+ my ($relpath,$fname) = ($filepath =~ m{^(.+/)([^/]+)$});
+ if ($fname ne '') {
+ $fname=~s/\.(\w+)$//;
+ my $ext=$1;
+ $fname = &clean($fname);
+ $fname.='.'.$ext;
+ $contents{image} = '';
+ $replacehash{$filepath} = $relpath.$fname;
+ $deps{$item}{$filepath} = 1;
+ }
+ }
+ }
+ }
+ $replacehash{'/'.$simplepages{$item}{'res'}} = $simplepages{$item}{'name'};
+ $lookup{'/'.$simplepages{$item}{'res'}} = $item;
+ my $content = '
+
+
+'.$contents{title}.'
';
+ }
+ if ($contents{image}) {
+ $content .= "\n".$contents{image};
+ }
+ if ($contents{content}) {
+ $content .= '
+'.&mt('Content').'
'.
+$contents{content}.'
+'.&mt('Web References').'
'.
+$contents{webreferences}.'
+
'.$item.' => '.$newfilename.': ';
+ } else {
+ $depresult .= ''.$depresult.'
');
+ }
+ }
+ } else {
+ my ($navmap,$errormsg) =
+ &Apache::loncourserespicker::get_navmap_object($crstype,'dumpdocs');
+ if (!ref($navmap)) {
+ $r->print($errormsg);
+ } else {
+ my $title=$origcrsdata{'description'};
+ $title=~s/[\/\s]+/\_/gs;
+ $title=&clean($title);
+ my $formname = 'dumpdoc';
+ my $preamble = &authorspace_selector($r,$formname,$home,$title,%outhash);
+ my %uploadedfiles;
+ &tiehash();
+ foreach my $file (&Apache::lonclonecourse::crsdirlist($origcrsid,'userfiles')) {
+ my ($ext)=($file=~/\.(\w+)$/);
+# FIXME Check supplemental here
+ my $title=$hash{'title_'.$hash{
+ 'ids_/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'.$file}};
+ if (!$title) {
+ $title=$file;
+ } else {
+ $title=~s|/|_|g;
+ }
+ $title=~s/\.(\w+)$//;
+ $title=&clean($title);
+ $title.='.'.$ext;
+# $r->print("\n"
+ $uploadedfiles{$file} = $title;
+ }
+ &untiehash();
+ $r->print(&Apache::loncourserespicker::create_picker($navmap,'dumpdocs',$formname,$crstype,undef,
+ undef,undef,$preamble,$home,\%uploadedfiles));
+ }
+ }
+ $r->print(&endContentScreen());
+}
+
+sub authorspace_selector {
+ my ($r,$formname,$home,$title,%outhash) = @_;
+ $r->print(' '.&mt('Copying Files and/or Sub-directories').'
');
+ if ($readonly) {
+ $r->print('
'."\n".
+ ''.&mt('Target directory: [_1] does not exist, and could not be created.',
+ ''.$desturl.'/'.$subdir.'').
+ '
'.&mt('Copied the following files to [_1]:',''.$desturl.'/'.$subdir.''). + '
'."\n". + ''.&mt('No currently existing files or directories in Course Authoring Space selected for copying').'
'); + $r->print(&endContentScreen()); + return ''; + } + } else { + my $formname = 'copycrsauthored'; + my $chkname = 'copytouser'; + my $context = 'crsauthored'; + my (%subdirs,%files,@dirs_by_depth,@files_by_depth,%parent,%children,%hierarchy,@checked_maps); + &Apache::lonnet::recursedirs($home,1,undef,$exclude,0,0,$srcurl,'',\%subdirs,\%files); + foreach my $key (keys(%subdirs)) { + next if (($key eq '/') || ($key eq '')); + my @items = split(/\//,$key); + my $dir = pop(@items); + my $depth = scalar(@items); + my $path; + if (!$depth) { + $path = '/'; + } else { + $path = join('/',@items); + } + $dirs_by_depth[$depth]{$path}{$dir} = 1; + } + foreach my $path (keys(%files)) { + next if ($path eq ''); + my $depth; + if ($path eq '/') { + $depth = 0; + } else { + $depth = scalar(split(/\//,$path)); + } + if (ref($files{$path}) eq 'HASH') { + foreach my $file (keys(%{$files{$path}})) { + $files_by_depth[$depth]{$path}{$file} = 1; + } + } + } + my ($info,$display,$onsubmit,$togglebuttons,$disabled); + if ($readonly) { + $disabled = ' disabled="disabled"'; + } + if ($disabled) { + $togglebuttons = '