[BACK]Return to imsexport.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / imspackages

Diff for /loncom/imspackages/imsexport.pm between versions 1.3 and 1.11

version 1.3, 2005/04/07 06:56:22 version 1.11, 2013/11/12 04:54:57
Line 1 Line 1
   # The LearningOnline Network
   #
   # $Id$
   #
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
 # This file is part of the LearningOnline Network with CAPA (LON-CAPA).  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
Line 25  package Apache::imsexport; Line 29  package Apache::imsexport;
   
 use strict;  use strict;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncommon;
   use Apache::lonhtmlcommon;
   use Apache::lonnavmaps;
   use Apache::loncourserespicker;
   use Apache::londocs;
   use Apache::lonlocal;
   use Cwd;
   use LONCAPA qw(:DEFAULT :match);
   
   sub exportcourse {
       my $r=shift;
       my $crstype = &Apache::loncommon::course_type();
       my ($navmap,$errormsg) = 
           &Apache::loncourserespicker::get_navmap_object($crstype,'imsexport'); 
       unless (ref($navmap)) {
           $r->print($errormsg);
           return;
       }
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                               ['finishexport']);
       if ($env{'form.finishexport'}) {
           &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                               ['archive','discussion']);
           my $outcome; 
           my $format = $env{'form.format'};
           my @exportitems = &Apache::loncommon::get_env_multiple('form.archive');
           my @discussions = &Apache::loncommon::get_env_multiple('form.discussion');
           if (@exportitems == 0 && @discussions == 0) {
               $outcome =
                   '<p class="LC_warning">'
                  .&mt('As you did not select any content items or discussions'
                      .' for export, an IMS package has not been created.')
                  .'</p>'
                  .'<p>'
                  .&mt('Please [_1]go back[_2] to select either content items'
                      .' or discussions for export.'
                          ,'<a href="javascript:history.go(-1)">'
                          ,'</a>')
                  .'</p>';
           } else {
               my $now = time;
               my %symbs;
               my $manifestok = 0;
               my $imsresources;
               my $tempexport;
               my $copyresult;
               my $testbank;
               my $ims_manifest = &create_ims_store($now,\$manifestok,\$outcome,\$tempexport,$format,\$testbank);
               if ($manifestok) {
                   &build_package($now,$navmap,\@exportitems,\@discussions,\$outcome,$tempexport,\$copyresult,$ims_manifest,$format,$testbank);
                   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 .= '<p>'
                              .&mt('[_1]Your IMS package[_2] is ready for download.'
                                  ,'<a href="'.$imszipfile.'">','</a>')
                              .'</p>';
                   if ($copyresult) {
                       $outcome .= '<p class="LC_error">'
                                  .&mt('The following errors occurred during export - [_1]'
                                      ,$copyresult)
                                  .'</p>';
                   }
               } else {
                   $outcome = '<p class="LC_error">'
                             .&mt('Unfortunately you will not be able to retrieve'
                                 .' an IMS archive of your course at this time,'
                                 .' because there was a problem creating a'
                                 .' manifest file.')
                             .'</p>'
                             .'<p><a href="javascript:history.go(-1)">'
                             .&mt('Go Back')
                             .'</a></p>';
               }
           }
           $r->print(&Apache::loncommon::start_page('Export '.$crstype.' to IMS Package'));
           $r->print(&Apache::lonhtmlcommon::breadcrumbs('IMS Export'));
           $r->print(&Apache::londocs::startContentScreen('tools')); 
           $r->print($outcome);
           $r->print(&Apache::londocs::endContentScreen());
           $r->print(&Apache::loncommon::end_page());
       } else {
           $r->print(&Apache::loncourserespicker::create_picker($navmap,'imsexport',
                                                                'exportdoc',$crstype));
       }
       return;
   }
   
   sub create_ims_store {
       my ($now,$manifestok,$outcome,$tempexport,$format,$testbank) = @_;
       $$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
   '<?xml version="1.0" encoding="UTF-8"?>'."\n".
   '<manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1"'.
   ' xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2"'.
   ' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"'.
   ' identifier="MANIFEST-'.$env{'request.course.id'}.'-'.$now.'"'.
   '  xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1imscp_v1p1.xsd'.
   '  http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd">'."\n".
   '  <metadata>
       <schema></schema>
       <imsmd:lom>
         <imsmd:general>
           <imsmd:identifier>'.$env{'request.course.id'}.'</imsmd:identifier>
           <imsmd:title>
             <imsmd:langstring xml:lang="en">'.$env{'course.'.$env{'request.course.id'}.'.description'}.'</imsmd:langstring>
           </imsmd:title>
         </imsmd:general>
       </imsmd:lom>
     </metadata>'."\n".
   '  <organizations default="ORG-'.$env{'request.course.id'}.'-'.$now.'">'."\n".
   '    <organization identifier="ORG-'.$env{'request.course.id'}.'-'.$now.'"'.
   ' structure="hierarchical">'."\n".
   '      <title>'.$env{'course.'.$env{'request.course.id'}.'.description'}.'</title>';
           if ($format eq 'plaintext') {
               my $testbankfilename = $$tempexport.'/testbank.txt';
               $$testbank = Apache::File->new('>'.$testbankfilename);
           }
       } else {
           $$outcome .= 'An error occurred opening the IMS manifest file.<br />'
   ;
       }
       return $ims_manifest;
   }
   
   sub build_package {
       my ($now,$navmap,$exportitems,$discussions,$outcome,$tempexport,$copyresult,
           $ims_manifest,$format,$testbank) = @_;
   # 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;
       my $currdirpath = 'Top';
       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".'  </item>'."\n";
                           $step --;
                       }
                   }
                   $prevdepth = $depth;
   
                   my $itementry =
                 '<item identifier="ITEM-'.$env{'request.course.id'}.'-'.$count.
                 '" isvisible="'.$isvisible.'" '.$resourceref.'>'.
                 '<title>'.$curRes->title().'</title>';
                   print $ims_manifest "\n".$itementry;
   
                   if ($curRes->is_sequence()) {
                       $currdirpath = 'Top';
                       my $pcslist = $curRes->map_hierarchy();
                       if ($pcslist ne '') {
                           foreach my $pc (split(/,/,$pcslist),$curRes->map_pc()) {
                               next if ($pc <= 1);
                               my $res = $navmap->getByMapPc($pc);
                               if (ref($res)) {
                                   my $encloser = $res->title();
                                   if ($encloser) {
                                       if ($currdirpath) {
                                           $currdirpath .= ' -> ';
                                       }
                                       $currdirpath .= $encloser;
                                   }
                               }
                           }
                       }
                   } else {
                       my $content_file;
                       my @hrefs = ();
                       &process_content($count,$curRes,$cdom,$cnum,$symb,\$content_file,\@hrefs,$copyresult,$tempexport,$format,$currdirpath,$testbank);
                       if ($content_file) {
                           $imsresources .= "\n".
                        '   <resource identifier="RES-'.$env{'request.course.id'}.'-'.$count.
                        '" type="webcontent" href="'.$content_file.'">'."\n".
                        '       <file href="'.$content_file.'" />'."\n";
                           foreach my $item (@hrefs) {
                               $imsresources .=
                        '        <file href="'.$item.'" />'."\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 .= '    </resource>'."\n";
                       }
                   }
                   $pkgdepth = $depth;
               }
           }
       }
       while ($pkgdepth > 0) {
           print $ims_manifest "    </item>\n";
           $pkgdepth --;
       }
       my $resource_text = qq|
       </organization>
     </organizations>
     <resources>
       $imsresources
     </resources>
   </manifest>
       |;
       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,$format,$currdirpath,$testbank) = @_;
       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 = &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 =  &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 = &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 =  &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 =  &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 =  &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 (($format eq 'html') || ($format eq 'plaintext')) {
               my $title = $curRes->title;
               $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,$format,$currdirpath,$title,$testbank);
           } elsif ($format eq 'xml') {
               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,$currdirpath,
           $title,$testbank) = @_;
       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."<br />\n";
                   }
               } elsif (($caller eq 'noedit') || ($caller eq 'html') ||
                        ($caller eq 'plaintext')) {
   # Need to render the resource without the LON-CAPA Internal header and the Post discussion footer, and then set $content equal to this.
                   my %form = (
                                grade_symb     => $symb,
                                grade_courseid => $cdom.'_'.$cnum,
                                grade_domain   => $env{'user.domain'},
                                grade_username => $env{'user.name'},
                                grade_imsexport => 1,
                                instructor_comments => 'hide',
                              );
                   my $feedurl=&Apache::lonnet::clutter($url);
                   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
                   if (ref($response)) {
                       if ($response->is_success) {
                           $content = $userview;
                           $content =~ s/\Qonchange="javascript:setSubmittedPart('\E[^\']+\Q');"\E//g;
                           $content =~ s/^\s*[\n\r]+$//;
                           if ($caller eq 'plaintext') {
                               my @lines = split(/[\n\r]+/,$content);
                               my @tosave;
                               my $foilcounter = 0;
                               my @alphabet = ('a'..'z');
                               my $mc_answer;
                               foreach my $line (@lines) {
                                   next if ($line =~ /^\s*$/);
                                   if ($line =~ m{(|\Q<\label>\E)\Q<br />Incorrect:<label>\E}) {
                                       $foilcounter ++;
                                   } elsif ($line =~ m{(|\Q</label>\E)\Q<br />Correct:<b><label>\E}) {
                                       $foilcounter ++;
                                       $mc_answer = $alphabet[$foilcounter-1];
                                   } elsif ($line !~ m{\Q</label>\E(|\Q</b>\E)\Q<br />\E}) {
                                       $line =~ s/^(\s+|\s+)$//g;
                                       $line =~ s{^\Q<b>\E([^<]+)\Q</b>\E$}{1};
                                       $tosave[$foilcounter] .= $line.' ';
                                   }
                                   $content = join("\t",@tosave);
                                   if ($mc_answer) {
                                       $content .= "\t".$mc_answer."\n";
                                   }
                               }
                               if (@tosave) {
                                   my $qtype;
                                   if ($mc_answer) {
                                       $qtype = 'MC';
                                   }
                                   $content = $currdirpath."\t".$title."\t$qtype\t".join("\t",@tosave);
                                   if ($mc_answer) {
                                       $content .= "\t".$mc_answer;
                                   }
                                   $content .= "\n";
                               }
                           } else {
                               $content = '<html><body>'.$content.'</body></html>';
                           }
                           if (($caller eq 'plaintext') && ($testbank)) {
                               print $testbank $content;
                           }
                       } else {
                           $content = 'Not the owner of this resource';
                       }
                   } else {
                       $content = 'Not the owner of this resource';
                   }
                   $repstatus = 'ok';
               }
               if ($repstatus eq 'ok') {
                   print $copiedfile $content;
               }
               close($copiedfile);
           } else {
               $$message = 'Could not open destination file for '.$filename."<br />\n";
           }
       } else {
           $$message = 'Could not determine name of file for '.$symb."<br />\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."<br />\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 simpleproblem  {  sub simpleproblem  {
     my ($symb) = @_;      my ($symb) = @_;
Line 48  sub simpleproblem  { Line 673  sub simpleproblem  {
                 %values = &evaloptionhash($options);                  %values = &evaloptionhash($options);
                 $output .= qq|                  $output .= qq|
 <problem>  <problem>
     <startouttext />$qtext<endouttext />
   <optionresponse max="$maxfoils" randomize="$randomize">    <optionresponse max="$maxfoils" randomize="$randomize">
     <foilgroup options="$options">      <foilgroup options="$options">
 |;  |;
Line 76  sub simpleproblem  { Line 702  sub simpleproblem  {
             } else {              } else {
                 $output .= qq|                  $output .= qq|
 <problem>  <problem>
     <startouttext />$qtext<endouttext />
   <radiobuttonresponse max="$maxfoils" randomize="$randomize">    <radiobuttonresponse max="$maxfoils" randomize="$randomize">
    <foilgroup>    <foilgroup>
 |;  |;
                 for (my $k=0; $k<10; $k++) {                  for (my $k=0; $k<10; $k++) {
                     my $iter = $k+1;                      my $iter = $k+1;
Line 102  sub simpleproblem  { Line 729  sub simpleproblem  {
 </problem>  </problem>
 |;  |;
             }              }
         } elsif ($qtype eq 'stringanswer') {          } elsif ($qtype eq 'string') {
             my $stringanswer = $qparms{$prefix.'stringanswer'};              my $stringanswer = $qparms{$prefix.'stringanswer'};
             my $stringtype=$qparms{$prefix.'stringtype'};              my $stringtype=$qparms{$prefix.'stringtype'};
             $output .= qq|              $output .= qq|
 <problem>  <problem>
   <stringresponse answer="$stringanswer" type="$stringtype">    <stringresponse answer="$stringanswer" type="$stringtype">
     <textline>    <startouttext />$qtext<endouttext />
     </textline>      <textline />
             |;              |;
             if ($hint) {              if ($hint) {
                 $output .= '                  $output .= '
Line 123  sub simpleproblem  { Line 750  sub simpleproblem  {
   </stringresponse>    </stringresponse>
 </problem>  </problem>
 |;  |;
           } elsif ($qtype eq 'numerical') {
               my $sigfigs = $qparms{$prefix.'numericalsigfigs'};
               my $unit = $qparms{$prefix.'numericalunit'};
               my $answer = $qparms{$prefix.'numericalanswer'};
               my $tolerance = $qparms{$prefix.'numericaltolerance'};
               my $format = $qparms{$prefix.'numericalformat'};
               my $scriptblock = $qparms{$prefix.'numericalscript'};
               $output .= qq|
   <problem>
   |;
               if ($scriptblock) {
                   $output .= qq|
   <script type="loncapa/perl">
   $scriptblock
   </script>|;
                }
                $output .= qq|
   <startouttext />$qtext<endouttext />
   <numericalresponse answer="$answer" |;
                if ($unit ne '') {
                    $output .= qq|unit="$unit" |;
                }
                if ($format ne '') {
                    $output .= qq|format="$format" |;
                }
                $output =~ s{ $}{};
                $output .= '>';
                if ($tolerance ne '') {
                    $output .= qq|
     <responseparam name="tol" type="tolerance" default="$tolerance" description="Numerical Tolerance" />|;
                }
                if ($sigfigs) {
                    $output .= qq|
     <responseparam name="sig" type="int_range" default="$sigfigs" description="Significant Digits" />|;
                }
                $output .= qq|
     <textline />|;
               if ($hint) {
                   $output .= qq|
     <hintgroup>
       <hintpart on="default">
         <startouttext />'.$hint.'<endouttext/>
       </hintpart>
     </hintgroup>|;
               }
               $output .= qq|
   </numericalresponse>
   </problem>
   |;
         } else {          } else {
             $output .= qq|              $output .= qq|
 <problem>  <problem>
Line 152  sub external { Line 828  sub external {
     my ($symb,$title) = @_;      my ($symb,$title) = @_;
     my $output;      my $output;
     if ($symb =~  m-\.sequence___\d+___ext(.+)$-) {      if ($symb =~  m-\.sequence___\d+___ext(.+)$-) {
         my $exturl = &Apache::lonnet::unescape($1);          my $exturl = &unescape($1);
         $output = qq|          $output = qq|
 <html>  <html>
 <head><title>$title</title>  <head><title>$title</title>
Line 213  sub templatedpage { Line 889  sub templatedpage {
         %syllabusdata=&Apache::lonnet::dump('aboutme',$udom,$uname);          %syllabusdata=&Apache::lonnet::dump('aboutme',$udom,$uname);
         %syllabusfields=&Apache::lonlocal::texthash(          %syllabusfields=&Apache::lonlocal::texthash(
            'aaa_contactinfo'   => 'Contact Information',             'aaa_contactinfo'   => 'Contact Information',
            'bbb_aboutme'       => 'About Me',             'bbb_aboutme'       => 'Personal Information',
            'ccc_webreferences' => 'Web References'             'ccc_webreferences' => 'Web References'
         );          );
         $output .= qq|          $output .= qq|
Line 243  sub templatedpage { Line 919  sub templatedpage {
 }  }
   
 1;  1;
   
   __END__
   
   =head1 NAME
   
   Apache::imsexport.pm
   
   =head1 SYNOPSIS
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 SUBROUTINES
   
   =over
   
   =item exportcourse()
   
   =item create_ims_store()
   
   =item build_package()
   
   =item get_dependencies()
   
   =item process_content()
   
   =item replicate_content()
   
   =item extract_media()
   
   =item store_template()
   
   =item simpleproblem()
   
   =item evaloptionhash()
   
   =item external()
   
   =item templatedpage()
   
   =back
   
   =cut
   
Removed from v.1.3  
changed lines
  Added in v.1.11

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>