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

1.5       www         1: # The LearningOnline Network
                      2: #
1.10    ! raeburn     3: # $Id: imsexport.pm,v 1.9 2012/03/31 12:02:29 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>
                    676:   <optionresponse max="$maxfoils" randomize="$randomize">
                    677:     <foilgroup options="$options">
                    678: |;
                    679:                 for (my $k=0; $k<10; $k++) {
                    680:                     my $iter = $k+1;
1.2       raeburn   681:                     $output .= '   <foil name="foil'.$k.'" value="'.$qparms{$prefix.'value'.$iter}.'"';
                    682:                     $output .= ' location="'.$qparms{$prefix.'position'.$iter}.'" ';
                    683:                     $output .= '><startouttext />'.$qparms{$prefix.'text'.$iter}.'<endouttext /></foil>'."\n";
1.1       raeburn   684:                 }
1.2       raeburn   685:                 chomp($output);
                    686:                 $output .= qq|
1.1       raeburn   687:     </foilgroup>
                    688: |;
                    689:                 if ($hint) {
1.2       raeburn   690:                     $output .= '
1.1       raeburn   691:     <hintgroup>
                    692:      <hintpart on="default">
                    693:       <startouttext />'.$hint.'<endouttext/>
                    694:      </hintpart>
                    695:     </hintgroup>';
                    696:                 }
1.2       raeburn   697:                 $output .= qq|
1.1       raeburn   698:   </optionresponse>
                    699: </problem>
                    700: |;
                    701:             } else {
1.2       raeburn   702:                 $output .= qq|
1.1       raeburn   703: <problem>
                    704:   <radiobuttonresponse max="$maxfoils" randomize="$randomize">
                    705:    <foilgroup>
                    706: |;
                    707:                 for (my $k=0; $k<10; $k++) {
                    708:                     my $iter = $k+1;
1.2       raeburn   709:                     $output .= '   <foil name="foil'.$k.'" value="'.$qparms{$prefix.'value'.$iter}.'"';
                    710:                     $output .= ' location="'.$qparms{$prefix.'position'.$iter}.'" ';
                    711:                     $output .= '><startouttext />'.$qparms{$prefix.'text'.$iter}.'<endouttext /></foil>'."\n";
1.1       raeburn   712:                 }
1.2       raeburn   713:                 chomp($output);
                    714:                 $output .= qq|
1.1       raeburn   715:    </foilgroup>
                    716: |;
                    717:                 if ($hint) {
1.2       raeburn   718:                     $output .= '
1.1       raeburn   719:    <hintgroup>
                    720:     <hintpart on="default">
                    721:      <startouttext />'.$hint.'<endouttext/>
                    722:     </hintpart>
                    723:    </hintgroup>';
                    724:                 }
1.2       raeburn   725:                 $output .= qq|
1.1       raeburn   726:   </radiobuttonresponse>
                    727: </problem>
                    728: |;
                    729:             }
                    730:         } elsif ($qtype eq 'stringanswer') {
                    731:             my $stringanswer = $qparms{$prefix.'stringanswer'};
                    732:             my $stringtype=$qparms{$prefix.'stringtype'};
1.2       raeburn   733:             $output .= qq|
1.1       raeburn   734: <problem>
                    735:   <stringresponse answer="$stringanswer" type="$stringtype">
                    736:     <textline>
                    737:     </textline>
                    738:             |;
                    739:             if ($hint) {
1.2       raeburn   740:                 $output .= '
1.1       raeburn   741:    <hintgroup>
                    742:     <hintpart on="default">
                    743:      <startouttext />'.$hint.'<endouttext/>
                    744:     </hintpart>
                    745:    </hintgroup>';
                    746:             }
1.2       raeburn   747:             $output .= qq|
1.1       raeburn   748:   </stringresponse>
                    749: </problem>
                    750: |;
                    751:         } else {
1.2       raeburn   752:             $output .= qq|
1.1       raeburn   753: <problem>
                    754:   <startouttext />$qtext<endouttext />
                    755:   <essayresponse>
                    756:   <textfield></textfield>
                    757:   </essayresponse>
                    758: </problem>
                    759: |;
                    760:         }
                    761:     }
