--- loncom/interface/londocs.pm 2023/07/11 22:24:29 1.702
+++ loncom/interface/londocs.pm 2024/12/28 12:19:21 1.715
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.702 2023/07/11 22:24:29 raeburn Exp $
+# $Id: londocs.pm,v 1.715 2024/12/28 12:19:21 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -48,6 +48,7 @@ use Apache::lonpublisher();
use Apache::loncourserespicker();
use HTML::Entities;
use HTML::TokeParser;
+use HTML::LCParser;
use GDBM_File;
use File::MMagic;
use File::Copy;
@@ -102,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;
@@ -118,7 +120,6 @@ 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;
@@ -263,11 +264,12 @@ ENDJS
add_entries => {'onload' => "hide_searching();"},
};
}
- $r->print(&Apache::loncommon::start_page('Copy '.$crstype.' Content to Authoring Space',$js,$starthash)."\n".
- &Apache::lonhtmlcommon::breadcrumbs('Copy '.$crstype.' Content to Authoring Space')."\n");
+ $r->print(&Apache::loncommon::start_page('Copy uploaded content to Authoring Space',$js,$starthash)."\n".
+ &Apache::lonhtmlcommon::breadcrumbs('Copy uploaded content to Authoring Space')."\n");
$r->print(&startContentScreen('tools'));
my ($home,$other,%outhash)=&authorhosts();
unless ($home) {
+ $r->print('
'.&mt('No author or co-author roles on this server.').'
');
$r->print(&endContentScreen());
return '';
}
@@ -276,7 +278,8 @@ ENDJS
if (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) {
# Do the dumping
unless ($outhash{'home_'.$env{'form.authorspace'}}) {
- $r->print(&endContentScreen());
+ $r->print(''.&mt('Selected Authoring Space is not on this server.').'
'.
+ &endContentScreen());
return '';
}
my ($ca,$cd)=split(/\:/,$env{'form.authorspace'});
@@ -572,49 +575,13 @@ $contents{webreferences}.'
if (!ref($navmap)) {
$r->print($errormsg);
} else {
- $r->print(''.&mt('Searching ...').'
');
- $r->rflush();
- my ($preamble,$formname);
- $formname = 'dumpdoc';
- unless ($home==1) {
- $preamble = ''.
- '
'."\n";
- }
my $title=$origcrsdata{'description'};
$title=~s/[\/\s]+/\_/gs;
$title=&clean($title);
- $preamble .= ''.
- '
'."\n";
- my %uploadedfiles;
+ my $formname = 'dumpdoc';
+ my $preamble = &authorspace_selector($r,$formname,$home,$title,%outhash).
+ ''."\n";
+ my %uploadedfiles;
&tiehash();
foreach my $file (&Apache::lonclonecourse::crsdirlist($origcrsid,'userfiles')) {
my ($ext)=($file=~/\.(\w+)$/);
@@ -640,6 +607,48 @@ $contents{webreferences}.'
$r->print(&endContentScreen());
}
+sub authorspace_selector {
+ my ($r,$formname,$home,$title,%outhash) = @_;
+ $r->print(''.&mt('Searching ...').'
'."\n");
+ $r->rflush();
+ my $preamble;
+ unless ($home==1) {
+ $preamble = ''.
+ '
'."\n";
+ }
+ $preamble .= ''.
+ '
'."\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'));
@@ -684,6 +693,819 @@ sub recurse_html {
return;
}
+sub copycrsauthored {
+ my ($r,$coursenum,$coursedom,$coursehome,$readonly) = @_;
+ my ($starthash,$js,$title,$formname);
+ my %origcrsdata=&Apache::lonnet::coursedescription($env{'request.course.id'});
+ $title=$origcrsdata{'description'};
+ $title=~s/[\/\s]+/\_/gs;
+ $title=&clean($title);
+ my ($home,$other,%outhash)=&authorhosts();
+ unless (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) {
+ my %js_lt;
+ $formname = 'copycrsauthored';
+ if ($home) {
+ %js_lt =
+ &Apache::lonlocal::texthash(
+ yomu => 'You must select an Authoring Space',
+ whco => 'When Copyright set to "custom", URL of a published rights file is needed.',
+ );
+ &js_escape(\%js_lt);
+ }
+ if ($home > 1) {
+ $js = <<"ENDJS";
+
+
+ENDJS
+ } elsif ($home) {
+ $js = <<"ENDJS";
+
+
+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 {
+ 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);
+ $r->print(''.&mt('Copy to: [_1]',
+ ''.$desturl.'/'.$subdir.'').
+ '
'."\n");
+ if (keys(%dirs_to_make)) {
+ 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.'').
+ '
'."\n");
+ }
+ }
+ } else {
+ $notopdir = 1;
+ }
+ }
+ 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 '')) {
+ if ($is_course_home) {
+ if (&File::Copy::copy($src,$dest)) {
+ $newfile{$file} = 1;
+ }
+ } else {
+ if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file,$dest) eq 'ok') {
+ $newfile{$file} = 1;
+ }
+ }
+ if ($newfile{$file}) {
+ my $gotmeta;
+ if ($is_course_home) {
+ if ((-e $src.'.meta') && (!-e $dest.'.meta')) {
+ if (&File::Copy::copy($src.'.meta',$dest.'.meta')) {
+ $gotmeta = 1;
+ }
+ }
+ } else {
+ if (&Apache::lonnet::repcopy_crsprivfile($srcurl.'/'.$file.'.meta',$dest.'.meta') eq 'ok') {
+ $gotmeta = 1;
+ }
+ }
+ if ($gotmeta) {
+ if (open(my $fh,'<',$dest.'.meta')) {
+ my ($output,$now,setsourceavail);
+ $now = time;
+ if (($file =~ /\.(xml|html|htm|xhtml|xhtm)$/i) || ($file =~ /$LONCAPA::assess_re/)) {
+ $setsourceavail = 1;
+ }
+ while (my $line=<$fh>) {
+ chomp($line);
+ if ($line eq "$coursenum:$coursedom") {
+ $output .= "$ca:$cd\n";
+ } elsif ($line eq 'custom') {
+ $output .= "$copyright\n";
+ } elsif ($line =~ m{^\d+$}) {
+ $output .= "$now\n";
+ } elsif ($line eq "/res/$coursedom/$coursenum/default.rights") {
+ $output .= "$customdistfile\n";
+ } elsif ($line =~ m{^(open|closed)$}) {
+ if ($setsourceavail) {
+ $output .= "$sourceavail\n";
+ }
+ } elsif ($line eq "$coursedom") {
+ $output .= "$cd\n";
+ } elsif ($line =~ m{^\d+$}) {
+ $output .= "$now\n";
+ } elsif ($line =~ m{^$match_username:$match_domain$}) {
+ $output .= "$env{'user.name'}:$env{'user.domain'}\n";
+ } elsif ($line eq "$coursenum:$coursedom") {
+ $output .= "$ca:$cd\n";
+ } elsif ($line =~ m{^(.+)$}) {
+ my @deps = split(/\s*,\s*/,$1);
+ my @newdeps;
+ my $changed = 0;
+ foreach my $dep (@deps) {
+ if ($dep =~ m{^/res/$coursedom/$coursenum/(.+)$}) {
+ my $rest = $1;
+ push(@newdeps,"/res/$cd/$ca/$rest");
+ $checkdeps{$rest} = 1;
+ $changed ++;
+ } else {
+ push(@newdeps,$dep);
+ }
+ }
+ if ($changed) {
+ $output .= ''.join(',',@newdeps).''."\n";
+ }
+ } else {
+ $output .= "$line\n";
+ }
+ }
+ close($fh);
+ if (open(my $fh,'>',$dest.'.meta')) {
+ print $fh $output;
+ close($fh);
+ }
+ }
+ }
+ my ($ext) = ($file =~ /\.(\w+)$/);
+ my $embstyle=&Apache::loncommon::fileembstyle($ext);
+ if ($embstyle eq 'ssi') {
+ my $outstring='';
+ my $changes = 0;
+ my @parser;
+ $parser[0]=HTML::LCParser->new($dest);
+ $parser[-1]->xml_mode(1);
+ my $token;
+ while (@parser) {
+ while ($token=$parser[-1]->get_token) {
+ if ($token->[0] eq 'S') {
+ my $tag=$token->[1];
+ my $lctag=lc($tag);
+ my %parms=%{$token->[2]};
+ foreach my $type ('src','href','background','bgimg') {
+ foreach my $key (keys(%parms)) {
+ if ($key =~ /^$type$/i) {
+ next if (($lctag eq 'img') && ($type eq 'src') &&
+ ($parms{$key} =~ m{^data\:image/gif;base64,}));
+ if ($parms{$key} =~ m{^\Q/res/$coursedom/$coursenum/\E}si) {
+ $parms{$key} =~ s{^\Q/res/$coursedom/$coursenum/\E}{/res/$cd/$ca/$subdir/}si;
+ $changes ++;
+ }
+ }
+ }
+ }
+ # probably a image type