--- loncom/interface/londocs.pm 2009/06/09 18:42:42 1.371
+++ loncom/interface/londocs.pm 2013/12/31 15:20:31 1.484.2.48
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.371 2009/06/09 18:42:42 tempelho Exp $
+# $Id: londocs.pm,v 1.484.2.48 2013/12/31 15:20:31 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,8 +26,6 @@
# http://www.lon-capa.org/
#
-
-
package Apache::londocs;
use strict;
@@ -35,12 +33,18 @@ 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 HTML::Entities;
+use HTML::TokeParser;
use GDBM_File;
use Apache::lonlocal;
use Cwd;
@@ -54,6 +58,7 @@ my $hashtied;
my %alreadyseen=();
my $hadchanges;
+my $suppchanges;
my %help=();
@@ -67,13 +72,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;
+ } else {
+ $suppchanges=1;
+ }
return ($errtext,0);
}
@@ -100,12 +113,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++;
}
}
@@ -114,22 +132,6 @@ sub authorhosts {
}
-sub dumpbutton {
- my ($home,$other,%outhash)=&authorhosts();
- my $type = &Apache::loncommon::course_type();
- if ($home+$other==0) { return ''; }
- if ($home) {
- return ''.
- &Apache::loncommon::help_open_topic('Docs_Dump_Course_Docs').' ';
- } else {
- return '
'.
- &mt('Dump '.$type.
- ' DOCS to Construction Space: available on other servers').
- '
';
- }
-}
-
sub clean {
my ($title)=@_;
$title=~s/[^\w\/\!\$\%\^\*\-\_\=\+\;\:\,\\\|\`\~]+/\_/gs;
@@ -140,804 +142,453 @@ sub clean {
sub dumpcourse {
my ($r) = @_;
- my $type = &Apache::loncommon::course_type();
- $r->print(&Apache::loncommon::start_page('Dump '.$type.' DOCS to Construction Space').
- '');
- }
-}
-
-
-
-sub exportbutton {
- my $type = &Apache::loncommon::course_type();
- return ''.
- &Apache::loncommon::help_open_topic('Docs_Export_Course_Docs').' ';
-}
-
-
-
-sub exportcourse {
- my $r=shift;
- my $type = &Apache::loncommon::course_type();
- my %discussiontime = &Apache::lonnet::dump('discussiontimes',
- $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'});
- my $numdisc = keys(%discussiontime);
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (!defined($navmap)) {
- $r->print(&Apache::loncommon::start_page('Export '.lc($type).' to IMS content package').
- '
IMS Export Failed
'.
- '
'.
- &mt('Unable to retrieve information about course contents').
- '
'.&mt('Return to Course Editor').'');
- &Apache::lonnet::logthis('IMS export failed - could not create navmap object in '.lc($type).':'.$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 = ' As you did not select any content items or discussions for export, an IMS package has not been created. Please go back to select either content items or discussions for export';
- } else {
- my $now = time;
- my %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('Download the zip file from [_1]IMS '.lc($type).' archive[_2]'
- ,'','')
- .'
';
- 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 this posts at this time, because there was a problem creating a manifest file.').' ';
- }
- }
- $r->print(&Apache::loncommon::start_page('Export '.lc($type).' to IMS content package'));
- $r->print(&Apache::lonhtmlcommon::breadcrumbs('Export '.lc($type).' to IMS content package'));
- $r->print($outcome);
- $r->print(&Apache::loncommon::end_page());
- } else {
- my $display;
- $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);
+ 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);
}
- }
- }
-# 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';
+ 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 .= '