--- loncom/interface/londocs.pm 2010/01/21 23:19:17 1.416
+++ loncom/interface/londocs.pm 2025/01/07 21:01:37 1.722
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.416 2010/01/21 23:19:17 raeburn Exp $
+# $Id: londocs.pm,v 1.722 2025/01/07 21:01:37 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,8 +26,6 @@
# http://www.lon-capa.org/
#
-
-
package Apache::londocs;
use strict;
@@ -41,10 +39,22 @@ 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 HTML::LCParser;
use GDBM_File;
+use File::MMagic;
+use File::Copy;
use Apache::lonlocal;
use Cwd;
+use UUID::Tiny ':std';
use LONCAPA qw(:DEFAULT :match);
my $iconpath;
@@ -55,6 +65,7 @@ my $hashtied;
my %alreadyseen=();
my $hadchanges;
+my $suppchanges;
my %help=();
@@ -68,13 +79,21 @@ sub mapread {
}
sub storemap {
- my ($coursenum,$coursedom,$map)=@_;
+ my ($coursenum,$coursedom,$map,$contentchg)=@_;
+ my $report;
+ if (($contentchg) && ($map =~ /^default/)) {
+ $report = 1;
+ }
my ($outtext,$errtext)=
&LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/'.
- $map,1);
+ $map,1,$report);
if ($errtext) { return ($errtext,2); }
- $hadchanges=1;
+ if ($map =~ /^default/) {
+ $hadchanges=1;
+ } elsif ($contentchg) {
+ $suppchanges=1;
+ }
return ($errtext,0);
}
@@ -84,6 +103,7 @@ sub authorhosts {
my %outhash=();
my $home=0;
my $other=0;
+ my @ids=&Apache::lonnet::current_machine_ids();
foreach my $key (keys(%env)) {
if ($key=~/^user\.role\.(au|ca)\.(.+)$/) {
my $role=$1;
@@ -100,13 +120,17 @@ sub authorhosts {
}
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++;
}
}
@@ -115,851 +139,1541 @@ sub authorhosts {
}
-sub dumpbutton {
- my ($home,$other,%outhash)=&authorhosts();
- my $crstype = &Apache::loncommon::course_type();
- if ($home+$other==0) { return ''; }
- if ($home) {
- my $link = "".&mt('Dump '.$crstype.' DOCS to Construction Space')." ";
- return $link.' '.
- &Apache::loncommon::help_open_topic('Docs_Dump_Course_Docs').' ';
- } else {
- return '
'.
- &mt('Dump '.$crstype.
- ' DOCS to Construction Space: available on other servers').
- '
';
- }
-}
-
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 $folderpath;
+ }
+}
+sub validate_supppath {
+ my ($coursenum,$coursedom) = @_;
+ my $backto;
+ if ($env{'form.supppath'} ne '') {
+ my @items = split(/\&/,$env{'form.supppath'});
+ my ($badpath,$got_supp,$supppath,%supphidden,%suppids);
+ for (my $i=0; $i<@items; $i++) {
+ my $odd = $i%2;
+ if ((!$odd) && ($items[$i] !~ /^supplemental(|_\d+)$/)) {
+ $badpath = 1;
+ last;
+ } elsif ($odd) {
+ my $suffix;
+ my $idx = $i-1;
+ if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
+ $backto .= '&'.$1;
+ } elsif ($items[$idx] eq 'supplemental') {
+ $backto .= '&'.$items[$i];
+ } else {
+ $backto .= '&'.$items[$i];
+ my $is_hidden;
+ unless ($got_supp) {
+ my ($supplemental) = &Apache::loncommon::get_supplemental($coursenum,$coursedom);
+ if (ref($supplemental) eq 'HASH') {
+ if (ref($supplemental->{'hidden'}) eq 'HASH') {
+ %supphidden = %{$supplemental->{'hidden'}};
+ }
+ if (ref($supplemental->{'ids'}) eq 'HASH') {
+ %suppids = %{$supplemental->{'ids'}};
+ }
+ }
+ $got_supp = 1;
+ }
+ if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
+ my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
+ if ($supphidden{$mapid}) {
+ $is_hidden = 1;
+ }
+ }
+ $suffix = '::'.$is_hidden.':::';
+ }
+ $supppath .= '&'.$items[$i].$suffix;
+ } else {
+ $supppath .= '&'.$items[$i];
+ $backto .= '&'.$items[$i];
+ }
+ }
+ if ($badpath) {
+ delete($env{'form.supppath'});
+ } else {
+ $supppath =~ s/^\&//;
+ $backto =~ s/^\&//;
+ $env{'form.supppath'} = $supppath;
+ }
+ }
+ return $backto;
+}
sub dumpcourse {
my ($r) = @_;
my $crstype = &Apache::loncommon::course_type();
- $r->print(&Apache::loncommon::start_page('Dump '.$crstype.' DOCS to Construction Space').
- '');
- if ($crstype eq 'Community') {
- $r->print(&mt('Unable to retrieve information about community contents'));
- } else {
- $r->print(&mt('Unable to retrieve information about course contents'));
- }
- $r->print('
');
- if ($crstype eq 'Community') {
- $r->print(&mt('Return to Community Editor'));
+sub authorspace_selector {
+ my ($r,$formname,$home,$title,%outhash) = @_;
+ $r->print(''.&mt('Searching ...').'
'."\n");
+ $r->rflush();
+ my $preamble;
+ unless ($home==1) {
+ $preamble = ''.
+ '
'.
+ &mt('Select the Authoring Space').
+ ' ';
+ }
+ my @orderspaces = ();
+ foreach my $key (sort(keys(%outhash))) {
+ if ($key=~/^home_(.+)$/) {
+ if ($1 eq $env{'user.name'}.':'.$env{'user.domain'}) {
+ unshift(@orderspaces,$1);
+ } else {
+ push(@orderspaces,$1);
+ }
+ }
+ }
+ if ($home>1) {
+ $preamble .= ''.&mt('Select').' ';
+ }
+ foreach my $user (@orderspaces) {
+ if ($home==1) {
+ $preamble .= ' ';
} else {
- $r->print(&mt('Return to Course Editor'));
+ $preamble .= ''.$user.' - '.
+ &Apache::loncommon::plainname(split(/\:/,$user)).' ';
}
- $r->print('');
- &Apache::lonnet::logthis('IMS export failed - could not create navmap object in '.lc($crstype).':'.$env{'request.course.id'});
- return;
}
- my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);
- my $curRes;
- my $outcome;
-
- &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 = &Apache::loncommon::get_env_multiple('form.archive');
- my @discussions = &Apache::loncommon::get_env_multiple('form.discussion');
- if (@exportitems == 0 && @discussions == 0) {
- $outcome =
- ''
- .&mt('As you did not select any content items or discussions'
- .' for export, an IMS package has not been created.')
- .'
'
- .''
- .&mt('Please [_1]go back[_2] to select either content items'
- .' or discussions for export.'
- ,''
- ,' ')
- .'
';
- } else {
- my $now = time;
- 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';
- my $cwd = &Cwd::getcwd();
- my $imszip = '/home/httpd/'.$imszipfile;
- chdir $tempexport;
- open(OUTPUT, "zip -r $imszip * 2> /dev/null |");
- close(OUTPUT);
- chdir $cwd;
- $outcome .= ''
- .&mt('[_1]Your IMS package[_2] is ready for download.'
- ,'',' ')
- .'
';
- if ($copyresult) {
- $outcome .= ''
- .&mt('The following errors occurred during export - [_1]'
- ,$copyresult)
- .'
';
- }
- } else {
- $outcome = ''
- .&mt('Unfortunately you will not be able to retrieve'
- .' an IMS archive of your course at this time,'
- .' because there was a problem creating a'
- .' manifest file.')
- .'
'
- .''
- .&mt('Go Back')
- .'
';
- }
- }
- $r->print(&Apache::loncommon::start_page('Export '.$crstype.' to IMS Package'));
- $r->print(&Apache::lonhtmlcommon::breadcrumbs('IMS Export'));
- $r->print($outcome);
- $r->print(&Apache::loncommon::end_page());
- } else {
- my $display=' '."\n";
+ }
+ $preamble .= ''.
+ '
'.&mt('Folder in Authoring Space').' '.
+ ' '."\n".
+ ' '."\n";
+ return $preamble;
+}
+
+sub recurse_html {
+ my ($mm,$prefix,$currdirpath,$currurlpath,$container,$item,$replacehash,$deps) = @_;
+ return unless ((ref($replacehash) eq 'HASH') && (ref($deps) eq 'HASH'));
+ my (%allfiles,%codebase);
+ if (&Apache::lonnet::extract_embedded_items($currdirpath,\%allfiles,\%codebase) eq 'ok') {
+ if (keys(%allfiles)) {
+ foreach my $dependency (keys(%allfiles)) {
+ next if (($dependency =~ m{^/(res|adm)/}) || ($dependency =~ m{^https?://}));
+ my ($depurl,$relfile,$newcontainer);
+ if ($dependency =~ m{^/}) {
+ if ($dependency =~ m{^\Q$currurlpath/\E(.+)$}) {
+ $relfile = $1;
+ if ($dependency =~ m{^\Q$prefix\E(.+)$}) {
+ $newcontainer = $1;
+ next if ($replacehash->{$newcontainer});
+ }
+ $depurl = $dependency;
+ } else {
+ next;
+ }
+ } else {
+ $relfile = $dependency;
+ $depurl = $currurlpath;
+ $depurl =~ s{[^/]+$}{};
+ $depurl .= $dependency;
+ ($newcontainer) = ($depurl =~ m{^\Q$prefix\E(.+)$});
+ }
+ next if ($relfile eq '');
+ my $newname = $replacehash->{$container};
+ $newname =~ s{[^/]+$}{};
+ $replacehash->{$newcontainer} = $newname.$relfile;
+ $deps->{$item}{$newcontainer} = 1;
+ my ($newurlpath) = ($depurl =~ m{^(.*)/[^/]+$});
+ my $depfile = &Apache::lonnet::filelocation('',$depurl);
+ my $type = $mm->checktype_filename($depfile);
+ if ($type eq 'text/html') {
+ &recurse_html($mm,$prefix,$depfile,$newurlpath,$newcontainer,$item,$replacehash,$deps);
}
- $display .= &Apache::loncommon::end_data_table_row();
}
}
- $display .= &Apache::loncommon::end_data_table();
- my $scripttag = qq|
-
- foreach my $container (sort { $a <=> $b } (keys(%children))) {
- my @contents = split(/:/,$children{$container});
- for (my $i=0; $i<@contents; $i ++) {
- $scripttag .= ' parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
- }
- }
+ENDJS
+ } elsif ($home) {
+ $js = <<"ENDJS";
+
- |;
- $r->print(&Apache::loncommon::start_page('Export '.$crstype.' to IMS Package',
- $scripttag));
- $r->print(&Apache::lonhtmlcommon::breadcrumbs('IMS Export'));
- $r->print($display.
- ' '.
- '
');
- }
-}
-
-sub create_ims_store {
- my ($now,$manifestok,$outcome,$tempexport) = @_;
- $$tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports';
- my $ims_manifest;
- if (!-e $$tempexport) {
- mkdir($$tempexport,0700);
- }
- $$tempexport .= '/'.$now;
- if (!-e $$tempexport) {
- mkdir($$tempexport,0700);
- }
- $$tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'};
- if (!-e $$tempexport) {
- mkdir($$tempexport,0700);
- }
- if (!-e "$$tempexport/resources") {
- mkdir("$$tempexport/resources",0700);
- }
-# open manifest file
- my $manifest = '/imsmanifest.xml';
- my $manifestfilename = $$tempexport.$manifest;
- if ($ims_manifest = Apache::File->new('>'.$manifestfilename)) {
- $$manifestok=1;
- print $ims_manifest
-''."\n".
-''."\n".
-'
-
-
-
- '.$env{'request.course.id'}.'
-
- '.$env{'course.'.$env{'request.course.id'}.'.description'}.'
-
-
-
- '."\n".
-' '."\n".
-' '."\n".
-' '.$env{'course.'.$env{'request.course.id'}.'.description'}.' '
- } else {
- $$outcome .= 'An error occurred opening the IMS manifest file. '
-;
- }
- return $ims_manifest;
-}
-
-sub build_package {
- my ($now,$navmap,$exportitems,$discussions,$outcome,$tempexport,$copyresult,$ims_manifest) = @_;
-# first iterator to look for dependencies
- my $it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
- my $curRes;
- my $count = 0;
- my $depth = 0;
- my $lastcontainer = 0;
- my %parent = ();
- my @dependencies = ();
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- while ($curRes = $it->next()) {
- if (ref($curRes)) {
- $count ++;
- }
- if ($curRes == $it->BEGIN_MAP()) {
- $depth++;
- $parent{$depth} = $lastcontainer;
- }
- if ($curRes == $it->END_MAP()) {
- $depth--;
- $lastcontainer = $parent{$depth};
- }
- if (ref($curRes)) {
- if ($curRes->is_sequence() || $curRes->is_page()) {
- $lastcontainer = $count;
- }
- if (grep(/^$count$/,@$exportitems)) {
- &get_dependencies($exportitems,\%parent,$depth,\@dependencies);
- }
- }
- }
-# second iterator to build manifest and store resources
- $it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
- $depth = 0;
- my $prevdepth;
- $count = 0;
- my $imsresources;
- my $pkgdepth;
- while ($curRes = $it->next()) {
- if ($curRes == $it->BEGIN_MAP()) {
- $prevdepth = $depth;
- $depth++;
- }
- if ($curRes == $it->END_MAP()) {
- $prevdepth = $depth;
- $depth--;
- }
- if (ref($curRes)) {
- $count ++;
- if ((grep(/^$count$/,@$exportitems)) || (grep(/^$count$/,@dependencies))) {
- my $symb = $curRes->symb();
- my $isvisible = 'true';
- my $resourceref;
- if ($curRes->randomout()) {
- $isvisible = 'false';
- }
- unless ($curRes->is_sequence()) {
- $resourceref = 'identifierref="RES-'.$env{'request.course.id'}.'-'.$count.'"';
- }
- my $step = $prevdepth - $depth;
- if (($step >= 0) && ($count > 1)) {
- while ($step >= 0) {
- print $ims_manifest "\n".' '."\n";
- $step --;
- }
- }
- $prevdepth = $depth;
-
- my $itementry =
- '- '.
- '
'.$curRes->title().' ';
- print $ims_manifest "\n".$itementry;
-
- unless ($curRes->is_sequence()) {
- my $content_file;
- my @hrefs = ();
- &process_content($count,$curRes,$cdom,$cnum,$symb,\$content_file,\@hrefs,$copyresult,$tempexport);
- if ($content_file) {
- $imsresources .= "\n".
- ' '."\n".
- ' '."\n";
- foreach my $item (@hrefs) {
- $imsresources .=
- ' '."\n";
- }
- if (grep(/^$count$/,@$discussions)) {
- my $ressymb = $symb;
- my $mode;
- if ($ressymb =~ m|adm/($match_domain)/($match_username)/(\d+)/bulletinboard$|) {
- unless ($ressymb =~ m|adm/wrapper/adm|) {
- $ressymb = 'bulletin___'.$3.'___adm/wrapper/adm/'.$1.'/'.$2.'/'.$3.'/bulletinboard';
- }
- $mode = 'board';
- }
- my %extras = (
- caller => 'imsexport',
- tempexport => $tempexport.'/resources',
- count => $count
- );
- my $discresult = &Apache::lonfeedback::list_discussion($mode,undef,$ressymb,\%extras);
- }
- $imsresources .= ' '."\n";
- }
- }
- $pkgdepth = $depth;
- }
- }
- }
- while ($pkgdepth > 0) {
- print $ims_manifest " \n";
- $pkgdepth --;
- }
- my $resource_text = qq|
-
-
-
- $imsresources
-
-
- |;
- print $ims_manifest $resource_text;
-}
-
-sub get_dependencies {
- my ($exportitems,$parent,$depth,$dependencies) = @_;
- if ($depth > 1) {
- if ((!grep(/^$$parent{$depth}$/,@$exportitems)) && (!grep(/^$$parent{$depth}$/,@$dependencies))) {
- push(@{$dependencies},$$parent{$depth});
- if ($depth > 2) {
- &get_dependencies($exportitems,$parent,$depth-1,$dependencies);
- }
+ENDJS
}
+ $js .= <<"ENDJS";
+
+ENDJS
+
+ $js .= "\n".&Apache::lonhtmlcommon::scripttag(&Apache::loncommon::browser_and_searcher_javascript())."\n";
+ $starthash = {
+ add_entries => {'onload' => "hide_searching(); init_copycrs_form();"},
+ };
+ }
+ $r->print(&Apache::loncommon::start_page('Copy from Course Authoring to User Authoring',$js,$starthash)."\n".
+ &Apache::lonhtmlcommon::breadcrumbs('Copy from Course Authoring Space')."\n");
+ $r->print(&startContentScreen('tools'));
+ unless ($home) {
+ $r->print(''.&mt('No author or co-author roles on this server.').'
');
+ $r->print(&endContentScreen());
+ return '';
+ }
+ my $docroot = $r->dir_config('lonDocRoot');
+ my $is_course_home;
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if (($coursehome ne '') && (grep(/^\Q$coursehome\E$/,@ids))) {
+ $is_course_home = 1;
+ }
+ my $exclude = &Apache::lonnet::priv_exclude();
+ my $srcurl = "/priv/$coursedom/$coursenum";
+ my $srctop = $docroot.$srcurl;
+ my $resurl = "/res/$coursedom/$coursenum";
+ my $res_exclude = &Apache::lonnet::res_exclude();
+ if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) {
+ $r->print(''.&mt('Copying Files and/or Sub-directories').' ');
+ if ($readonly) {
+ $r->print(''.
+ &mt('You do not have permission to copy files and/or directories from Course Authoring Space.').
+ '
'.
+ &endContentScreen());
+ return '';
+ }
+ unless ($outhash{'home_'.$env{'form.authorspace'}}) {
+ $r->print(''.&mt('Selected Authoring Space is not on this server.').'
'.
+ &endContentScreen());
+ return '';
+ }
+ my ($ca,$cd)=split(/\:/,$env{'form.authorspace'});
+ my $desturl = "/priv/$cd/$ca";
+ my $destresurl = "/res/$cd/$ca";
+ my $desttop = $docroot.$desturl;
+ my $subdir = &clean($env{'form.authorfolder'});
+ $subdir = &cleandir($subdir);
+ if ($subdir eq '') {
+ $r->print(''.&mt('After removal of disallowed characters target sub-directory name was blank.').'
'.
+ &endContentScreen());
+ return '';
+ } elsif ($subdir =~/^_+$/) {
+ $r->print(''.&mt('After replacement of non-alphanumeric characters with _ in target sub-directory name, nothing but underscores was left.').'
'.
+ &endContentScreen());
+ return '';
+ }
+ my (%tocopy,%dirs_to_make,%files_to_copy);
+ map { $tocopy{&unescape($_)} = 1; } &Apache::loncommon::get_env_multiple('form.copytouser');
+ if (keys(%tocopy)) {
+ my (%subdirs,%files);
+ &Apache::lonnet::recursedirs($is_course_home,1,undef,$exclude,0,0,$srcurl,'',\%subdirs,\%files);
+ foreach my $possible (sort(keys(%tocopy))) {
+ if ($possible =~ m{/$}) {
+ my $possdir = $possible;
+ $possdir =~ s{^/+|/+$}{}g;
+ if (exists($subdirs{$possdir})) {
+ $dirs_to_make{$possdir} = 1;
+ } else {
+ delete($tocopy{$possible});
+ }
} else {
- &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'resource');
- $repstatus = 'ok';
+ my ($path,$fname) = ($possible =~ m{(.*/)([^/]+)$});
+ my $found = 0;
+ if ($path eq '/') {
+ if (ref($files{$path}) eq 'HASH') {
+ if (exists($files{$path}{$fname})) {
+ $found = 1;
+ $files_to_copy{$fname} = 1;
+ }
+ }
+ } else {
+ $path =~ s{^/+|/+$}{}g;
+ if (ref($files{$path}) eq 'HASH') {
+ if (exists($files{$path}{$fname})) {
+ $dirs_to_make{$path} = 1;
+ $files_to_copy{"$path/$fname"} = 1;
+ $found = 1;
+ }
+ }
+ }
+ unless ($found) {
+ delete($tocopy{$possible});
+ }
+ }
+ }
+ } else {
+ $r->print(''.&mt('No files or directories selected for copying').'
');
+ $r->print(&endContentScreen());
+ return '';
+ }
+ if (keys(%tocopy)) {
+ my (%resdirs,%resfiles);
+ &Apache::lonnet::recursedirs($is_course_home,1,undef,$res_exclude,0,0,$resurl,'',\%resdirs,\%resfiles);
+ my ($notopdir,%newdir,%newfile,%checkdeps,%newresfile);
+ $r->print(''.&mt('Copy to: [_1]',
+ ''.$desturl.'/'.$subdir.' ').
+ '
'."\n");
+ if (keys(%dirs_to_make)) {
+ unless (-e $desttop.'/'.$subdir) {
+ mkdir($desttop.'/'.$subdir,0755);
}
- } elsif ($caller eq 'uploaded' || $caller eq 'templateupload') {
- my $rtncode;
- $repstatus = &Apache::lonnet::getuploaded('GET',$url,$cdom,$cnum,\$content,$rtncode);
- if ($repstatus eq 'ok') {
- if ($url =~ /\.html?$/i) {
- &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'uploaded');
+ 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.' ').
+ '
'."\n");
+ }
}
} else {
- $$message = 'Could not render '.$url.' server message - '.$rtncode." \n";
+ $notopdir = 1;
}
- } elsif ($caller eq 'noedit') {
-# Need to render the resource without the LON-CAPA Internal header and the Post discussion footer, and then set $content equal to this.
- $repstatus = 'ok';
- $content = 'Not the owner of this resource';
}
- if ($repstatus eq 'ok') {
- print $copiedfile $content;
+ if (keys(%files_to_copy)) {
+ unless (-e $desttop.'/'.$subdir) {
+ mkdir($desttop.'/'.$subdir,0755);
+ }
+ if (-e $desttop.'/'.$subdir) {
+ my $num = 0;
+ my ($copyright,$customdistfile);
+ if ($env{'form.copyright'} eq 'default' || $env{'form.copyright'} eq 'domain' || $env{'form.copyright'} eq 'public') {
+ $copyright = $env{'form.copyright'};
+ } elsif ($env{'form.copyright'} eq 'custom') {
+ if ($env{'form.customrights'} =~ m{^/res/$match_domain/$match_username/.+\.rights$}) {
+ my ($rightsdom,$rightsuname) = ($1,$2);
+ my $rightshome = &Apache::lonnet::homeserver($rightsdom,$rightsuname);
+ if (($rightshome eq 'no_host') || ($rightshome eq '')) {
+ $copyright = 'default';
+ } elsif (grep(/^\Q$rightshome\E$/,@ids)) {
+ if (-e $docroot.$env{'form.customrights'}) {
+ $copyright = 'custom';
+ $customdistfile = $env{'form.customrights'};
+ } else {
+ $copyright = 'default';
+ }
+ } else {
+ my $rightsfile = &Apache::lonnet::filelocation('',$env{'form.customrights'});
+ unless (&Apache::lonnet::getfile($rightsfile) eq '-1') {
+ $customdistfile = $env{'form.customrights'};
+ }
+ }
+ }
+ }
+ my $sourceavail;
+ if ($env{'form.sourceavail'} =~ /^(open|closed)$/) {
+ $sourceavail = $env{'form.sourceavail'};
+ }
+ my $respublish;
+ if ($env{'form.respublish'}) {
+ $respublish = 1;
+ }
+ my $nokeyref = &Apache::lonpublisher::getnokey($r->dir_config('lonIncludes'));
+ foreach my $file (keys(%files_to_copy)) {
+ my ($fail,$dup,$dir_is_file,$src,$dest,$path,$fname);
+ if ($file =~ m{/}) {
+ ($path,$fname) = ($file =~ m{^(.+)/([^/]+)$});
+ if (-d "$desttop/$subdir/$path") {
+ if (-e "$desttop/$subdir/$path/$fname") {
+ $dup = 1;
+ } else {
+ $src = "$srctop/$path/$fname";
+ $dest = "$desttop/$subdir/$path/$fname";
+ }
+ } elsif (-f "$desttop/$subdir/$path") {
+ $dir_is_file = 1;
+ } else {
+ $fail = 1;
+ }
+ } elsif (-e "$desttop/$subdir/$file") {
+ $dup = 1;
+ } else {
+ $src = "$srctop/$file";
+ $dest = "$desttop/$subdir/$file";
+ $fname = $file;
+ }
+ if ($fail) {
+ $r->print(''.&mt('Target directory: [_1] does not exist, and could not be created.',
+ ''.$desturl.'/'.$subdir.'/'.$path.' ').
+ '
'."\n");
+ } elsif ($dup) {
+ $r->print(''.&mt('Target file: [_1] already exists -- not overwriting.',
+ ''.$desturl.'/'.$subdir.'/'.$file.' ').
+ '
'."\n");
+ } elsif ($dir_is_file) {
+ $r->print(''.&mt('Target directory: [_1] name is already in a use for a file -- not overwriting.',
+ ''.$desturl.'/'.$subdir.'/'.$file.' ').
+ '
'."\n");
+ } elsif (($src ne '') && ($dest ne '')) {
+ my $ressrc = $docroot.$resurl.'/'.$file;
+ my $ressrcmeta = $ressrc.'.meta';
+ my ($ext) = ($file =~ /\.(\w+)$/);
+ my $embstyle=&Apache::loncommon::fileembstyle($ext);
+ my ($getres,$getresmeta);
+ if ($respublish) {
+ if ($path eq '') {
+ if ((ref($resfiles{'/'}) eq 'HASH') &&
+ (exists($resfiles{'/'}{$fname}))) {
+ $getres = 1;
+ $getresmeta = 1;
+ }
+ } elsif ((ref($resfiles{$path}) eq 'HASH') &&
+ (exists($resfiles{$path}{$fname}))) {
+ $getres = 1;
+ $getresmeta = 1;
+ }
+ }
+ if ($is_course_home) {
+ my ($needpriv,$needprivmeta);
+ if ($respublish) {
+ if ($getres) {
+ if (&Apache::londiff::are_different_files($src,$ressrc)) {
+ $needpriv = 1;
+ if (&File::Copy::copy($ressrc,$dest)) {
+ if ($embstyle eq 'ssi') {
+ &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd);
+ }
+ }
+ } else {
+ if (&File::Copy::copy($src,$dest)) {
+ $newfile{$file} = $desturl.'/'.$subdir.'/'.$file;
+ if ($embstyle eq 'ssi') {
+ &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir);
+ }
+ }
+ }
+ } else {
+ $needpriv = 1;
+ }
+ if ($getresmeta) {
+ if ((-e $src.'.meta') && (!-e $dest.'.meta')) {
+ if (&Apache::londiff::are_different_files($src.'.meta',$ressrc.'.meta')) {
+ if (&File::Copy::copy($ressrc.'.meta',$dest.'.meta')) {
+ &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright,
+ $customdistfile,$sourceavail,\%checkdeps);
+ }
+ $needprivmeta = 1;
+ } else {
+ if (&File::Copy::copy($src.'.meta',$dest.'.meta')) {
+ &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright,
+ $customdistfile,$sourceavail,\%checkdeps);
+ }
+ }
+ }
+ }
+ if ($getres) {
+ my $destresfile = $docroot.$destresurl.'/'.$subdir.'/'.$file;
+ if (-e $dest) {
+ my $output = &Apache::lonpublisher::batchpublish($r,$dest,$destresfile,$nokeyref,1);
+ if (-e $destresfile) {
+ $newresfile{$file} = $destresurl.'/'.$subdir.'/'.$file;
+ }
+ }
+ }
+ } else {
+ $needpriv = 1;
+ if ((-e $src.'.meta') && (!-e $dest.'.meta')) {
+ $needprivmeta = 1;
+ }
+ }
+ if ($needpriv) {
+ if (&File::Copy::copy($src,$dest)) {
+ $newfile{$file} = $desturl.'/'.$subdir.'/'.$file;
+ if ($embstyle eq 'ssi') {
+ &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir);
+ }
+ }
+ }
+ if ($needprivmeta) {
+ if (&File::Copy::copy($src.'.meta',$dest.'.meta')) {
+ &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright,
+ $customdistfile,$sourceavail,\%checkdeps);
+ }
+ }
+ } else {
+ my ($needpriv,$needprivmeta);
+ if ($respublish) {
+ if ($getres) {
+ &Apache::lonnet::repcopy($docroot.$resurl.'/'.$file);
+ }
+ if ($getresmeta) {
+ &Apache::lonnet::repcopy($docroot.$resurl.'/'.$file.'.meta');
+ }
+ if (-e $docroot.$resurl.'/'.$file) {
+ if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file,$dest) eq 'ok') {
+ if (&Apache::londiff::are_different_files($docroot.$resurl.'/'.$file,$dest)) {
+ $needpriv = 1;
+ if (&File::Copy::copy($docroot.$resurl.'/'.$file,$dest)) {
+ if ($embstyle eq 'ssi') {
+ &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd);
+ }
+ }
+ } else {
+ if ($embstyle eq 'ssi') {
+ &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir);
+ }
+ $newfile{$file} = $desturl.'/'.$subdir.'/'.$file;
+ }
+ }
+ } else {
+ $needpriv = 1;
+ }
+ if (-e $docroot.$resurl.'/'.$file.'.meta') {
+ if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') {
+ if (&Apache::londiff::are_different_files($docroot.$resurl.'/'.$file.'.meta',$dest.'.meta')) {
+ $needprivmeta = 1;
+ if (&File::Copy::copy($docroot.$resurl.'/'.$file.'.meta',$dest.'.meta')) {
+ &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright,
+ $customdistfile,$sourceavail,\%checkdeps);
+ }
+ } else {
+ &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright,
+ $customdistfile,$sourceavail,\%checkdeps);
+ }
+ }
+ } else {
+ if (!-e $dest.'.meta') {
+ $needprivmeta = 1;
+ }
+ }
+ if ($getres) {
+ my $destresfile = $docroot.$destresurl.'/'.$subdir.'/'.$file;
+ if (-e $dest) {
+ my $output = &Apache::lonpublisher::batchpublish($r,$dest,$destresfile,$nokeyref,1);
+ if (-e $destresfile) {
+ $newresfile{$file} = $destresurl.'/'.$subdir.'/'.$file;
+ }
+ }
+ }
+ } else {
+ $needpriv = 1;
+ if (!-e $dest.'.meta') {
+ $needprivmeta = 1;
+ }
+ }
+ if ($needpriv) {
+ if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file,$dest) eq 'ok') {
+ if ($embstyle eq 'ssi') {
+ &crsres_fixup($dest,$coursenum,$coursedom,$ca,$cd,$subdir);
+ }
+ $newfile{$file} = $desturl.'/'.$subdir.'/'.$file;
+ }
+ }
+ if ($needprivmeta) {
+ if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') {
+ &crsres_fixup_meta($dest,$coursenum,$coursedom,$ca,$cd,$copyright,
+ $customdistfile,$sourceavail,\%checkdeps);
+ }
+ }
+ }
+ }
+ }
+ } else {
+ $notopdir = 1;
+ }
+ }
+ if ($notopdir) {
+ $r->print(''.&mt('No files or sub-directories copied').' '."\n".
+ ''.&mt('Target directory: [_1] does not exist, and could not be created.',
+ ''.$desturl.'/'.$subdir.' ').
+ '
'."\n");
+ }
+ if (keys(%newdir)) {
+ $r->print(''.&mt('Created the following directories in [_1]:',''.$desturl.'/'.$subdir.' ').
+ '
'."\n".
+ ''.join(' ',sort(keys(%newdir))).' '."\n");
+ }
+ if (keys(%newfile)) {
+ $r->print(''.&mt('Copied the following files to [_1]:',''.$desturl.'/'.$subdir.' ').
+ '
'."\n".
+ ''.join(' ',sort(keys(%newfile))).' '."\n");
+ foreach my $file (keys(%newfile)) {
+ my %storehash = (
+ 'priv' => $newfile{$file},
+ 'who' => $env{'user.name'}.':'.$env{'user.domain'},
+ );
+ if (exists($newresfile{$file})) {
+ $storehash{'res'} = 1;
+ }
+ &Apache::lonnet::store_userdata(\%storehash,$file,'copycourseauthor',$coursedom,$coursenum);
+ }
+ }
+ if (keys(%checkdeps)) {
+ my %missingdep;
+ foreach my $depfile (sort(keys(%checkdeps))) {
+ unless (-e "$desttop/$depfile") {
+ $missingdep{$depfile} = 1;
+ }
+ }
+ if (keys(%missingdep)) {
+ $r->print(''.&mt('You may also need to copy the following missing dependencies for files copied to [_1]:',
+ ''.$desturl.'/'.$subdir.' ').
+ '
'."\n".
+ ''.join(' ',sort(keys(%missingdep))).' '."\n");
+ }
}
- close($copiedfile);
} else {
- $$message = 'Could not open destination file for '.$filename." \n";
+ $r->print(''.&mt('No currently existing files or directories in Course Authoring Space selected for copying').'
');
+ $r->print(&endContentScreen());
+ return '';
}
} else {
- $$message = 'Could not determine name of file for '.$symb." \n";
- }
- if ($repstatus eq 'ok') {
- $content_name = 'resources/'.$count.'/'.$filename;
- }
- return $content_name;
-}
-
-sub extract_media {
- my ($url,$cdom,$cnum,$content,$count,$tempexport,$href,$message,$caller) = @_;
- my ($dirpath,$container);
- my %allfiles = ();
- my %codebase = ();
- if ($url =~ m-(.*/)([^/]+)$-) {
- $dirpath = $1;
- $container = $2;
- } else {
- $dirpath = $url;
- $container = '';
- }
- &Apache::lonnet::extract_embedded_items(undef,\%allfiles,\%codebase,$content);
- foreach my $embed_file (keys(%allfiles)) {
- my $filename;
- if ($embed_file =~ m#([^/]+)$#) {
- $filename = $1;
- } else {
- $filename = $embed_file;
+ my $chkname = 'copytouser';
+ my $context = 'crsauthored';
+ my (%subdirs,%files,@dirs_by_depth,@files_by_depth,%parent,%children,%hierarchy,@checked_maps);
+ &Apache::lonnet::recursedirs($is_course_home,1,undef,$exclude,0,0,$srcurl,'',\%subdirs,\%files,1);
+ 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;
}
- my $newname = 'res/'.$filename;
- my ($rtncode,$embed_content,$repstatus);
- my $embed_url;
- if ($embed_file =~ m-^/-) {
- $embed_url = $embed_file; # points to absolute path
- } else {
- if ($embed_file =~ m-https?://-) {
- next; # points to url
+ foreach my $path (keys(%files)) {
+ next if ($path eq '');
+ my $depth;
+ if ($path eq '/') {
+ $depth = 0;
} else {
- $embed_url = $dirpath.$embed_file; # points to relative path
+ $depth = scalar(split(/\//,$path));
+ }
+ if (ref($files{$path}) eq 'HASH') {
+ foreach my $file (keys(%{$files{$path}})) {
+ $files_by_depth[$depth]{$path}{$file} = $files{$path}{$file};
+ }
}
}
- if ($caller eq 'resource') {
- my $respath = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res';
- my $embed_path = &Apache::lonnet::filelocation($respath,$embed_url);
- $embed_content = &Apache::lonnet::getfile($embed_path);
- unless ($embed_content eq -1) {
- $repstatus = 'ok';
+ my ($info,$display,$onsubmit,$togglebuttons,$disabled);
+ my (%resdirs,%resfiles);
+ &Apache::lonnet::recursedirs($is_course_home,1,undef,$res_exclude,0,0,$resurl,'',\%resdirs,\%resfiles);
+ my $numpub = 0;
+ if (keys(%resfiles)) {
+ foreach my $dir (keys(%resfiles)) {
+ if (ref($resfiles{$dir}) eq 'HASH') {
+ foreach my $file (keys(%{$resfiles{$dir}})) {
+ if (exists($files{$dir}{$file})) {
+ $numpub ++;
+ }
+ }
+ }
}
- } elsif ($caller eq 'uploaded') {
-
- $repstatus = &Apache::lonnet::getuploaded('GET',$embed_url,$cdom,$cnum,\$embed_content,$rtncode);
}
- if ($repstatus eq 'ok') {
- my $destination = $tempexport.'/resources/'.$count.'/res';
- if (!-e "$destination") {
- mkdir($destination,0755);
+ if ($readonly) {
+ $disabled = ' disabled="disabled"';
+ }
+ if ($disabled) {
+ $togglebuttons = ' ';
+ } else {
+ $togglebuttons = ' '.
+ ' ';
+ }
+ my $preamble = &authorspace_selector($r,$formname,$home,$title,%outhash).
+ &courseresource_options($formname,$numpub).
+ '
'."\n";
+ my $display = '