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