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