Annotation of loncom/imspackages/imsexport.pm, revision 1.11

1.5       www         1: # The LearningOnline Network
                      2: #
1.11    ! raeburn     3: # $Id: imsexport.pm,v 1.10 2012/05/07 02:12:54 raeburn Exp $
1.5       www         4: #
1.1       raeburn     5: # Copyright Michigan State University Board of Trustees
                      6: #
                      7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: #
                      9: # LON-CAPA is free software; you can redistribute it and/or modify
                     10: # it under the terms of the GNU General Public License as published by
                     11: # the Free Software Foundation; either version 2 of the License, or
                     12: # (at your option) any later version.
                     13: #
                     14: # LON-CAPA is distributed in the hope that it will be useful,
                     15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: # GNU General Public License for more details.
                     18: #
                     19: # You should have received a copy of the GNU General Public License
                     20: # along with LON-CAPA; if not, write to the Free Software
                     21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: #
                     23: # /home/httpd/html/adm/gpl.txt
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
                     27: 
                     28: package Apache::imsexport;
                     29: 
                     30: use strict;
                     31: use Apache::lonnet;
1.8       raeburn    32: use Apache::loncommon;
                     33: use Apache::lonhtmlcommon;
                     34: use Apache::lonnavmaps;
1.9       raeburn    35: use Apache::loncourserespicker;
1.10      raeburn    36: use Apache::londocs;
1.8       raeburn    37: use Apache::lonlocal;
                     38: use Cwd;
                     39: use LONCAPA qw(:DEFAULT :match);
                     40: 
                     41: sub exportcourse {
                     42:     my $r=shift;
                     43:     my $crstype = &Apache::loncommon::course_type();
1.9       raeburn    44:     my ($navmap,$errormsg) = 
                     45:         &Apache::loncourserespicker::get_navmap_object($crstype,'imsexport'); 
                     46:     unless (ref($navmap)) {
                     47:         $r->print($errormsg);
1.8       raeburn    48:         return;
                     49:     }
                     50:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                     51:                                             ['finishexport']);
                     52:     if ($env{'form.finishexport'}) {
                     53:         &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                     54:                                             ['archive','discussion']);
1.9       raeburn    55:         my $outcome; 
1.8       raeburn    56:         my $format = $env{'form.format'};
                     57:         my @exportitems = &Apache::loncommon::get_env_multiple('form.archive');
                     58:         my @discussions = &Apache::loncommon::get_env_multiple('form.discussion');
                     59:         if (@exportitems == 0 && @discussions == 0) {
                     60:             $outcome =
                     61:                 '<p class="LC_warning">'
                     62:                .&mt('As you did not select any content items or discussions'
                     63:                    .' for export, an IMS package has not been created.')
                     64:                .'</p>'
                     65:                .'<p>'
                     66:                .&mt('Please [_1]go back[_2] to select either content items'
                     67:                    .' or discussions for export.'
                     68:                        ,'<a href="javascript:history.go(-1)">'
                     69:                        ,'</a>')
                     70:                .'</p>';
                     71:         } else {
                     72:             my $now = time;
                     73:             my %symbs;
                     74:             my $manifestok = 0;
                     75:             my $imsresources;
                     76:             my $tempexport;
                     77:             my $copyresult;
                     78:             my $testbank;
                     79:             my $ims_manifest = &create_ims_store($now,\$manifestok,\$outcome,\$tempexport,$format,\$testbank);
                     80:             if ($manifestok) {
                     81:                 &build_package($now,$navmap,\@exportitems,\@discussions,\$outcome,$tempexport,\$copyresult,$ims_manifest,$format,$testbank);
                     82:                 close($ims_manifest);
                     83: 
                     84: #Create zip file in prtspool
                     85:                 my $imszipfile = '/prtspool/'.
                     86:                 $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
                     87:                    time.'_'.rand(1000000000).'.zip';
                     88:                 my $cwd = &Cwd::getcwd();
                     89:                 my $imszip = '/home/httpd/'.$imszipfile;
                     90:                 chdir $tempexport;
                     91:                 open(OUTPUT, "zip -r $imszip *  2> /dev/null |");
                     92:                 close(OUTPUT);
                     93:                 chdir $cwd;
                     94:                 $outcome .= '<p>'
                     95:                            .&mt('[_1]Your IMS package[_2] is ready for download.'
                     96:                                ,'<a href="'.$imszipfile.'">','</a>')
                     97:                            .'</p>';
                     98:                 if ($copyresult) {
                     99:                     $outcome .= '<p class="LC_error">'
                    100:                                .&mt('The following errors occurred during export - [_1]'
                    101:                                    ,$copyresult)
                    102:                                .'</p>';
                    103:                 }
                    104:             } else {
                    105:                 $outcome = '<p class="LC_error">'
                    106:                           .&mt('Unfortunately you will not be able to retrieve'
                    107:                               .' an IMS archive of your course at this time,'
                    108:                               .' because there was a problem creating a'
                    109:                               .' manifest file.')
                    110:                           .'</p>'
                    111:                           .'<p><a href="javascript:history.go(-1)">'
                    112:                           .&mt('Go Back')
                    113:                           .'</a></p>';
                    114:             }
                    115:         }
                    116:         $r->print(&Apache::loncommon::start_page('Export '.$crstype.' to IMS Package'));
                    117:         $r->print(&Apache::lonhtmlcommon::breadcrumbs('IMS Export'));
