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

Diff for /loncom/interface/londocs.pm between versions 1.142 and 1.143

version 1.142, 2004/09/14 01:21:49 version 1.143, 2004/09/14 21:27:36
Line 40  use Apache::lonnavmaps; Line 40  use Apache::lonnavmaps;
 use HTML::Entities;  use HTML::Entities;
 use GDBM_File;  use GDBM_File;
 use Apache::lonlocal;  use Apache::lonlocal;
   use Cwd;
   
 my $iconpath;  my $iconpath;
   
Line 254  sub exportcourse { Line 255  sub exportcourse {
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
     my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);      my $it=$navmap->getIterator(undef,undef,undef,1,undef,undef);
     my $curRes;      my $curRes;
       my $outcome;
   
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                             ['finishexport']);                                              ['finishexport']);
Line 277  sub exportcourse { Line 279  sub exportcourse {
                 $discussions[0] = $ENV{'form.discussion'};                  $discussions[0] = $ENV{'form.discussion'};
             }              }
         }          }
         my $curRes;          if (@exportitems == 0 && @discussions == 0) {
         my $count;              $outcome = '<br />As you did not select any content items or discussions for export, an IMS package has not been created.  Please <a href="javascript:history.go(-1)">go back</a> to select either content items or discussions for export';
         my %symbs;          } else {
         my $display;              my $now = time;
         while ($curRes = $it->next()) {              my $count = 0;
             if (ref($curRes)) {              my %symbs;
                 $count ++;              my $manifestok = 0;
                 $symbs{$count} = $curRes->symb();              my $imsresources;
                 if (grep/^$count$/,@exportitems) {              my $tempexport;
                     $display.= 'Export content item '.$curRes->title()."<br />\n";              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 <a href="'.$imszipfile.'">IMS course archive</a><br />';
                   if ($copyresult) {
                       $outcome .= 'The following errors occurred during export - '.$copyresult;
                 }                  }
                 if (grep/^$count$/,@discussions) {              } else {
                     $display.= 'Export discussion posts '.$curRes->title()."<br />\n";                  $outcome = '<br />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.<br />';
                 }    
             }              }
         }          }
   
         $r->print('<html><head><title>Export Course</title></head>'.          $r->print('<html><head><title>Export Course</title></head>'.
             &Apache::loncommon::bodytag('Export course to IMS or SCORM content package'              &Apache::loncommon::bodytag('Export course to IMS or SCORM content package'));
 ));          $r->print($outcome);
   
         my $exportfile;  
         $r->print($display);  
         $r->print('</body></html>');          $r->print('</body></html>');
     } else {      } else {
         my $display;          my $display;
Line 433  function containerCheck(item) { Line 455  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
   '<?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".
   '  <organizations default="ORG-."'.$ENV{'request,course.id'}.'-'.$now.'">'."\n".
   '    <organization identifier="ORG-'.$ENV{'request.course.id'}.'-'.$now.'"'.
   ' structure="hierarchical">'."\n".
   '      <title>'.$ENV{'request.'.$ENV{'request.course.id'}.'.description'}.'</title>'
       } 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) = @_;
   # 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 '  </item>'."\n";
               }
               $prevdepth = $depth;
   
               my $itementry =
                 '<item identifier="ITEM-'.$ENV{'request.course.id'}.'-'.$count.
                 '" isvisible="'.$isvisible.'" '.$resourceref.'>'.
                 '<title>'.$curRes->title().'</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".
                        '   <resource identifier="RES-'.$ENV{'request.course.id'}.'-'.$count.
                        '" type="webcontent" href="'.$content_file.'">'."\n".
                        '       <file href="'.$content_file.'" />'."\n";
                       foreach (@hrefs) {
                           $imsresources .=
                        '        <file href="'.$_.'" />'."\n";
                       }
                       $imsresources .= '    </resource>'."\n";
                   }
               }
               $pkgdepth = $depth;
           }
       }
       while ($pkgdepth > -1) {
           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) {
           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  # Imports the given (name, url) resources into the course
 # coursenum, coursedom, and folder must precede the list  # coursenum, coursedom, and folder must precede the list
Removed from v.1.142  
changed lines
  Added in v.1.143

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