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