1.10      raeburn   118:         $r->print(&Apache::londocs::startContentScreen('tools')); 
1.8       raeburn   119:         $r->print($outcome);
1.10      raeburn   120:         $r->print(&Apache::londocs::endContentScreen());
1.8       raeburn   121:         $r->print(&Apache::loncommon::end_page());
                    122:     } else {
1.9       raeburn   123:         $r->print(&Apache::loncourserespicker::create_picker($navmap,'imsexport',
                    124:                                                              'exportdoc',$crstype));
1.8       raeburn   125:     }
1.9       raeburn   126:     return;
1.8       raeburn   127: }
                    128: 
                    129: sub create_ims_store {
                    130:     my ($now,$manifestok,$outcome,$tempexport,$format,$testbank) = @_;
                    131:     $$tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports';
                    132:     my $ims_manifest;
                    133:     if (!-e $$tempexport) {
                    134:         mkdir($$tempexport,0700);
                    135:     }
                    136:     $$tempexport .= '/'.$now;
                    137:     if (!-e $$tempexport) {
                    138:         mkdir($$tempexport,0700);
                    139:     }
                    140:     $$tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'};
                    141:     if (!-e $$tempexport) {
                    142:         mkdir($$tempexport,0700);
                    143:     }
                    144:     if (!-e "$$tempexport/resources") {
                    145:         mkdir("$$tempexport/resources",0700);
                    146:     }
                    147: # open manifest file
                    148:     my $manifest = '/imsmanifest.xml';
                    149:     my $manifestfilename = $$tempexport.$manifest;
                    150:     if ($ims_manifest = Apache::File->new('>'.$manifestfilename)) {
                    151:         $$manifestok=1;
                    152:         print $ims_manifest
                    153: '<?xml version="1.0" encoding="UTF-8"?>'."\n".
                    154: '<manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1"'.
                    155: ' xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2"'.
                    156: ' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"'.
                    157: ' identifier="MANIFEST-'.$env{'request.course.id'}.'-'.$now.'"'.
                    158: '  xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1imscp_v1p1.xsd'.
                    159: '  http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd">'."\n".
                    160: '  <metadata>
                    161:     <schema></schema>
                    162:     <imsmd:lom>
                    163:       <imsmd:general>
                    164:         <imsmd:identifier>'.$env{'request.course.id'}.'</imsmd:identifier>
                    165:         <imsmd:title>
                    166:           <imsmd:langstring xml:lang="en">'.$env{'course.'.$env{'request.course.id'}.'.description'}.'</imsmd:langstring>
                    167:         </imsmd:title>
                    168:       </imsmd:general>
                    169:     </imsmd:lom>
                    170:   </metadata>'."\n".
                    171: '  <organizations default="ORG-'.$env{'request.course.id'}.'-'.$now.'">'."\n".
                    172: '    <organization identifier="ORG-'.$env{'request.course.id'}.'-'.$now.'"'.
                    173: ' structure="hierarchical">'."\n".
                    174: '      <title>'.$env{'course.'.$env{'request.course.id'}.'.description'}.'</title>';
                    175:         if ($format eq 'plaintext') {
                    176:             my $testbankfilename = $$tempexport.'/testbank.txt';
                    177:             $$testbank = Apache::File->new('>'.$testbankfilename);
                    178:         }
                    179:     } else {
                    180:         $$outcome .= 'An error occurred opening the IMS manifest file.<br />'
                    181: ;
                    182:     }
                    183:     return $ims_manifest;
                    184: }
                    185: 
                    186: sub build_package {
                    187:     my ($now,$navmap,$exportitems,$discussions,$outcome,$tempexport,$copyresult,
                    188:         $ims_manifest,$format,$testbank) = @_;
                    189: # first iterator to look for dependencies
                    190:     my $it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
                    191:     my $curRes;
                    192:     my $count = 0;
                    193:     my $depth = 0;
                    194:     my $lastcontainer = 0;
                    195:     my %parent = ();
                    196:     my @dependencies = ();
                    197:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    198:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    199:     while ($curRes = $it->next()) {
                    200:         if (ref($curRes)) {
                    201:             $count ++;
                    202:         }
                    203:         if ($curRes == $it->BEGIN_MAP()) {
                    204:             $depth++;
                    205:             $parent{$depth} = $lastcontainer;
                    206:         }
                    207:         if ($curRes == $it->END_MAP()) {
                    208:             $depth--;
                    209:             $lastcontainer = $parent{$depth};
                    210:         }
                    211:         if (ref($curRes)) {
                    212:             if ($curRes->is_sequence() || $curRes->is_page()) {
                    213:                 $lastcontainer = $count;
                    214:             }
                    215:             if (grep(/^$count$/,@$exportitems)) {
                    216:                 &get_dependencies($exportitems,\%parent,$depth,\@dependencies);
                    217:             }
                    218:         }
                    219:     }
                    220: # second iterator to build manifest and store resources
                    221:     $it = $navmap->getIterator(undef,undef,undef,1,undef,undef);
                    222:     $depth = 0;
                    223:     my $prevdepth;
                    224:     $count = 0;
                    225:     my $imsresources;
                    226:     my $pkgdepth;
                    227:     my $currdirpath = 'Top';
                    228:     while ($curRes = $it->next()) {
                    229:         if ($curRes == $it->BEGIN_MAP()) {
                    230:             $prevdepth = $depth;
                    231:             $depth++;
                    232:         }
                    233:         if ($curRes == $it->END_MAP()) {
                    234:             $prevdepth = $depth;
                    235:             $depth--;
                    236:         }
                    237: 
                    238:         if (ref($curRes)) {
                    239:             $count ++;
                    240:             if ((grep(/^$count$/,@$exportitems)) || (grep(/^$count$/,@dependencies))) {
                    241:                 my $symb = $curRes->symb();
                    242:                 my $isvisible = 'true';
                    243:                 my $resourceref;
                    244:                 if ($curRes->randomout()) {
                    245:                     $isvisible = 'false';
                    246:                 }
                    247:                 unless ($curRes->is_sequence()) {
                    248:                     $resourceref = 'identifierref="RES-'.$env{'request.course.id'}.'-'.$count.'"';
                    249:                 }
                    250:                 my $step = $prevdepth - $depth;
                    251:                 if (($step >= 0) && ($count > 1)) {
                    252:                     while ($step >= 0) {
                    253:                         print $ims_manifest "\n".'  </item>'."\n";
                    254:                         $step --;
                    255:                     }
                    256:                 }
                    257:                 $prevdepth = $depth;
                    258: 
                    259:                 my $itementry =
                    260:               '<item identifier="ITEM-'.$env{'request.course.id'}.'-'.$count.
                    261:               '" isvisible="'.$isvisible.'" '.$resourceref.'>'.
                    262:               '<title>'.$curRes->title().'</title>';
                    263:                 print $ims_manifest "\n".$itementry;
                    264: 
                    265:                 if ($curRes->is_sequence()) {
                    266:                     $currdirpath = 'Top';
                    267:                     my $pcslist = $curRes->map_hierarchy();
                    268:                     if ($pcslist ne '') {
                    269:                         foreach my $pc (split(/,/,$pcslist),$curRes->map_pc()) {
                    270:                             next if ($pc <= 1);
                    271:                             my $res = $navmap->getByMapPc($pc);
                    272:                             if (ref($res)) {
                    273:                                 my $encloser = $res->title();
                    274:                                 if ($encloser) {
                    275:                                     if ($currdirpath) {
                    276:                                         $currdirpath .= ' -> ';
                    277:                                     }
                    278:                                     $currdirpath .= $encloser;
                    279:                                 }
                    280:                             }
                    281:                         }
                    282:                     }
                    283:                 } else {
                    284:                     my $content_file;
                    285:                     my @hrefs = ();
                    286:                     &process_content($count,$curRes,$cdom,$cnum,$symb,\$content_file,\@hrefs,$copyresult,$tempexport,$format,$currdirpath,$testbank);
                    287:                     if ($content_file) {
                    288:                         $imsresources .= "\n".
                    289:                      '   <resource identifier="RES-'.$env{'request.course.id'}.'-'.$count.
                    290:                      '" type="webcontent" href="'.$content_file.'">'."\n".
                    291:                      '       <file href="'.$content_file.'" />'."\n";
                    292:                         foreach my $item (@hrefs) {
                    293:                             $imsresources .=
                    294:                      '        <file href="'.$item.'" />'."\n";
                    295:                         }
                    296:                         if (grep(/^$count$/,@$discussions)) {
                    297:                             my $ressymb = $symb;
                    298:                             my $mode;
                    299:                             if ($ressymb =~ m|adm/($match_domain)/($match_username)/(\d+)/bulletinboard$|) {
                    300:                                 unless ($ressymb =~ m|adm/wrapper/adm|) {
                    301:                                     $ressymb = 'bulletin___'.$3.'___adm/wrapper/adm/'.$1.'/'.$2.'/'.$3.'/bulletinboard';
                    302:                                 }
                    303:                                 $mode = 'board';
                    304:                             }
                    305:                             my %extras = (
                    306:                                           caller => 'imsexport',
                    307:                                           tempexport => $tempexport.'/resources',
                    308:                                           count => $count
                    309:                                          );
                    310:                             my $discresult = &Apache::lonfeedback::list_discussion($mode,undef,$ressymb,\%extras);
                    311:                         }
                    312:                         $imsresources .= '    </resource>'."\n";
                    313:                     }
                    314:                 }
                    315:                 $pkgdepth = $depth;
                    316:             }
                    317:         }
                    318:     }
                    319:     while ($pkgdepth > 0) {
                    320:         print $ims_manifest "    </item>\n";
                    321:         $pkgdepth --;
                    322:     }
                    323:     my $resource_text = qq|
                    324:     </organization>
                    325:   </organizations>
                    326:   <resources>
                    327:     $imsresources
                    328:   </resources>
                    329: </manifest>
                    330:     |;
                    331:     print $ims_manifest $resource_text;
                    332: }
                    333: 
                    334: sub get_dependencies {
                    335:     my ($exportitems,$parent,$depth,$dependencies) = @_;
                    336:     if ($depth > 1) {
                    337:         if ((!grep(/^$$parent{$depth}$/,@$exportitems)) && (!grep(/^$$parent{$depth}$/,@$dependencies))) {
                    338:             push(@{$dependencies},$$parent{$depth});
                    339:             if ($depth > 2) {
                    340:                 &get_dependencies($exportitems,$parent,$depth-1,$dependencies);
                    341:             }
                    342:         }
                    343:     }
                    344: }
                    345: 
                    346: sub process_content {
                    347:     my ($count,$curRes,$cdom,$cnum,$symb,$content_file,$href,$copyresult,$tempexport,$format,$currdirpath,$testbank) = @_;
                    348:     my $content_type;
                    349:     my $message;
                    350:     my @uploads = ();
                    351:     if ($curRes->is_sequence()) {
                    352:         $content_type = 'sequence';
                    353:     } elsif ($curRes->is_page()) {
                    354:         $content_type = 'page'; # need to handle individual items in pages.
                    355:     } elsif ($symb =~ m-public/$cdom/$cnum/syllabus$-) {
                    356:         $content_type = 'syllabus';
                    357:         my $contents = &templatedpage($content_type);
                    358:         if ($contents) {
                    359:             $$content_file = &store_template($contents,$tempexport,$count,$content_type);
                    360:         }
                    361:     } elsif ($symb =~ m-\.sequence___\d+___ext-) {
                    362:         $content_type = 'external';
                    363:         my $title = $curRes->title;
                    364:         my $contents =  &external($symb,$title);
                    365:         if ($contents) {
                    366:             $$content_file = &store_template($contents,$tempexport,$count,$content_type);
                    367:         }
                    368:     } elsif ($symb =~ m-adm/navmaps$-) {
                    369:         $content_type =  'navmap';
                    370:     } elsif ($symb =~ m-adm/[^/]+/[^/]+/(\d+)/smppg$-) {
                    371:         $content_type = 'simplepage';
                    372:         my $contents = &templatedpage($content_type,$1,$count,\@uploads);
                    373:         if ($contents) {
                    374:             $$content_file = &store_template($contents,$tempexport,$count,$content_type);
                    375:         }
                    376:     } elsif ($symb =~ m-lib/templates/simpleproblem\.problem$-) {
                    377:         $content_type = 'simpleproblem';
                    378:         my $contents =  &simpleproblem($symb);
                    379:         if ($contents) {
                    380:             $$content_file = &store_template($contents,$tempexport,$count,$content_type);
                    381:         }
                    382:     } elsif ($symb =~ m-lib/templates/examupload\.problem$-) {
                    383:         $content_type = 'examupload';
                    384:     } elsif ($symb =~ m-adm/($match_domain)/($match_username)/(\d+)/bulletinboard$-) {
                    385:         $content_type = 'bulletinboard';
                    386:         my $contents =  &templatedpage($content_type,$3,$count,\@uploads,$1,$2);
                    387:         if ($contents) {
                    388:             $$content_file = &store_template($contents,$tempexport,$count,$content_type);
                    389:         }
                    390:     } elsif ($symb =~ m-adm/([^/]+)/([^/]+)/aboutme$-) {
                    391:         $content_type = 'aboutme';
                    392:         my $contents =  &templatedpage($content_type,undef,$count,\@uploads,$1,$2);
                    393:         if ($contents) {
                    394:             $$content_file = &store_template($contents,$tempexport,$count,$content_type);
                    395:         }
                    396:     } elsif ($symb =~ m-\.(sequence|page)___\d+___uploaded/$cdom/$cnum/-) {
                    397:         $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded');
                    398:     } elsif ($symb =~ m-\.(sequence|page)___\d+___([^/]+)/([^/]+)-) {
                    399:         my $canedit = 0;
                    400:         if ($2 eq $env{'user.domain'} && $3 eq $env{'user.name'})  {
                    401:             $canedit= 1;
                    402:         }
                    403: # only include problem code where current user is author
                    404:         if (($format eq 'html') || ($format eq 'plaintext')) {
                    405:             my $title = $curRes->title;
                    406:             $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,$format,$currdirpath,$title,$testbank);
                    407:         } elsif ($format eq 'xml') {
                    408:             if ($canedit) {
                    409:                 $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'resource');
                    410:             } else {
                    411:                 $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'noedit');
                    412:             }
                    413:         }
                    414:     } elsif ($symb =~ m-uploaded/$cdom/$cnum-) {
                    415:         $$content_file = &replicate_content($cdom,$cnum,$tempexport,$symb,$count,\$message,$href,'uploaded');
                    416:     }
                    417:     if (@uploads > 0) {
                    418:         foreach my $item (@uploads) {
                    419:             my $uploadmsg = '';
                    420:             &replicate_content($cdom,$cnum,$tempexport,$item,$count,\$uploadmsg,$href,'templateupload');
                    421:             if ($uploadmsg) {
                    422:                 $$copyresult .= $uploadmsg."\n";
                    423:             }
                    424:         }
                    425:     }
                    426:     if ($message) {
                    427:         $$copyresult .= $message."\n";
                    428:     }
                    429: }
                    430: 
                    431: sub replicate_content {
                    432:     my ($cdom,$cnum,$tempexport,$symb,$count,$message,$href,$caller,$currdirpath,
                    433:         $title,$testbank) = @_;
                    434:     my ($map,$ind,$url);
                    435:     if ($caller eq 'templateupload') {
                    436:         $url = $symb;
                    437:         $url =~ s#//#/#g;
                    438:     } else {
                    439:         ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
                    440:     }
                    441:     my $content;
                    442:     my $filename;
                    443:     my $repstatus;
                    444:     my $content_name;
                    445:     if ($url =~ m-/([^/]+)$-) {
                    446:         $filename = $1;
                    447:         if (!-e $tempexport.'/resources') {
                    448:             mkdir($tempexport.'/resources',0700);
                    449:         }
                    450:         if (!-e $tempexport.'/resources/'.$count) {
                    451:             mkdir($tempexport.'/resources/'.$count,0700);
                    452:         }
                    453:         my $destination = $tempexport.'/resources/'.$count.'/'.$filename;
                    454:         my $copiedfile;
                    455:         if ($copiedfile = Apache::File->new('>'.$destination)) {
                    456:             my $content;
                    457:             if ($caller eq 'resource') {
                    458:                 my $respath =  $Apache::lonnet::perlvar{'lonDocRoot'}.'/res';
                    459:                 my $filepath = &Apache::lonnet::filelocation($respath,$url);
                    460:                 $content = &Apache::lonnet::getfile($filepath);
                    461:                 if ($content eq -1) {
                    462:                     $$message = 'Could not copy file '.$filename;
                    463:                 } else {
                    464:                     &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'resource');
                    465:                     $repstatus = 'ok';
                    466:                 }
                    467:             } elsif ($caller eq 'uploaded' || $caller eq 'templateupload') {
                    468:                 my $rtncode;
                    469:                 $repstatus = &Apache::lonnet::getuploaded('GET',$url,$cdom,$cnum,\$content,$rtncode);
                    470:                 if ($repstatus eq 'ok') {
                    471:                     if ($url =~ /\.html?$/i) {
                    472:                         &extract_media($url,$cdom,$cnum,\$content,$count,$tempexport,$href,$message,'uploaded');
                    473:                     }
                    474:                 } else {
                    475:                     $$message = 'Could not render '.$url.' server message - '.$rtncode."<br />\n";
                    476:                 }
                    477:             } elsif (($caller eq 'noedit') || ($caller eq 'html') ||
                    478:                      ($caller eq 'plaintext')) {
                    479: # Need to render the resource without the LON-CAPA Internal header and the Post discussion footer, and then set $content equal to this.
                    480:                 my %form = (
                    481:                              grade_symb     => $symb,
                    482:                              grade_courseid => $cdom.'_'.$cnum,
                    483:                              grade_domain   => $env{'user.domain'},
                    484:                              grade_username => $env{'user.name'},
                    485:                              grade_imsexport => 1,
                    486:                              instructor_comments => 'hide',
                    487:                            );
                    488:                 my $feedurl=&Apache::lonnet::clutter($url);
                    489:                 my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
                    490:                 if (ref($response)) {
                    491:                     if ($response->is_success) {
                    492:                         $content = $userview;
                    493:                         $content =~ s/\Qonchange="javascript:setSubmittedPart('\E[^\']+\Q');"\E//g;
                    494:                         $content =~ s/^\s*[\n\r]+$//;
                    495:                         if ($caller eq 'plaintext') {
                    496:                             my @lines = split(/[\n\r]+/,$content);
                    497:                             my @tosave;
                    498:                             my $foilcounter = 0;
                    499:                             my @alphabet = ('a'..'z');
                    500:                             my $mc_answer;
                    501:                             foreach my $line (@lines) {
                    502:                                 next if ($line =~ /^\s*$/);
                    503:                                 if ($line =~ m{(|\Q<\label>\E)\Q<br />Incorrect:<label>\E}) {
                    504:                                     $foilcounter ++;
                    505:                                 } elsif ($line =~ m{(|\Q</label>\E)\Q<br />Correct:<b><label>\E}) {
                    506:                                     $foilcounter ++;
                    507:                                     $mc_answer = $alphabet[$foilcounter-1];
                    508:                                 } elsif ($line !~ m{\Q</label>\E(|\Q</b>\E)\Q<br />\E}) {
                    509:                                     $line =~ s/^(\s+|\s+)$//g;
                    510:                                     $line =~ s{^\Q<b>\E([^<]+)\Q</b>\E$}{1};
                    511:                                     $tosave[$foilcounter] .= $line.' ';
                    512:                                 }
                    513:                                 $content = join("\t",@tosave);
                    514:                                 if ($mc_answer) {
                    515:                                     $content .= "\t".$mc_answer."\n";
                    516:                                 }
                    517:                             }
                    518:                             if (@tosave) {
                    519:                                 my $qtype;
                    520:                                 if ($mc_answer) {
                    521:                                     $qtype = 'MC';
                    522:                                 }
                    523:                                 $content = $currdirpath."\t".$title."\t$qtype\t".join("\t",@tosave);
                    524:                                 if ($mc_answer) {
                    525:                                     $content .= "\t".$mc_answer;
                    526:                                 }
                    527:                                 $content .= "\n";
                    528:                             }
                    529:                         } else {
                    530:                             $content = '<html><body>'.$content.'</body></html>';
                    531:                         }
                    532:                         if (($caller eq 'plaintext') && ($testbank)) {
                    533:                             print $testbank $content;
                    534:                         }
                    535:                     } else {
                    536:                         $content = 'Not the owner of this resource';
                    537:                     }
                    538:                 } else {
                    539:                     $content = 'Not the owner of this resource';
                    540:                 }
                    541:                 $repstatus = 'ok';
                    542:             }
                    543:             if ($repstatus eq 'ok') {
                    544:                 print $copiedfile $content;
                    545:             }
                    546:             close($copiedfile);
                    547:         } else {
                    548:             $$message = 'Could not open destination file for '.$filename."<br />\n";
                    549:         }
                    550:     } else {
                    551:         $$message = 'Could not determine name of file for '.$symb."<br />\n";
                    552:     }
                    553:     if ($repstatus eq 'ok') {
                    554:         $content_name = 'resources/'.$count.'/'.$filename;
                    555:     }
                    556:     return $content_name;
                    557: }
                    558: 
                    559: sub extract_media {
                    560:     my ($url,$cdom,$cnum,$content,$count,$tempexport,$href,$message,$caller) = @_;
                    561:     my ($dirpath,$container);
                    562:     my %allfiles = ();
                    563:     my %codebase = ();
                    564:     if ($url =~ m-(.*/)([^/]+)$-) {
                    565:         $dirpath = $1;
                    566:         $container = $2;
                    567:     } else {
                    568:         $dirpath = $url;
                    569:         $container = '';
                    570:     }
                    571:     &Apache::lonnet::extract_embedded_items(undef,\%allfiles,\%codebase,$content);
                    572:     foreach my $embed_file (keys(%allfiles)) {
                    573:         my $filename;
                    574:         if ($embed_file =~ m#([^/]+)$#) {
                    575:             $filename = $1;
                    576:         } else {
                    577:             $filename = $embed_file;
                    578:         }
                    579:         my $newname = 'res/'.$filename;
                    580:         my ($rtncode,$embed_content,$repstatus);
                    581:         my $embed_url;
                    582:         if ($embed_file =~ m-^/-) {
                    583:             $embed_url = $embed_file;           # points to absolute path
                    584:         } else {
                    585:             if ($embed_file =~ m-https?://-) {
                    586:                 next;                           # points to url
                    587:             } else {
                    588:                 $embed_url = $dirpath.$embed_file;  # points to relative path
                    589:             }
                    590:         }
                    591:         if ($caller eq 'resource') {
                    592:             my $respath =  $Apache::lonnet::perlvar{'lonDocRoot'}.'/res';
                    593:             my $embed_path = &Apache::lonnet::filelocation($respath,$embed_url);
                    594:             $embed_content = &Apache::lonnet::getfile($embed_path);
                    595:             unless ($embed_content eq -1) {
                    596:                 $repstatus = 'ok';
                    597:             }
                    598:         } elsif ($caller eq 'uploaded') {
                    599:             $repstatus = &Apache::lonnet::getuploaded('GET',$embed_url,$cdom,$cnum,\$embed_content,$rtncode);
                    600:         }
                    601:         if ($repstatus eq 'ok') {
                    602:             my $destination = $tempexport.'/resources/'.$count.'/res';
                    603:             if (!-e "$destination") {
                    604:                 mkdir($destination,0755);
                    605:             }
                    606:             $destination .= '/'.$filename;
                    607:             my $copiedfile;
                    608:             if ($copiedfile = Apache::File->new('>'.$destination)) {
                    609:                 print $copiedfile $embed_content;
                    610:                 push(@{$href},'resources/'.$count.'/res/'.$filename);
                    611:                 my $attrib_regexp = '';
                    612:                 if (@{$allfiles{$embed_file}} > 1) {
                    613:                     $attrib_regexp = join('|',@{$allfiles{$embed_file}});
                    614:                 } else {
                    615:                     $attrib_regexp = $allfiles{$embed_file}[0];
                    616:                 }
                    617:                 $$content =~ s#($attrib_regexp\s*=\s*['"]?)\Q$embed_file\E(['"]?)#$1$newname$2#gi;
                    618:                 if ($caller eq 'resource' && $container =~ /\.(problem|library)$/) {
                    619:                     $$content =~ s#\Q$embed_file\E#$newname#gi;
                    620:                 }
                    621:             }
                    622:         } else {
                    623:             $$message .= 'replication of embedded file - '.$embed_file.' in '.$url.' failed, reason -'.$rtncode."<br />\n";
                    624:         }
                    625:     }
                    626:     return;
                    627: }
                    628: 
                    629: sub store_template {
                    630:     my ($contents,$tempexport,$count,$content_type) = @_;
                    631:     if ($contents) {
                    632:         if ($tempexport) {
                    633:             if (!-e $tempexport.'/resources') {
                    634:                 mkdir($tempexport.'/resources',0700);
                    635:             }
                    636:             if (!-e $tempexport.'/resources/'.$count) {
                    637:                 mkdir($tempexport.'/resources/'.$count,0700);
                    638:             }
                    639:             my $destination = $tempexport.'/resources/'.$count.'/'.$content_type.'.xml';
                    640:             my $storetemplate;
                    641:             if ($storetemplate = Apache::File->new('>'.$destination)) {
                    642:                 print $storetemplate $contents;
                    643:                 close($storetemplate);
                    644:             }
                    645:             if ($content_type eq 'external') {
                    646:                 return 'resources/'.$count.'/'.$content_type.'.html';
                    647:             } else {
                    648:                 return 'resources/'.$count.'/'.$content_type.'.xml';
                    649:             }
                    650:         }
                    651:     }
                    652: }
