--- loncom/interface/londocs.pm 2009/02/16 10:33:32 1.343
+++ loncom/interface/londocs.pm 2013/05/23 15:06:39 1.484.2.34
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.343 2009/02/16 10:33:32 biermanm Exp $
+# $Id: londocs.pm,v 1.484.2.34 2013/05/23 15:06:39 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,16 @@ 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 HTML::Entities;
+use HTML::TokeParser;
use GDBM_File;
use Apache::lonlocal;
use Cwd;
@@ -67,12 +69,16 @@ 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;
return ($errtext,0);
}
@@ -100,12 +106,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,44 +125,34 @@ 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;
- return $title;
+ return $title;
}
sub dumpcourse {
my ($r) = @_;
- my $type = &Apache::loncommon::course_type();
- $r->print(&Apache::loncommon::start_page('Dump '.$type.' DOCS to Construction Space').
- '');
+ '');
}
+ $r->print(&endContentScreen());
}
-
-
-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 IMS '.lc($type).' archive
',$imszipfile,);
- 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);
- }
- }
- }
-# 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);
- }
- }
- }
-}
-
-sub process_content {
- my ($count,$curRes,$cdom,$cnum,$symb,$content_file,$href,$copyresult,$tempexport) = @_;
- my $content_type;
- my $message;
- my @uploads = ();
- if ($curRes->is_sequence()) {
- $content_type = 'sequence';
- } elsif ($curRes->is_page()) {
- $content_type = 'page'; # need to handle individual items in pages.
- } elsif ($symb =~ m-public/$cdom/$cnum/syllabus$-) {
- $content_type = 'syllabus';
- my $contents = &Apache::imsexport::templatedpage($content_type);
- if ($contents) {
- $$content_file = &store_template($contents,$tempexport,$count,$content_type);
- }
- } elsif ($symb =~ m-\.sequence___\d+___ext-) {
- $content_type = 'external';
- my $title = $curRes->title;
- my $contents = &Apache::imsexport::external($symb,$title);
- if ($contents) {
- $$content_file = &store_template($contents,$tempexport,$count,$content_type);
- }
- } elsif ($symb =~ m-adm/navmaps$-) {
- $content_type = 'navmap';
- } elsif ($symb =~ m-adm/[^/]+/[^/]+/(\d+)/smppg$-) {
- $content_type = 'simplepage';
- my $contents = &Apache::imsexport::templatedpage($content_type,$1,$count,\@uploads);
- if ($contents) {
- $$content_file = &store_template($contents,$tempexport,$count,$content_type);
- }
- } elsif ($symb =~ m-lib/templates/simpleproblem\.problem$-) {
- $content_type = 'simpleproblem';
- my $contents = &Apache::imsexport::simpleproblem($symb);
- if ($contents) {
- $$content_file = &store_template($contents,$tempexport,$count,$content_type);
- }
- } elsif ($symb =~ m-lib/templates/examupload\.problem$-) {
- $content_type = 'examupload';
- } elsif ($symb =~ m-adm/($match_domain)/($match_username)/(\d+)/bulletinboard$-) {
- $content_type = 'bulletinboard';
- my $contents = &Apache::imsexport::templatedpage($content_type,$3,$count,\@uploads,$1,$2);
- if ($contents) {
- $$content_file = &store_template($contents,$tempexport,$count,$content_type);
- }
- } elsif ($symb =~ m-adm/([^/]+)/([^/]+)/aboutme$-) {
- $content_type = 'aboutme';
- my $contents = &Apache::imsexport::templatedpage($content_type,undef,$count,\@uploads,$1,$2);
- if ($contents) {
- $$content_file = &store_template($contents,$tempexport,$count,$content_type);
- }
- } elsif ($symb =~ m-\.(sequence|page)___\d+___uploaded/$cdom/$cnum/-) {
- $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded');
- } elsif ($symb =~ m-\.(sequence|page)___\d+___([^/]+)/([^/]+)-) {
- my $canedit = 0;
- if ($2 eq $env{'user.domain'} && $3 eq $env{'user.name'}) {
- $canedit= 1;
- }
-# only include problem code where current user is author
- if ($canedit) {
- $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'resource');
- } else {
- $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'noedit');
- }
- } elsif ($symb =~ m-uploaded/$cdom/$cnum-) {
- $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded');
- }
- if (@uploads > 0) {
- foreach my $item (@uploads) {
- my $uploadmsg = '';
- &replicate_content($cdom,$cnum,$tempexport,$item,$count,\$uploadmsg,$href,'templateupload');
- if ($uploadmsg) {
- $$copyresult .= $uploadmsg."\n";
- }
- }
- }
- if ($message) {
- $$copyresult .= $message."\n";
- }
-}
-
-sub replicate_content {
- my ($cdom,$cnum,$tempexport,$symb,$count,$message,$href,$caller) = @_;
- my ($map,$ind,$url);
- if ($caller eq 'templateupload') {
- $url = $symb;
- $url =~ s#//#/#g;
- } else {
- ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
- }
- my $content;
- my $filename;
- my $repstatus;
- my $content_name;
- if ($url =~ m-/([^/]+)$-) {
- $filename = $1;
- if (!-e $tempexport.'/resources') {
- mkdir($tempexport.'/resources',0700);
- }
- if (!-e $tempexport.'/resources/'.$count) {
- mkdir($tempexport.'/resources/'.$count,0700);
- }
- my $destination = $tempexport.'/resources/'.$count.'/'.$filename;
- my $copiedfile;
- if ($copiedfile = Apache::File->new('>'.$destination)) {
- my $content;
- if ($caller eq 'resource') {
- my $respath = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res';
- my $filepath = &Apache::lonnet::filelocation($respath,$url);
- $content = &Apache::lonnet::getfile($filepath);
- if ($content eq -1) {
- $$message = 'Could not copy file '.$filename;
- } else {
- &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'resource');
- $repstatus = 'ok';
- }
- } 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');
- }
- } else {
- $$message = 'Could not render '.$url.' server message - '.$rtncode."
\n";
- }
- } 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;
- }
- close($copiedfile);
- } else {
- $$message = 'Could not open destination file for '.$filename."
\n";
- }
- } 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 $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
- } else {
- $embed_url = $dirpath.$embed_file; # points to relative path
- }
- }
- 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';
- }
- } 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);
- }
- $destination .= '/'.$filename;
- my $copiedfile;
- if ($copiedfile = Apache::File->new('>'.$destination)) {
- print $copiedfile $embed_content;
- push(@{$href},'resources/'.$count.'/res/'.$filename);
- my $attrib_regexp = '';
- if (@{$allfiles{$embed_file}} > 1) {
- $attrib_regexp = join('|',@{$allfiles{$embed_file}});
- } else {
- $attrib_regexp = $allfiles{$embed_file}[0];
- }
- $$content =~ s#($attrib_regexp\s*=\s*['"]?)\Q$embed_file\E(['"]?)#$1$newname$2#gi;
- if ($caller eq 'resource' && $container =~ /\.(problem|library)$/) {
- $$content =~ s#\Q$embed_file\E#$newname#gi;
- }
- }
- } else {
- $$message .= 'replication of embedded file - '.$embed_file.' in '.$url.' failed, reason -'.$rtncode."
\n";
- }
- }
- return;
-}
-
-sub store_template {
- my ($contents,$tempexport,$count,$content_type) = @_;
- if ($contents) {
- if ($tempexport) {
- if (!-e $tempexport.'/resources') {
- mkdir($tempexport.'/resources',0700);
- }
- if (!-e $tempexport.'/resources/'.$count) {
- mkdir($tempexport.'/resources/'.$count,0700);
- }
- my $destination = $tempexport.'/resources/'.$count.'/'.$content_type.'.xml';
- my $storetemplate;
- if ($storetemplate = Apache::File->new('>'.$destination)) {
- print $storetemplate $contents;
- close($storetemplate);
- }
- if ($content_type eq 'external') {
- return 'resources/'.$count.'/'.$content_type.'.html';
- } else {
- return 'resources/'.$count.'/'.$content_type.'.xml';
- }
- }
- }
-}
-
-
sub group_import {
my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_;
-
+ my ($donechk,$allmaps,%hierarchy,%titles,%addedmaps,%removefrommap,
+ %removeparam,$importuploaded,$fixuperrors);
+ $allmaps = {};
while (@files) {
my ($name, $url, $residx) = @{ shift(@files) };
- if (($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$})
+ if (($url =~ m{^/uploaded/\Q$coursedom\E/\Q$coursenum\E/(default_\d+\.)(page|sequence)$})
&& ($caller eq 'londocs')
&& (!&Apache::lonnet::stat_file($url))) {
-
+
my $errtext = '';
my $fatal = 0;
my $newmapstr = '