1.2       raeburn   762:     return $output;
1.1       raeburn   763: }
                    764: 
                    765: sub evaloptionhash {
                    766:     my $options=shift;
                    767:     $options=~s/^\(\'//;
                    768:     $options=~s/\'\)$//;
                    769:     my %returnhash=();
                    770:     foreach (split(/\'\,\'/,$options)) {
                    771:         $returnhash{$_}=$_;
                    772:     }
                    773:     return %returnhash;
                    774: }
                    775: 
                    776: sub external {
                    777:     my ($symb,$title) = @_;
                    778:     my $output;
1.2       raeburn   779:     if ($symb =~  m-\.sequence___\d+___ext(.+)$-) {
1.4       www       780:         my $exturl = &unescape($1);
1.1       raeburn   781:         $output = qq|
                    782: <html>
                    783: <head><title>$title</title>
                    784: </head>
                    785: <frameset rows="0,*" border="0">
1.2       raeburn   786: <frame src='' />
                    787: <frame src="http://$exturl" name="external" />
1.1       raeburn   788: </frameset>
                    789: </html>
                    790:         |;
                    791:     }
                    792:     return $output;
                    793: }
                    794: 
                    795: sub templatedpage {
                    796:     my ($content_type,$timestamp,$count,$uploads,$udom,$uname) = @_;
1.3       albertel  797:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    798:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
1.1       raeburn   799:     my $output = '
                    800: <'.$content_type.'>';
                    801:     my %syllabusdata=();
                    802:     my %syllabusfields=();
                    803:     if ($content_type eq 'syllabus') {
                    804:         %syllabusfields=&Apache::lonlocal::texthash(
                    805:            'aaa_instructorinfo' => 'Instructor Information',
                    806:            'bbb_description'    => 'Course Description',
                    807:            'ccc_prereq'         => 'Prerequisites',
                    808:            'cdc_classhours'     => 'Class Hours',
                    809:            'ddd_officehours'    => 'Office Hours',
                    810:            'eee_helproom'       => 'Helproom Hours',
                    811:            'efe_projectinfo'    => 'Project Information',
                    812:            'fff_examinfo'       => 'Exam Information',
                    813:            'fgf_deadlines'      => 'Deadlines',
                    814:            'ggg_grading'        => 'Grading Information',
                    815:            'hhh_readings'       => 'Readings',
                    816:            'iii_coursepack'     => 'Coursepack',
                    817:            'jjj_weblinks'       => 'Web Links',
                    818:            'kkk_textbook'       => 'Textbook',
                    819:            'lll_includeurl'     => 'URLs To Include in Syllabus'
                    820:         );
                    821:         %syllabusdata = &Apache::lonnet::dump('syllabus',$cdom,$cnum);
                    822: 
                    823:     } elsif ($content_type eq 'simplepage') {
                    824:         %syllabusfields=&Apache::lonlocal::texthash(
                    825:            'aaa_title'         => 'Page Title',
                    826:            'bbb_content'       => 'Content',
                    827:            'ccc_webreferences' => 'Web References'
                    828:         );
                    829:         %syllabusdata = &Apache::lonnet::dump('smppage_'.$timestamp,$cdom,$cnum);
                    830:     } elsif ($content_type eq 'bulletinboard') {
                    831:         %syllabusfields=&Apache::lonlocal::texthash(
                    832:            'aaa_title'         => 'Topic',
                    833:            'bbb_content'       => 'Task',
                    834:            'ccc_webreferences' => 'Web References'
                    835:         );
                    836:         %syllabusdata = &Apache::lonnet::dump('bulletinpage_'.$timestamp,$cdom,$cnum);
                    837:     } elsif ($content_type eq 'aboutme') {
                    838:         %syllabusdata=&Apache::lonnet::dump('aboutme',$udom,$uname);
                    839:         %syllabusfields=&Apache::lonlocal::texthash(
                    840:            'aaa_contactinfo'   => 'Contact Information',
1.6       weissno   841:            'bbb_aboutme'       => 'Personal Information',
1.1       raeburn   842:            'ccc_webreferences' => 'Web References'
                    843:         );
                    844:         $output .= qq|
                    845:   <username>$uname</username>
                    846:   <domain>$udom</domain>
                    847: |;
                    848:     }
                    849:     foreach (sort keys %syllabusfields) {
                    850:         $output .= qq|
                    851: <$_>
                    852:  <name>$syllabusfields{$_}</name>
                    853:  <value>$syllabusdata{$_}</value>
                    854: </$_>|;
                    855:     }
                    856:     if (defined($syllabusdata{'uploaded.photourl'})) {
1.2       raeburn   857:         if ($syllabusdata{'uploaded.photourl'} =~  m-/([^/]+)$-) {
                    858:             push @$uploads, $syllabusdata{'uploaded.photourl'};
1.1       raeburn   859:         }
                    860:         $output .= '
                    861: <photo>
                    862:  <filename>'.$count.'/'.$1.'</filename>
                    863: </photo>';
                    864:     }
                    865:     $output .= '
                    866: </'.$content_type.'>';
                    867:     return $output;
                    868: }
                    869: 
                    870: 1;
1.8       raeburn   871: 
                    872: __END__
                    873: 
                    874: =head1 NAME
                    875: 
                    876: Apache::imsexport.pm
                    877: 
                    878: =head1 SYNOPSIS
                    879: 
                    880: This is part of the LearningOnline Network with CAPA project
                    881: described at http://www.lon-capa.org.
                    882: 
                    883: =head1 SUBROUTINES
                    884: 
                    885: =over
                    886: 
                    887: =item exportcourse()
                    888: 
                    889: =item create_ims_store()
                    890: 
                    891: =item build_package()
                    892: 
                    893: =item get_dependencies()
                    894: 
                    895: =item process_content()
                    896: 
                    897: =item replicate_content()
                    898: 
                    899: =item extract_media()
                    900: 
                    901: =item store_template()
                    902: 
                    903: =item simpleproblem()
                    904: 
                    905: =item evaloptionhash()
                    906: 
                    907: =item external()
                    908: 
                    909: =item templatedpage()
                    910: 
                    911: =back
                    912: 
                    913: =cut
                    914: 

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