1.1       raeburn   653: 
                    654: sub simpleproblem  {
1.2       raeburn   655:     my ($symb) = @_;
                    656:     my $output;
1.1       raeburn   657:     my %qparms = &Apache::lonnet::dump('resourcedata',
1.3       albertel  658:                   $env{'course.'.$env{'request.course.id'}.'.domain'},
                    659:                   $env{'course.'.$env{'request.course.id'}.'.num'},
                    660:                   $env{'request.course.id'}.'.'.$symb);
1.1       raeburn   661:     if ($symb) {
1.3       albertel  662:         my $prefix=$env{'request.course.id'}.'.'.$symb.'.0.';
1.1       raeburn   663:         my $qtype=$qparms{$prefix.'questiontype'};
                    664:         my $qtext=$qparms{$prefix.'questiontext'};
                    665:         my $hint=$qparms{$prefix.'hinttext'};
                    666:         my %values = ();
                    667:         my %foils = ();
                    668:         if (($qtype eq 'radio') || ($qtype eq 'option')) {
                    669:             my $maxfoils=$qparms{$prefix.'maxfoils'};
                    670:             my $randomize=$qparms{$prefix.'randomize'};
                    671:             if ($qtype eq 'option') {
                    672:                 my $options=$qparms{$prefix.'options'};
                    673:                 %values = &evaloptionhash($options);
1.2       raeburn   674:                 $output .= qq|
1.1       raeburn   675: <problem>
1.11    ! raeburn   676:   <startouttext />$qtext<endouttext />
1.1       raeburn   677:   <optionresponse max="$maxfoils" randomize="$randomize">
                    678:     <foilgroup options="$options">
                    679: |;
                    680:                 for (my $k=0; $k<10; $k++) {
                    681:                     my $iter = $k+1;
1.2       raeburn   682:                     $output .= '   <foil name="foil'.$k.'" value="'.$qparms{$prefix.'value'.$iter}.'"';
                    683:                     $output .= ' location="'.$qparms{$prefix.'position'.$iter}.'" ';
                    684:                     $output .= '><startouttext />'.$qparms{$prefix.'text'.$iter}.'<endouttext /></foil>'."\n";
1.1       raeburn   685:                 }
1.2       raeburn   686:                 chomp($output);
                    687:                 $output .= qq|
1.1       raeburn   688:     </foilgroup>
                    689: |;
                    690:                 if ($hint) {
1.2       raeburn   691:                     $output .= '
1.1       raeburn   692:     <hintgroup>
                    693:      <hintpart on="default">
                    694:       <startouttext />'.$hint.'<endouttext/>
                    695:      </hintpart>
                    696:     </hintgroup>';
                    697:                 }
1.2       raeburn   698:                 $output .= qq|
1.1       raeburn   699:   </optionresponse>
                    700: </problem>
                    701: |;
                    702:             } else {
1.2       raeburn   703:                 $output .= qq|
1.1       raeburn   704: <problem>
1.11    ! raeburn   705:   <startouttext />$qtext<endouttext />
1.1       raeburn   706:   <radiobuttonresponse max="$maxfoils" randomize="$randomize">
1.11    ! raeburn   707:   <foilgroup>
1.1       raeburn   708: |;
                    709:                 for (my $k=0; $k<10; $k++) {
                    710:                     my $iter = $k+1;
1.2       raeburn   711:                     $output .= '   <foil name="foil'.$k.'" value="'.$qparms{$prefix.'value'.$iter}.'"';
                    712:                     $output .= ' location="'.$qparms{$prefix.'position'.$iter}.'" ';
                    713:                     $output .= '><startouttext />'.$qparms{$prefix.'text'.$iter}.'<endouttext /></foil>'."\n";
1.1       raeburn   714:                 }
1.2       raeburn   715:                 chomp($output);
                    716:                 $output .= qq|
1.1       raeburn   717:    </foilgroup>
                    718: |;
                    719:                 if ($hint) {
1.2       raeburn   720:                     $output .= '
1.1       raeburn   721:    <hintgroup>
                    722:     <hintpart on="default">
                    723:      <startouttext />'.$hint.'<endouttext/>
                    724:     </hintpart>
                    725:    </hintgroup>';
                    726:                 }
1.2       raeburn   727:                 $output .= qq|
1.1       raeburn   728:   </radiobuttonresponse>
                    729: </problem>
                    730: |;
                    731:             }
1.11    ! raeburn   732:         } elsif ($qtype eq 'string') {
1.1       raeburn   733:             my $stringanswer = $qparms{$prefix.'stringanswer'};
                    734:             my $stringtype=$qparms{$prefix.'stringtype'};
1.2       raeburn   735:             $output .= qq|
1.1       raeburn   736: <problem>
                    737:   <stringresponse answer="$stringanswer" type="$stringtype">
1.11    ! raeburn   738:   <startouttext />$qtext<endouttext />
        !           739:     <textline />
1.1       raeburn   740:             |;
                    741:             if ($hint) {
1.2       raeburn   742:                 $output .= '
1.1       raeburn   743:    <hintgroup>
                    744:     <hintpart on="default">
                    745:      <startouttext />'.$hint.'<endouttext/>
                    746:     </hintpart>
                    747:    </hintgroup>';
                    748:             }
1.2       raeburn   749:             $output .= qq|
1.1       raeburn   750:   </stringresponse>
                    751: </problem>
                    752: |;
1.11    ! raeburn   753:         } elsif ($qtype eq 'numerical') {
        !           754:             my $sigfigs = $qparms{$prefix.'numericalsigfigs'};
        !           755:             my $unit = $qparms{$prefix.'numericalunit'};
        !           756:             my $answer = $qparms{$prefix.'numericalanswer'};
        !           757:             my $tolerance = $qparms{$prefix.'numericaltolerance'};
        !           758:             my $format = $qparms{$prefix.'numericalformat'};
        !           759:             my $scriptblock = $qparms{$prefix.'numericalscript'};
        !           760:             $output .= qq|
        !           761: <problem>
        !           762: |;
        !           763:             if ($scriptblock) {
        !           764:                 $output .= qq|
        !           765: <script type="loncapa/perl">
        !           766: $scriptblock
        !           767: </script>|;
        !           768:              }
        !           769:              $output .= qq|
        !           770: <startouttext />$qtext<endouttext />
        !           771: <numericalresponse answer="$answer" |;
        !           772:              if ($unit ne '') {
        !           773:                  $output .= qq|unit="$unit" |;
        !           774:              }
        !           775:              if ($format ne '') {
        !           776:                  $output .= qq|format="$format" |;
        !           777:              }
        !           778:              $output =~ s{ $}{};
        !           779:              $output .= '>';
        !           780:              if ($tolerance ne '') {
        !           781:                  $output .= qq|
        !           782:   <responseparam name="tol" type="tolerance" default="$tolerance" description="Numerical Tolerance" />|;
        !           783:              }
        !           784:              if ($sigfigs) {
        !           785:                  $output .= qq|
        !           786:   <responseparam name="sig" type="int_range" default="$sigfigs" description="Significant Digits" />|;
        !           787:              }
        !           788:              $output .= qq|
        !           789:   <textline />|;
        !           790:             if ($hint) {
        !           791:                 $output .= qq|
        !           792:   <hintgroup>
        !           793:     <hintpart on="default">
        !           794:       <startouttext />'.$hint.'<endouttext/>
        !           795:     </hintpart>
        !           796:   </hintgroup>|;
        !           797:             }
        !           798:             $output .= qq|
        !           799: </numericalresponse>
        !           800: </problem>
        !           801: |;
1.1       raeburn   802:         } else {
1.2       raeburn   803:             $output .= qq|
1.1       raeburn   804: <problem>
                    805:   <startouttext />$qtext<endouttext />
                    806:   <essayresponse>
                    807:   <textfield></textfield>
                    808:   </essayresponse>
                    809: </problem>
                    810: |;
                    811:         }
                    812:     }
1.2       raeburn   813:     return $output;
1.1       raeburn   814: }
                    815: 
                    816: sub evaloptionhash {
                    817:     my $options=shift;
                    818:     $options=~s/^\(\'//;
                    819:     $options=~s/\'\)$//;
                    820:     my %returnhash=();
                    821:     foreach (split(/\'\,\'/,$options)) {
                    822:         $returnhash{$_}=$_;
                    823:     }
                    824:     return %returnhash;
                    825: }
                    826: 
                    827: sub external {
                    828:     my ($symb,$title) = @_;
                    829:     my $output;
1.2       raeburn   830:     if ($symb =~  m-\.sequence___\d+___ext(.+)$-) {
1.4       www       831:         my $exturl = &unescape($1);
1.1       raeburn   832:         $output = qq|
                    833: <html>
                    834: <head><title>$title</title>
                    835: </head>
                    836: <frameset rows="0,*" border="0">
1.2       raeburn   837: <frame src='' />
                    838: <frame src="http://$exturl" name="external" />
1.1       raeburn   839: </frameset>
                    840: </html>
                    841:         |;
                    842:     }
                    843:     return $output;
                    844: }
                    845: 
                    846: sub templatedpage {
                    847:     my ($content_type,$timestamp,$count,$uploads,$udom,$uname) = @_;
1.3       albertel  848:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    849:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
1.1       raeburn   850:     my $output = '
                    851: <'.$content_type.'>';
                    852:     my %syllabusdata=();
                    853:     my %syllabusfields=();
                    854:     if ($content_type eq 'syllabus') {
                    855:         %syllabusfields=&Apache::lonlocal::texthash(
                    856:            'aaa_instructorinfo' => 'Instructor Information',
                    857:            'bbb_description'    => 'Course Description',
                    858:            'ccc_prereq'         => 'Prerequisites',
                    859:            'cdc_classhours'     => 'Class Hours',
                    860:            'ddd_officehours'    => 'Office Hours',
                    861:            'eee_helproom'       => 'Helproom Hours',
                    862:            'efe_projectinfo'    => 'Project Information',
                    863:            'fff_examinfo'       => 'Exam Information',
                    864:            'fgf_deadlines'      => 'Deadlines',
                    865:            'ggg_grading'        => 'Grading Information',
                    866:            'hhh_readings'       => 'Readings',
                    867:            'iii_coursepack'     => 'Coursepack',
                    868:            'jjj_weblinks'       => 'Web Links',
                    869:            'kkk_textbook'       => 'Textbook',
                    870:            'lll_includeurl'     => 'URLs To Include in Syllabus'
                    871:         );
                    872:         %syllabusdata = &Apache::lonnet::dump('syllabus',$cdom,$cnum);
                    873: 
                    874:     } elsif ($content_type eq 'simplepage') {
                    875:         %syllabusfields=&Apache::lonlocal::texthash(
                    876:            'aaa_title'         => 'Page Title',
                    877:            'bbb_content'       => 'Content',
                    878:            'ccc_webreferences' => 'Web References'
                    879:         );
                    880:         %syllabusdata = &Apache::lonnet::dump('smppage_'.$timestamp,$cdom,$cnum);
                    881:     } elsif ($content_type eq 'bulletinboard') {
                    882:         %syllabusfields=&Apache::lonlocal::texthash(
                    883:            'aaa_title'         => 'Topic',
                    884:            'bbb_content'       => 'Task',
                    885:            'ccc_webreferences' => 'Web References'
                    886:         );
                    887:         %syllabusdata = &Apache::lonnet::dump('bulletinpage_'.$timestamp,$cdom,$cnum);
                    888:     } elsif ($content_type eq 'aboutme') {
                    889:         %syllabusdata=&Apache::lonnet::dump('aboutme',$udom,$uname);
                    890:         %syllabusfields=&Apache::lonlocal::texthash(
                    891:            'aaa_contactinfo'   => 'Contact Information',
1.6       weissno   892:            'bbb_aboutme'       => 'Personal Information',
1.1       raeburn   893:            'ccc_webreferences' => 'Web References'
                    894:         );
                    895:         $output .= qq|
                    896:   <username>$uname</username>
                    897:   <domain>$udom</domain>
                    898: |;
                    899:     }
                    900:     foreach (sort keys %syllabusfields) {
                    901:         $output .= qq|
                    902: <$_>
                    903:  <name>$syllabusfields{$_}</name>
                    904:  <value>$syllabusdata{$_}</value>
                    905: </$_>|;
                    906:     }
                    907:     if (defined($syllabusdata{'uploaded.photourl'})) {
1.2       raeburn   908:         if ($syllabusdata{'uploaded.photourl'} =~  m-/([^/]+)$-) {
                    909:             push @$uploads, $syllabusdata{'uploaded.photourl'};
1.1       raeburn   910:         }
                    911:         $output .= '
                    912: <photo>
                    913:  <filename>'.$count.'/'.$1.'</filename>
                    914: </photo>';
                    915:     }
                    916:     $output .= '
                    917: </'.$content_type.'>';
                    918:     return $output;
                    919: }
                    920: 
                    921: 1;
1.8       raeburn   922: 
                    923: __END__
                    924: 
                    925: =head1 NAME
                    926: 
                    927: Apache::imsexport.pm
                    928: 
                    929: =head1 SYNOPSIS
                    930: 
                    931: This is part of the LearningOnline Network with CAPA project
                    932: described at http://www.lon-capa.org.
                    933: 
                    934: =head1 SUBROUTINES
                    935: 
                    936: =over
                    937: 
                    938: =item exportcourse()
                    939: 
                    940: =item create_ims_store()
                    941: 
                    942: =item build_package()
                    943: 
                    944: =item get_dependencies()
                    945: 
                    946: =item process_content()
                    947: 
                    948: =item replicate_content()
                    949: 
                    950: =item extract_media()
                    951: 
                    952: =item store_template()
                    953: 
                    954: =item simpleproblem()
                    955: 
                    956: =item evaloptionhash()
                    957: 
                    958: =item external()
                    959: 
                    960: =item templatedpage()
                    961: 
                    962: =back
                    963: 
                    964: =cut
                    965: 

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