--- loncom/interface/londocs.pm 2006/05/30 20:09:25 1.229
+++ 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.229 2006/05/30 20:09:25 raeburn Exp $
+# $Id: londocs.pm,v 1.722 2025/01/07 21:01:37 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,17 +33,29 @@ 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::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 lib '/home/httpd/lib/perl/';
-use LONCAPA;
+use UUID::Tiny ':std';
+use LONCAPA qw(:DEFAULT :match);
my $iconpath;
@@ -53,1229 +65,5126 @@ 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;
+ } elsif ($contentchg) {
+ $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)\.(.+)$/) {
+ my @ids=&Apache::lonnet::current_machine_ids();
+ 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'};
} 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();
- my $type = 'Course';
- if (defined($env{'course.'.$env{'request.course.id'}.'.type'})) {
- $type = $env{'course.'.$env{'request.course.id'}.'.type'};
- }
- if ($home+$other==0) { return ''; }
- my $output='
';
- if ($home) {
- return ' '.
- ' '.
- &Apache::loncommon::help_open_topic('Docs_Dump_Course_Docs');
- } else {
- return' '.
- &mt('Dump [_1] DOCS to Construction Space: available on other servers',
- $type);
- }
-}
sub clean {
my ($title)=@_;
$title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;
- return $title;
+ 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;
}
-# -------------------------------------------------------- Actually dump course
sub dumpcourse {
my ($r) = @_;
- my $type = 'Course';
- if (defined($env{'course.'.$env{'request.course.id'}.'.type'})) {
- $type = $env{'course.'.$env{'request.course.id'}.'.type'};
+ my $crstype = &Apache::loncommon::course_type();
+ my ($starthash,$js);
+ unless (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) {
+ $js = <<"ENDJS";
+
+ENDJS
+ $starthash = {
+ add_entries => {'onload' => "hide_searching();"},
+ };
+ }
+ $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) { return ''; }
+ unless ($home) {
+ $r->print(''.&mt('No author or co-author roles on this server.').'
');
+ $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'}}) { return ''; }
- my ($ca,$cd)=split(/\@/,$env{'form.authorspace'});
+ 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'});
$r->print(''.&mt('Copying Files').' ');
my $title=$env{'form.authorfolder'};
$title=&clean($title);
- my %replacehash=();
- foreach (keys %env) {
- if ($_=~/^form\.namefor\_(.+)/) {
- $replacehash{$1}=$env{$_};
- }
+ 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;
- foreach (keys %replacehash) {
- my $newfilename=$title.'/'.$replacehash{$_};
- $newfilename=~s/\.(\w+)$//;
- my $ext=$1;
- $newfilename=&clean($newfilename);
- $newfilename.='.'.$ext;
- my @dirs=split(/\//,$newfilename);
- my $path='/home/'.$ca.'/public_html';
- 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(''.$_.' => '.$newfilename.' : ');
- if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) {
- if ($_=~/\.(sequence|page|html|htm|xml|xhtml)$/) {
- print $fh &Apache::loncreatecourse::rewritefile(
- &Apache::loncreatecourse::readfile($env{'request.course.id'},$_),
- (%replacehash,$crs => '')
- );
- } else {
- print $fh
- &Apache::loncreatecourse::readfile($env{'request.course.id'},$_);
- }
- $fh->close();
- } else {
- $fail=1;
- }
- if ($fail) {
- $r->print('fail ');
- } else {
- $r->print('ok ');
- }
- }
+ 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 = '
+
+
+'.$pagetitle.'
+
+';
+ if ($contents{title}) {
+ $content .= "\n".''.$contents{title}.' ';
+ }
+ if ($contents{image}) {
+ $content .= "\n".$contents{image};
+ }
+ if ($contents{content}) {
+ $content .= '
+
+
'.&mt('Content').' '.
+$contents{content}.'
+';
+ }
+ if ($contents{webreferences}) {
+ $content .= '
+
+
'.&mt('Web References').' '.
+$contents{webreferences}.'
+';
+ }
+ $content .= '
+
+
+';
+ $newcontent{'/'.$simplepages{$item}{res}} = $content;
+ }
+ }
+ foreach my $item (keys(%tocopy)) {
+ unless ($item=~/\.(sequence|page)$/) {
+ my $currurlpath = $prefix.$item;
+ my $currdirpath = &Apache::lonnet::filelocation('',$currurlpath);
+ &recurse_html($mm,$prefix,$currdirpath,$currurlpath,$item,$lookup{$item},\%replacehash,\%deps);
+ }
+ }
+ foreach my $num (sort {$a <=> $b} (@todump)) {
+ my $src = $display{$num};
+ next if ($src eq '');
+ my @needcopy = ();
+ if ($replacehash{$src}) {
+ push(@needcopy,$src);
+ if (ref($deps{$num}) eq 'HASH') {
+ foreach my $dep (sort(keys(%{$deps{$num}}))) {
+ if ($replacehash{$dep}) {
+ push(@needcopy,$dep);
+ }
+ }
+ }
+ } elsif ($src =~ /^simpleproblem_/) {
+ push(@needcopy,$src);
+ }
+ next if (@needcopy == 0);
+ my ($result,$depresult);
+ for (my $i=0; $i<@needcopy; $i++) {
+ my $item = $needcopy[$i];
+ my $newfilename;
+ if ($simpleproblems{$num}) {
+ $newfilename=$title.'/'.$simpleproblems{$num}{'name'};
+ } else {
+ $newfilename=$title.'/'.$replacehash{$item};
+ }
+ $newfilename=~s/\.(\w+)$//;
+ my $ext=$1;
+ $newfilename=&clean($newfilename);
+ $newfilename.='.'.$ext;
+ my ($newrelpath) = ($newfilename =~ m{^\Q$title/\E(.+)$});
+ if ($newrelpath ne $replacehash{$item}) {
+ $replacehash{$item} = $newrelpath;
+ }
+ my @dirs=split(/\//,$newfilename);
+ my $path=$r->dir_config('lonDocRoot')."/priv/$cd/$ca";
+ my $makepath=$path;
+ my $fail;
+ my $origin;
+ for (my $i=0;$i<$#dirs;$i++) {
+ $makepath.='/'.$dirs[$i];
+ unless (-e $makepath) {
+ unless(mkdir($makepath,0755)) {
+ $fail = &mt('Directory creation failed.');
+ }
+ }
+ }
+ if ($i == 0) {
+ $result = ''.$item.' => '.$newfilename.' : ';
+ } else {
+ $depresult .= ''.$item.' => '.$newfilename.' '.
+ ''.
+ &mt('(dependency)').' : ';
+ }
+ if (-e $path.'/'.$newfilename) {
+ $fail = &mt('Destination already exists -- not overwriting.');
+ } else {
+ if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) {
+ if (($item =~ m{^/adm/$match_domain/$match_username/\d+/smppg}) ||
+ ($item =~ /^simpleproblem_/)) {
+ print $fh $newcontent{$item};
+ } else {
+ my $fileloc = &Apache::lonnet::filelocation('',$prefix.$item);
+ if (-e $fileloc) {
+ if ($item=~/\.(sequence|page|html|htm|xml|xhtml)$/) {
+ if ((($1 eq 'sequence') || ($1 eq 'page')) &&
+ (ref($has_simpleprobs{$item}) eq 'HASH')) {
+ my %changes = %{$has_simpleprobs{$item}};
+ my $content = &Apache::lonclonecourse::rewritefile(
+ &Apache::lonclonecourse::readfile($env{'request.course.id'},$item),
+ (%replacehash,$crs => '')
+ );
+ my $updatedcontent = '';
+ my $parser = HTML::TokeParser->new(\$content);
+ $parser->attr_encoded(1);
+ while (my $token = $parser->get_token) {
+ if ($token->[0] eq 'S') {
+ if (($token->[1] eq 'resource') &&
+ ($token->[2]->{'src'} eq '/res/lib/templates/simpleproblem.problem') &&
+ ($changes{$token->[2]->{'id'}})) {
+ my $id = $token->[2]->{'id'};
+ $updatedcontent .= '<'.$token->[1];
+ foreach my $attrib (@{$token->[3]}) {
+ next unless ($attrib =~ /^(src|type|title|id)$/);
+ if ($attrib eq 'src') {
+ my ($file) = ($display{$changes{$id}} =~ /^\Qsimpleproblem_\E(.+)$/);
+ if ($file) {
+ $updatedcontent .= ' '.$attrib.'="'.$file.'"';
+ } else {
+ $updatedcontent .= ' '.$attrib.'="'.$token->[2]->{$attrib}.'"';
+ }
+ } else {
+ $updatedcontent .= ' '.$attrib.'="'.$token->[2]->{$attrib}.'"';
+ }
+ }
+ $updatedcontent .= ' />'."\n";
+ } else {
+ $updatedcontent .= $token->[4]."\n";
+ }
+ } else {
+ $updatedcontent .= $token->[2];
+ }
+ }
+ print $fh $updatedcontent;
+ } else {
+ 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);
+ }
+ } else {
+ $fail = &mt('Source does not exist.');
+ }
+ }
+ $fh->close();
+ } else {
+ $fail = &mt('Could not write to destination.');
+ }
+ }
+ my $text;
+ if ($fail) {
+ $text = ''.&mt('fail').(' 'x3).$fail.' ';
+ } else {
+ $text = ''.&mt('ok').' ';
+ }
+ if ($i == 0) {
+ $result .= $text;
+ } else {
+ $depresult .= $text.' ';
+ }
+ }
+ $r->print($result);
+ if ($depresult) {
+ $r->print('');
+ }
+ }
} else {
-# Input form
- unless ($home==1) {
- $r->print(
- ''.&mt('Select the Construction Space').' ');
- }
- foreach (sort keys %outhash) {
- if ($_=~/^home_(.+)$/) {
- if ($home==1) {
- $r->print(
- ' ');
- } else {
- $r->print(''.$1.' - '.
- &Apache::loncommon::plainname(split(/\@/,$1)).' ');
- }
- }
- }
- unless ($home==1) {
- $r->print(' ');
- }
- my $title=$origcrsdata{'description'};
- $title=~s/[\/\s]+/\_/gs;
- $title=&clean($title);
- $r->print(''.&mt('Folder in Construction Space').' ');
- &tiehash();
- $r->print(''.&mt('Filenames in Construction Space').' \n");
- &untiehash();
- $r->print(
- '
');
+ 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+)$/);
+# 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());
}
-# ------------------------------------------------------ Generate "export" button
+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 {
+ $preamble .= ''.$user.' - '.
+ &Apache::loncommon::plainname(split(/\:/,$user)).' ';
+ }
+ }
+ unless ($home==1) {
+ $preamble .= ' '."\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);
+ }
+ }
+ }
+ }
+ return;
+}
-sub exportbutton {
- my $type = 'Course';
- if (defined($env{'course.'.$env{'request.course.id'}.'.type'})) {
- $type = $env{'course.'.$env{'request.course.id'}.'.type'};
+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,%newresfile);
+ $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 '')) {
+ 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");
+ }
+ }
+ } else {
+ $r->print(''.&mt('No currently existing files or directories in Course Authoring Space selected for copying').'
');
+ $r->print(&endContentScreen());
+ return '';
+ }
+ } else {
+ 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;
+ }
+ 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} = $files{$path}{$file};
+ }
+ }
+ }
+ 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 ++;
+ }
+ }
+ }
+ }
+ }
+ 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 = '