--- loncom/interface/londocs.pm 2004/09/14 01:21:49 1.142 +++ loncom/interface/londocs.pm 2004/09/14 21:27:36 1.143 @@ -1,7 +1,7 @@ # The LearningOnline Network # Documents # -# $Id: londocs.pm,v 1.142 2004/09/14 01:21:49 raeburn Exp $ +# $Id: londocs.pm,v 1.143 2004/09/14 21:27:36 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,6 +40,7 @@ use Apache::lonnavmaps; use HTML::Entities; use GDBM_File; use Apache::lonlocal; +use Cwd; my $iconpath; @@ -254,6 +255,7 @@ sub exportcourse { my $navmap = Apache::lonnavmaps::navmap->new(); my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef); my $curRes; + my $outcome; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['finishexport']); @@ -277,29 +279,49 @@ sub exportcourse { $discussions[0] = $ENV{'form.discussion'}; } } - my $curRes; - my $count; - my %symbs; - my $display; - while ($curRes = $it->next()) { - if (ref($curRes)) { - $count ++; - $symbs{$count} = $curRes->symb(); - if (grep/^$count$/,@exportitems) { - $display.= 'Export content item '.$curRes->title()."
\n"; + 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 $count = 0; + 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'; +# zip can cause an sh launch which can pass along all of %ENV +# which can be too large for /bin/sh to handle + my %oldENV=%ENV; + undef(%ENV); + my $cwd = &Cwd::getcwd(); + my $imszip = '/home/httpd/'.$imszipfile; + chdir $tempexport; + open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); + close(OUTPUT); + chdir $cwd; + %ENV=%oldENV; + undef(%oldENV); + $outcome .= 'Download the zip file from IMS course archive
'; + if ($copyresult) { + $outcome .= 'The following errors occurred during export - '.$copyresult; } - if (grep/^$count$/,@discussions) { - $display.= 'Export discussion posts '.$curRes->title()."
\n"; - } + } else { + $outcome = '
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('Export Course'. - &Apache::loncommon::bodytag('Export course to IMS or SCORM content package' -)); - - my $exportfile; - $r->print($display); + &Apache::loncommon::bodytag('Export course to IMS or SCORM content package')); + $r->print($outcome); $r->print(''); } else { my $display; @@ -433,6 +455,255 @@ function containerCheck(item) { } } +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); + } +# 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". +' '."\n". +' '."\n". +' '.$ENV{'request.'.$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{'request.'.$ENV{'request.course.id'}.'.num'}; + my $cdom = $ENV{'request.'.$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; + if ($curRes == $it->BEGIN_MAP()) { + $prevdepth = $depth; + $depth++; + } + if ($curRes == $it->END_MAP()) { + $prevdepth = $depth; + $depth--; + } + + if (ref($curRes)) { + 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.'"'; + } + if (($depth <= $prevdepth) && ($count > 1)) { + print $ims_manifest ' '."\n"; + } + $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 (@hrefs) { + $imsresources .= + ' '."\n"; + } + $imsresources .= ' '."\n"; + } + } + $pkgdepth = $depth; + } + } + while ($pkgdepth > -1) { + 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) { + unless (grep/^$$parent{$depth}$/,@$exportitems || grep/^$$parent{$depth}$/,@$dependencies) { + push @$dependencies, $$parent{$depth}; + if ($depth > 2) { + &get_dependencies($exportitems,$parent,$depth-1,$dependencies); + } + } + } +} + +sub process_content { + my ($count,$curRes,$cdom,$cnum,$symb,$content_file,$href,$copyresult,$tempexport) = @_; + my $content_type; + my $message; +# find where user is author or co-author + my %roleshash = &Appache::lonnet::get_my_roles(); + if ($curRes->is_page()) { + $content_type = 'page'; + } elsif ($symb =~ m-public/$cdom/$cnum/syllabus$-) { + $content_type = 'syllabus'; + } elsif ($symb =~ m-\.sequence____\d+____ext-) { + $content_type = 'external'; + } elsif ($symb =~ m-adm/navmaps$-) { + $content_type = 'navmap'; + } elsif ($symb =~ m-adm/$cdom/$cnum/\d+/smppg$-) { + $content_type = 'simplepage'; + } elsif ($symb =~ m-$-) { + $content_type = 'simpleproblem'; + } elsif ($symb =~ m-adm/$cdom/$cnum/\d+/bulletinboard$-) { + $content_type = 'bulletinboard'; + } elsif ($symb =~ m-adm/$cdom/$cnum/\d+/aboutme$-) { + $content_type = 'aboutme'; + } elsif ($symb =~ m-uploaded/$cdom/$cnum-) { + &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,'uploaded'); + } elsif ($symb =~ m-\.sequence____\d+____([^/])/([^/])-) { + my $coauth = $2.':'.$1.':ca'; + my $canedit = 0; + if ($1 eq $ENV{'user.domain'} && $2 eq $ENV{'user.name'}) { + $canedit= 1; + } elsif (defined($roleshash{$coauth})) { + if ($roleshash{$coauth} =~ /(\d+):(\d+)/) { + if (($1 < time || $1 == 0) && ($2 == 0 || $2 >= time)) { + $canedit = 1; + } + } elsif ($roleshash{$coauth} eq ':') { + $canedit = 1; + } + } + if ($canedit) { + &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,'resource'); + } else { + &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,'noedit'); + } + } + $$copyresult .= $message."\n"; +} + +sub replicate_content { + my ($cdom,$cnum,$tempexport,$symb,$count,$message,$caller) = @_; + my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); + my $feedurl = &Apache::lonnet::clutter($url); + + my $content; + my $filename; + my $repstatus; + if ($url =~ m-[^/]/(.+)$-) { + $filename = $1; + if (!-e $tempexport.'/resources') { + mkdir($tempexport.'/resources',0700); + } + if (!-e $tempexport.'/resources') { + mkdir($tempexport.'/resources/'.$count,0700); + } + my $destination = $$tempexport.'/resources/'.$count.'/'.$filename; + my $copiedfile; + if ($copiedfile = Apache::File->new('>'.$destination)) { + my $content; + if ($caller eq 'uploaded' || $caller eq 'resource') { + $content = &Apache::lonnet::getfile($url); + if ($content eq -1) { + $$message = 'Could not copy file '.$filename; + } else { + $repstatus = 'ok'; + } + } elsif ($caller eq 'noedit') { + my $rtncode; + $repstatus = &getuploaded('GET',$url,$cdom,$cnum,$content,$rtncode); + unless ($repstatus eq 'ok') { + $$message = 'Could not render '.$url.' server message - '.$rtncode; + } + } + if ($repstatus eq 'ok') { + print $copiedfile $content; + } + close($copiedfile); + } else { + $$message = 'Could not open destination file for '.$filename."\n"; + } + } else { + $$message = 'Could not determine name of file for '; + } + return $repstatus; +} # Imports the given (name, url) resources into the course # coursenum, coursedom, and folder must precede the list