1: package Apache::imsimport;
2:
3: use strict;
4: use Apache::Constants qw(:common :http :methods);
5: use Apache::loncacc;
6: use Apache::loncommon();
7: use Apache::Log();
8: use Apache::lonnet;
9: use HTML::Parser;
10: use HTML::Entities();
11: use Apache::lonlocal;
12: use Apache::lonupload;
13: use File::Basename();
14: # ---------------------------------------------------------------- Display Control
15: sub display_control {
16: # figure out what page we're on and where we're heading.
17: my $page = $ENV{'form.page'};
18: my $command = $ENV{'form.go'};
19: my $current_page = &calculate_page($page,$command);
20: return $current_page;
21: }
22:
23: # CALCULATE THE CURRENT PAGE
24: sub calculate_page($$) {
25: my ($prev,$dir) = @_;
26: return 0 if $prev eq ''; # start with first page
27: return $prev + 1 if $dir eq 'NextPage';
28: return $prev - 1 if $dir eq 'PreviousPage';
29: return $prev if $dir eq 'ExitPage';
30: return 0 if $dir eq 'BackToStart';
31: }
32:
33: # ---------------------------------------------------------------- Jscript Zero
34: sub jscript_zero {
35: my ($fullpath,$jsref,$uname,$dom) = @_;
36: my $source = '';
37: if (exists($ENV{'form.go'}) ) {
38: $source = $ENV{'form.go'};
39: }
40: my %crsentry = ();
41: my $course_list;
42: my $title_list;
43: my @crslist = ();
44: @crslist = &get_ccroles($uname,$dom,\%crsentry);
45: if (@crslist > 0) {
46: $crsentry{$crslist[0]} =~ s/("|,)//g;
47: $title_list = '"'.$crsentry{$crslist[0]}.'"';
48: if (@crslist > 1) {
49: for (my $i=1; $i<@crslist; $i++) {
50: $crsentry{$crslist[$i]} =~ s/("|,)//g;
51: $title_list .= ',"'.$crsentry{$crslist[$i]}.'"';
52: }
53: }
54: }
55: $course_list = '"'.join('","',@crslist).'"';
56:
57: $$jsref = <<"END_OF_ONE";
58: function verify() {
59: if ((document.forms.dataForm.newdir.value == '') || (!document.forms.dataForm.newdir.value)) {
60: alert("You must choose a destination directory for the import")
61: return false
62: }
63: if (document.forms.dataForm.source.selectedIndex == 0) {
64: alert("You must choose the Course Management System from which the IMS package was exported");
65: return false
66: }
67: return true
68: }
69:
70: function nextPage() {
71: if (verify()) {
72: document.forms.dataForm.go.value="NextPage"
73: document.forms.dataForm.submit()
74: }
75: }
76:
77: function createWin() {
78: document.dataForm.newdir.value = "";
79: newWindow = window.open("","CreateDir","HEIGHT=400,WIDTH=750,scrollbars=yes")
80: newWindow.document.open()
81: newWindow.document.write("<html><head><title>Create IMS import directory</title><meta http-equiv='pragma' content='no-cache'>\\n")
82: newWindow.document.write("</head><body bgcolor='#CCFFDD' topmargin='0' leftmargin='0' marginheight='0'marginwidth='0' rightmargin='0'>\\n")
83: newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
84: newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='600' bgcolor='#CCFFDD'>\\n")
85: newWindow.document.write("<tr><td width='2'> </td><td width='3'> </td>\\n")
86: newWindow.document.write("<td><h3>Location: <tt>$fullpath</tt></h3><h3>New Directory</h3></td></tr>\\n")
87: newWindow.document.write("<tr><td width='2'> </td><td width='3'> </td>\\n")
88: newWindow.document.write("<td><form name='fileaction' action='/adm/cfile' method='post'>\\n")
89: newWindow.document.write("<font face='arial,helvetica,sans-serif'>Enter the name of the new directory where you will store the contents of your IMS package.<br /><br />")
90: newWindow.document.write("<input type='hidden' name='filename' value='$fullpath'>")
91: newWindow.document.write("<input type='hidden' name='action' value='newdir'>")
92: newWindow.document.write("<input type='hidden' name='callingmode' value='imsimport'>")
93: newWindow.document.write("$fullpath<input type='text' name='newfilename' value=''/>")
94: newWindow.document.write("<input type='button' value='Go' onClick='document.fileaction.submit();' />")
95: newWindow.document.write("</td></tr>\\n")
96: newWindow.document.write("</table></body></html>")
97: newWindow.document.close()
98: newWindow.focus()
99: }
100:
101: function setCourse(caller) {
102: courseID_array = new Array($course_list)
103: courseTitle_array = new Array($title_list)
104: var step1Form = document.forms.dataForm
105: var curVal = step1Form.elements[caller*2+3].options[step1Form.elements[caller*2+3].selectedIndex].value
106: step1Form.elements[caller*2+4].length = 0
107: if (step1Form.elements[caller*2+3].options[step1Form.elements[caller*2+3].selectedIndex].value == "-1") {
108: step1Form.elements[caller*2+4].options[0] = new Option("<--- Set type ","-1",true,true)
109: }
110: else {
111: if ((step1Form.elements[caller*2+3].selectedIndex == 2 ) || (step1Form.elements[caller*2+3].selectedIndex == 3)) {
112: step1Form.elements[caller*2+4].options[0] = new Option("Please Select","-1",true,true)
113: if (courseID_array.length > 0) {
114: step1Form.elements[caller*2+4].options[0] = new Option("Please Select","-1",true,true)
115: for (var i=0; i<courseID_array.length; i++) {
116: step1Form.elements[caller*2+4].options[i+1] = new Option(courseTitle_array[i],courseID_array[i],false,false)
117: }
118: }
119: else {
120: step1Form.elements[caller*2+4].options[0] = new Option("No courses available","-2",true,true)
121: step1Form.elements[caller*2+3].selectedIndex == 1
122: }
123: step1Form.elements[caller*2+4].selectedIndex = 0
124: }
125: else {
126: step1Form.elements[caller*2+4].options[0] = new Option("Not required","0",true,true)
127: }
128: }
129: }
130:
131: END_OF_ONE
132:
133: }
134:
135: # ---------------------------------------------------------------- Display Zero
136: sub display_zero {
137: my ($r,$uname,$fn,$page,$fullpath) = @_;
138: $r->print(<<"END_OF_ONE");
139: <form name="dataForm" method="post">
140: <table border='0' bgcolor='#CCFFDD' cellspacing='0' cellpadding ='0' width='100%'>
141: <tr>
142: <td colspan='2'>
143: <table border='0' cellspacing='0' cellpadding='0'>
144: <tr>
145: <td colspan='2' align='left'>
146: </td>
147: </tr>
148: <tr bgcolor='#ccddaa'>
149: <td valign='middle'><img src='/res/adm/pages/bl_step1.gif'>
150: </td>
151: <td width='100%' align='left'>
152: <font face='arial,helvetica,sans-serif'><b>Specify the Course Management system used to create the package.</b>
153: </font>
154: </td>
155: </tr>
156: <tr>
157: <td colspan='2'> </td>
158: </tr>
159: <tr>
160: <td> </td>
161: <td>
162: <font face='Arial,Helvetica,sans-serif'>
163: Please choose the CMS used to create your IMS content package.
164: <select name="source">
165: <option value='-1' selected="true">Please select
166: <option value='bb5'>Blackboard 5
167: <option value='angel'>ANGEL
168: </select>
169: </font>
170: </td>
171: </tr>
172: <tr>
173: <td colspan='2'> </td>
174: </tr>
175: <tr>
176: <td colspan='2'> </td>
177: </tr>
178: <tr bgcolor='#ccddaa'>
179: <td valign='middle'><img src='/res/adm/pages/bl_step2.gif'>
180: </td>
181: <td width='100%' align='left'>
182: <font face='arial,helvetica,sans-serif'><b>Create a directory where you will unpack your IMS package.</b> </font></td>
183: </tr>
184: <tr>
185: <td colspan='2'> </td>
186: </tr>
187: <td> </td>
188: <td>
189: <font face='Arial,Helvetica,sans-serif'>
190: Please choose a destination LON-CAPA directory in which to store the contents of the IMS package file. <input type="button" name="createdir" value="Create Directory" onClick="javascript:createWin()"><input type="hidden" name="newdir" value=""></font>
191: </td>
192: </tr>
193: <tr>
194: <td colspan='2'> <br /><br /></td>
195: </tr>
196: <tr bgcolor='#ccddaa'>
197: <td valign='middle'><img src='/res/adm/pages/bl_step3.gif'>
198: </td>
199: <td width='100%' align='left'>
200: <font face='arial,helvetica,sans-serif'><b>Indicate how any discussion boards and user data in the package should be handled</b></font>
201: </td>
202: </tr>
203: <tr>
204: <td colspan='2'> </td>
205: </tr>
206: <tr>
207: <td> </td>
208: <td>
209: <table border='0' cellspacing='0' cellpadding='1' bgcolor='#000000'>
210: <tr>
211: <td>
212: <table border='0' cellspacing='0' cellpadding='0' bgcolor='#ffffff' width='100%'>
213: <tr>
214: <td>
215: <table border='0' cellspacing='1' cellpadding='1' bgcolor='#CCFFDD' width='100%'>
216: <tr bgcolor='#ccddaa'>
217: <td align='center'><font face='arial,helvetica,sans-serif'><b>Type of data</b></font></td>
218: <td align='center'><font face='arial,helvetica,sans-serif'><b>Action</b></font></td>
219: <td align='center'><font face='arial,helvetica,sans-serif'><b>Target course</b></font></td>
220: </tr>
221: <tr bgcolor='#eeeeee'>
222: <td align='left'><font face='arial,helvetica,sans-serif'> Discussion boards  </font></td>
223: <td align='left'><font face='arial,helvetica,sans-serif'>
224: <select name='bb_handling' onChange="setCourse('0')">
225: <option value='-1'>Select
226: <option value='ignore'>Disregard
227: <option value='topics'>Import topics only
228: <option value='importall'>Import topics & posts
229: </select>
230: </font>
231: </td>
232: <td align='left'> <font face='arial,helvetica,sans-serif'>
233: <select name='bb_crs'>
234: <option value='-1'><--Pick action first
235: </select>
236: </font>
237: </td>
238: </tr>
239: <tr bgcolor='#dddddd'>
240: <td align='left'><font face='arial,helvetica,sans-serif'> User information</font> </td>
241: <td align='left'>
242: <select name='user_handling' onChange="setCourse('1')">
243: <option value='-1'>Select
244: <option value='ignore'>Disregard
245: <option value='students'>Enroll students only
246: <option value='enrollall'>Emroll all users
247: </select>
248: </font>
249: </td>
250: <td align='left'>
251: <font face='arial,helvetica,sans-serif'>
252: <select name='user_crs'>
253: <option value='-1'><--Pick action first
254: </select>
255: </font>
256: </td>
257: </tr>
258: </table>
259: </td>
260: </tr>
261: </table>
262: </td>
263: </tr>
264: </table>
265: </td>
266: </tr>
267: <tr>
268: <td colspan='2'> <br /><br /></td>
269: </tr>
270: <tr>
271: <td> </td>
272: <td><font face='arial,helvetica,sans-serif'>If you have created a destination directory, and have made your selections for the disposition of bulletin boards and user information, you should click the 'Convert' button to unpack your IMS package.</font></td>
273: </tr>
274: <tr>
275: <td colspan='2'>
276: <input type='hidden' name="go" value="">
277: <input type="hidden" name="uploaduname" value="$uname">
278: <input type="hidden" name="filename" value="$fn">
279: <input type='hidden' name="page" value="$page">
280: <input type="hidden" name="phase" value="three">
281: </td>
282: </tr>
283: <tr>
284: <td colspan='2'> </td>
285: </tr>
286: <tr>
287: <td colspan='2'>
288: <table border='0' cellspacing='0' cellpadding='0' width="100%">
289: <tr>
290: <td align='left'>
291: <input type='button' name='exitpage' value='Exit now' onClick="javascript:location.href='$fullpath'">
292: </td>
293: <td align='right'>
294: <input type="button" name="nextpage" value="Convert" onClick="javascript:nextPage()">
295: </td>
296: </tr>
297: </table>
298: </td>
299: </tr>
300: </table>
301: </td>
302: </tr>
303: </table>
304: </form>
305: END_OF_ONE
306: }
307:
308: # ---------------------------------------------------------------- Expand bb5
309: sub expand_bb5 {
310: my ($r,$uname,$udom,$fn,$page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling) = @_;
311: my @state = ();
312: my @seq = "Top";
313: my $lastitem;
314: my %resnum = ();
315: my %title = ();
316: my %filepath = ();
317: my %contentscount = ('Top' => 0);
318: my %contents = ();
319: my %parentseq = ();
320: my %base = ();
321: my %file = ();
322: my %type = ();
323: my %href = ();
324: my $identifier = '';
325: my %resinfo = ();
326: my $numfolders = 0;
327: my $numpages = 0;
328: my @timestamp = ();
329: my @boards = ();
330: my @groups = ();
331: my $board_count = 0;
332: my $board_id = time;
333: my $totseq = 0;
334: my $totpage = 0;
335: my $totprob = 0;
336: my $docroot = $ENV{'form.newdir'};
337: if (!-e "$docroot/temp") {
338: mkdir "$docroot/temp";
339: }
340: my $newdir = '';
341: if ($docroot =~ m|public_html/(.+)$|) {
342: $newdir = $1;
343: }
344: my $dirname = "/res/$udom/$uname/$newdir";
345: my $zipfile = '/home/'.$uname.'/public_html'.$fn;
346: if ($fn =~ m|\.zip$|i) {
347: open(OUTPUT, "unzip -o $zipfile -d $docroot/temp 2> /dev/null |");
348: while (<OUTPUT>) {
349: print "$_<br />";
350: }
351: close(OUTPUT);
352: }
353:
354: my $xmlfile = $docroot.'/temp/imsmanifest.xml';
355: my $p = HTML::Parser->new
356: (
357: xml_mode => 1,
358: start_h =>
359: [sub {
360: my ($tagname, $attr) = @_;
361: push @state, $tagname;
362: my $num = @state - 3;
363: my $start = $num;
364: my $statestr = '';
365: foreach (@state) {
366: $statestr .= "$_ ";
367: }
368: if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "tableofcontents") ) {
369: my $searchstr = "manifest organizations tableofcontents";
370: while ($num > 0) {
371: $searchstr .= " item";
372: $num --;
373: }
374: if (("@state" eq $searchstr) && (@state > 3)) {
375: my $itm = $attr->{identifier};
376: $resnum{$itm} = $attr->{identifierref};
377: $title{$itm} = $attr->{title};
378: if ($start > @seq) {
379: unless ($lastitem eq '') {
380: push @seq, $lastitem;
381: unless ( defined($contents{$seq[-1]}) ) {
382: @{$contents{$seq[-1]}} = ();
383: }
384: push @{$contents{$seq[-1]}},$itm;
385: $parentseq{$itm} = $seq[-1];
386: }
387: }
388: elsif ($start < @seq) {
389: my $diff = @seq - $start;
390: while ($diff > 0) {
391: pop @seq;
392: $diff --;
393: }
394: if (@seq) {
395: push @{$contents{$seq[-1]}}, $itm;
396: }
397: } else {
398: push @{$contents{$seq[-1]}}, $itm;
399: }
400: my $path;
401: if (@seq > 1) {
402: $path = join(',',@seq);
403: } elsif (@seq > 0) {
404: $path = $seq[0];
405: }
406: $filepath{$itm} = $path;
407: $contentscount{$seq[-1]} ++;
408: $lastitem = $itm;
409: }
410: } elsif ("@state" eq "manifest resources resource" ) {
411: $identifier = $attr->{identifier};
412: $base{$identifier} = $attr->{baseurl};
413: $file{$identifier} = $attr->{file};
414: $type{$identifier} = $attr->{type};
415: } elsif ("@state" eq "manifest resources resource file") {
416: push @{$href{$identifier}},$attr->{href};
417: }
418: }, "tagname, attr"],
419: text_h =>
420: [sub {
421: my ($text) = @_;
422: }, "dtext"],
423: end_h =>
424: [sub {
425: my ($tagname) = @_;
426: pop @state;
427: }, "tagname"],
428: );
429:
430: $p->parse_file($xmlfile);
431: $p->eof;
432:
433: my $topnum = 0;
434: my $destdir = $docroot;
435: if (!-e "$destdir") {
436: mkdir("$destdir",0755);
437: }
438: if (!-e "$destdir/sequences") {
439: mkdir("$destdir/sequences",0755);
440: }
441: if (!-e "$destdir/resfiles") {
442: mkdir("$destdir/resfiles",0755);
443: }
444: if (!-e "$destdir/pages") {
445: mkdir("$destdir/pages",0755);
446: }
447: if (!-e "$destdir/problems") {
448: mkdir("$destdir/problems",0755);
449: }
450: foreach my $key (sort keys %href) {
451: foreach my $file (@{$href{$key}}) {
452: my $filepath = $file;
453: if (!-e "$destdir/resfiles/$key") {
454: mkdir("$destdir/resfiles/$key",0755);
455: }
456: while ($filepath =~ m-(\w+)/(.+)-) {
457: $filepath = $2;
458: if (!-e "$destdir/resfiles/$key/$1") {
459: mkdir("$destdir/resfiles/$key/$1",0755);
460: }
461: }
462: system("cp $docroot/temp/$key/$file $destdir/resfiles/$key/$file");
463: }
464: }
465:
466: foreach my $key (sort keys %type) {
467: if ($type{$key} eq "resource/x-bb-document") {
468: %{$resinfo{$key}} = ();
469: &process_content($key,$docroot,$destdir,\%{$resinfo{$key}},$udom,$uname);
470: } elsif ($type{$key} eq "resource/x-bb-staffinfo") {
471: %{$resinfo{$key}} = ();
472: &process_staff($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
473: } elsif ($type{$key} eq "resource/x-bb-externallink") {
474: %{$resinfo{$key}} = ();
475: &process_link($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
476: } elsif ($type{$key} eq "resource/x-bb-discussionboard") {
477: %{$resinfo{$key}} = ();
478: unless ($bb_handling eq 'ignore') {
479: $contentscount{Top} ++;
480: push @boards, $key;
481: $timestamp[$board_count] = $board_id;
482: &process_db($key,$docroot,$destdir,$board_id,$bb_crs,$bb_cdom,$bb_handling,$uname,\%{$resinfo{$key}});
483: $board_id ++;
484: $board_count ++;
485: }
486: } elsif ($type{$key} eq "resource/x-bb-announcement") {
487: %{$resinfo{$key}} = ();
488: &process_announce($key,$docroot,$destdir,\%{$resinfo{$key}});
489: } elsif ($type{$key} eq "assessment/x-bb-pool") {
490: %{$resinfo{$key}} = ();
491: &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob);
492: } elsif ($type{$key} eq "assessment/x-bb-quiz") {
493: %{$resinfo{$key}} = ();
494: &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob);
495: } elsif ($type{$key} eq "assessment/x-bb-survey") {
496: %{$resinfo{$key}} = ();
497: &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob);
498: } elsif ($type{$key} eq "assessment/x-bb-group") {
499: %{$resinfo{$key}} = ();
500: $contentscount{Top} ++;
501: push @groups, $key;
502: &process_group($key,$docroot,$destdir,\%{$resinfo{$key}});
503: } elsif ($type{$key} eq "resource/x-bb-user") {
504: %{$resinfo{$key}} = ();
505: unless ($user_handling eq 'ignore') {
506: &process_user($key,$docroot,$destdir,\%{$resinfo{$key}},$user_crs,$user_cdom,$user_handling);
507: }
508: }
509: }
510:
511: my $nextnum = 0;
512: open(TOPFILE,">$destdir/sequences/ims_import.sequence");
513: print TOPFILE "<map>\n";
514: my $fileopen = 0;
515: my $areakey;
516: my $areacount = 0;
517: my $lastentry = '';
518: my $notlastentry = '';
519: my %pagecount = ();
520: my %pagecontents = ();
521: my %pageflag = ();
522: my %seqflag = ();
523: my %seqcount = ();
524:
525: foreach my $key (sort keys %resnum) {
526: $pageflag{$key} = 0;
527: $seqflag{$key} = 0;
528: $seqcount{$key} = 0;
529: $pagecount{$key} = -1;
530: if ($filepath{$key} eq 'Top') {
531: $topnum ++;
532: $nextnum = $topnum +1;
533: print TOPFILE qq|<resource id="$topnum" src="/res/$udom/$uname/$newdir/sequences/$key.sequence" title="$title{$key}"|;
534: if ($topnum == 1) {
535: print TOPFILE qq| type="start"></resource>
536: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
537: if ($topnum == $contentscount{'Top'}) {
538: print TOPFILE qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
539: }
540: } else {
541: if ($topnum == $contentscount{'Top'}) {
542: print TOPFILE qq| type="finish"></resource>\n|;
543: } else {
544: print TOPFILE qq|></resource>
545: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
546: }
547: }
548: my $seqname = $title{$key};
549: $seqname =~ s/\s//g;
550: $seqname =~ tr/A-Z/a-z/;
551: if ($fileopen) {
552: if ($areacount == 0) {
553: print AREAFILE qq|<resource id="1" src="" type="start">
554: <link from="1" to="2" index="1"></link>
555: <resource id="2" src="" type="finish">\n|;
556: } elsif ($areacount == 1) {
557: print AREAFILE qq|<resource id="2" src="" type="finish">\n|;
558: } else {
559: print AREAFILE qq|$lastentry\n|;
560: }
561: print AREAFILE "</map>\n";
562: close(AREAFILE);
563: $fileopen = 0;
564: }
565: $areakey = $key;
566: @{$pagecontents{$areakey}} = ();
567: open(AREAFILE,">$destdir/sequences/$key.sequence");
568: print AREAFILE "<map>\n";
569: $fileopen = 1;
570: $areacount = 0;
571: } else {
572: if ($filepath{$key} eq "Top,$areakey") {
573: my $src = '';
574: if ($areacount == 0) {
575: if ($resinfo{$resnum{$key}}{'isfolder'} eq "true") {
576: $src = 'sequences/'.$key.".sequence";
577: $pageflag{$areakey} = 0;
578: $seqflag{$areakey} = 1;
579: } else {
580: if ($pageflag{$areakey}) {
581: push @{$pagecontents{$areakey}[$pagecount{$areakey}]},$key;
582: } else {
583: $pagecount{$areakey} ++;
584: $src = 'pages/'.$areakey.'_'.$pagecount{$areakey}.'.page';
585: @{$pagecontents{$areakey}[$pagecount{$areakey}]} = ("$key");
586: $seqflag{$areakey} = 0;
587: }
588: }
589: unless ($pageflag{$areakey}) {
590: print AREAFILE qq|<resource id="1" src="/res/$udom/$uname/$newdir/$src" title="$title{$key}" type="start">
591: <link from="1" to="2" index="1"></link>\n|;
592: $areacount ++;
593: $notlastentry = "";
594: unless ($seqflag{$areakey}) {
595: $pageflag{$areakey} = 1;
596: }
597: }
598: } else {
599: my $id = $areacount +1;
600: my $nextid = $id +1;
601: $areacount ++;
602: if ($resinfo{$resnum{$key}}{'isfolder'} eq "true") {
603: $src = 'sequences/'.$key.".sequence";
604: $pageflag{$areakey} = 0;
605: $seqflag{$areakey} = 1;
606: } else {
607: if ($pageflag{$areakey}) {
608: push @{$pagecontents{$areakey}[$pagecount{$areakey}]},$key;
609: } else {
610: $pagecount{$areakey} ++ ;
611: $src = 'pages/'.$areakey.'_'.$pagecount{$areakey}.'.page';
612: @{$pagecontents{$areakey}[$pagecount{$areakey}]} = ("$key");
613: $seqflag{$areakey} = 0;
614: }
615: }
616: unless ($pageflag{$areakey}) {
617: print AREAFILE $notlastentry.qq|<resource id="$id" src="/res/$udom/$uname/$newdir/$src" title="$title{$key}" |;
618: unless ($seqflag{$areakey}) {
619: $pageflag{$areakey} = 1;
620: }
621: }
622: $lastentry = qq|type="finish"></resource>|;
623: $notlastentry = qq|></resource>
624: <link from="$id" to="$nextid" index="$id"></link>\n|;
625: }
626: }
627: my $src ="";
628: my $next_id = 1;
629: my $curr_id = 0;
630: if ( (($type{$resnum{$key}} eq "resource/x-bb-document") || ($type{$resnum{$key}} eq "resource/x-bb-staffinfo") || ($type{$resnum{$key}} eq "resource/x-bb-externallink")) && ($resinfo{$resnum{$key}}{'isfolder'} eq "true") ) {
631: # if ( ($type{$resnum{$key}} eq "resource/x-bb-staffinfo") && ($resinfo{$resnum{$key}}{'isfolder'} eq "true") ) {
632: # print "$key $filepath{$key} $resnum{$key} $title{$key}\n";
633: # print "Folder for item - $key - res - $resnum{$key}\n";
634: # print "$key, $contentscount{$key}\n";
635: # foreach (@{$contents{$key}}) {
636: # print "$key, $_\n";
637: # }
638: # print STDERR "Contents Count for $key is $contentscount{$key}\n";
639: open(LOCFILE,">$destdir/sequences/$key.sequence");
640: print LOCFILE "<map>\n";
641: $totseq ++;
642: if ($contentscount{$key} == 0) {
643: print LOCFILE qq|<resource id="1" src="" type="start"></resource>
644: <link from="1" to="2" index="1"></link>
645: <resource id="2" src="" type="finish"></resource>\n|;
646: } else {
647: if ($resinfo{$resnum{$contents{$key}[0]}}{'isfolder'} eq "true") {
648: $src = 'sequences/'.$contents{$key}[0].".sequence";
649: $pageflag{$key} = 0;
650: $seqflag{$key} = 1;
651: $seqcount{$key} ++;
652: } else {
653: if ($pageflag{$key}) {
654: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[0];
655: } else {
656: $pagecount{$key} ++;
657: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
658: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[0]");
659: $seqflag{$key} = 0;
660: }
661: }
662: unless ($pageflag{$key}) {
663: print LOCFILE qq|<resource id="1" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[0]}" type="start"|;
664: unless ($seqflag{$key}) {
665: $pageflag{$key} = 1;
666: }
667: }
668: if ($contentscount{$key} == 1) {
669: print LOCFILE qq|></resource>
670: <link from="1" to="2" index="1"></link>
671: <resource id="2" src="" type="finish"></resource>\n|;
672: } else {
673: if ($contentscount{$key} > 2 ) {
674: for (my $i=1; $i<$contentscount{$key}-1; $i++) {
675: if ($resinfo{$resnum{$contents{$key}[$i]}}{'isfolder'} eq "true") {
676: $src = 'sequences/'.$contents{$key}[$i].".sequence";
677: $pageflag{$key} = 0;
678: $seqflag{$key} = 1;
679: $seqcount{$key} ++;
680: } else {
681: if ($pageflag{$key}) {
682: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$i];
683: } else {
684: $pagecount{$key} ++;
685: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
686: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$i]");
687: $seqflag{$key} = 0;
688: }
689: }
690: unless ($pageflag{$key}) {
691: $curr_id ++;
692: $next_id ++;
693: print LOCFILE qq|></resource>
694: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
695: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$i]}"|;
696: unless ($seqflag{$key}) {
697: $pageflag{$key} = 1;
698: }
699: }
700: }
701: }
702: if ($resinfo{$resnum{$contents{$key}[$contentscount{$key}-1]}}{'isfolder'} eq "true") {
703: $src = 'sequences/'.$contents{$key}[$contentscount{$key}-1].".sequence";
704: $pageflag{$key} = 0;
705: $seqflag{$key} = 1;
706: } else {
707: if ($pageflag{$key}) {
708: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$contentscount{$key}-1];
709: } else {
710: $pagecount{$key} ++;
711: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
712: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$contentscount{$key}-1]");
713: }
714: }
715: if ($pageflag{$key}) {
716: if ($seqcount{$key} + $pagecount{$key} +1 == 1) {
717: print LOCFILE qq|></resource>
718: <link from="1" index="1" to="2">
719: <resource id ="2" src="" title="" type="finish"></resource>\n|;
720: } else {
721: print LOCFILE qq| type="finish"></resource>\n|;
722: }
723: } else {
724: $curr_id ++;
725: $next_id ++;
726: print LOCFILE qq|></resource>
727: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
728: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$contentscount{$key}-1]}" type="finish"></resource>\n|;
729: }
730: }
731: }
732: print LOCFILE "</map>\n";
733: close(LOCFILE);
734: }
735: }
736: }
737: if (@boards > 0) {
738: $topnum ++;
739: print TOPFILE qq|<resource id="$topnum" src="/res/$udom/$uname/$newdir/sequences/bulletinboards.sequence" title="Course Bulletin Boards"|;
740: $nextnum = $topnum +1;
741: if ($topnum == 1) {
742: print TOPFILE qq| type="start"></resource>
743: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
744: if ($topnum == $contentscount{'Top'}) {
745: print TOPFILE qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
746: }
747: } else {
748: if ($topnum == $contentscount{'Top'}) {
749: print TOPFILE qq| type="finish"></resource>\n|;
750: } else {
751: print TOPFILE qq|></resource>
752: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
753: }
754: }
755: open(BOARD,">$destdir/sequences/bulletinboards.sequence");
756: print BOARD qq|<map>
757: <resource id="1" src="/adm/$udom/$uname/$timestamp[0]/bulletinboard" title="$resinfo{$boards[0]}{title}" type="start"></resource>
758: <link from="1" to="2" index="1"></link>|;
759: if (@boards == 1) {
760: print BOARD qq|
761: <resource id="2" src="" type="finish"></resource>\n|;
762: } else {
763: for (my $i=1; $i<@boards; $i++) {
764: print BOARD qq|<resource id="$i" src="/adm/$udom/$uname/$timestamp[$i]/bulletinboard" title="$resinfo{$boards[$i]}{title}"|;
765: my $curr = $i+1;
766: my $next = $i+2;
767: if (@boards == $i) {
768: print BOARD qq| type="finish"></resource>\n|;
769: } else {
770: print BOARD qq|></resource>
771: <link from="$curr" to="$next" index="$next">\n|;
772: }
773: }
774: }
775: print BOARD qq|</map>|;
776: close(BOARD);
777: }
778: print TOPFILE "</map>";
779: close(TOPFILE);
780: foreach my $key (sort keys %pagecontents) {
781: for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
782: my $filestem = "/res/$udom/$uname/$newdir";
783: my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
784: $totpage ++;
785: open(PAGEFILE,">$filename");
786: print PAGEFILE qq|<map>
787: <resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][0]}.html" id="1" type="start" title="$title{$pagecontents{$key}[$i][0]}"></resource>
788: <link to="2" index="1" from="1">\n|;
789: if (@{$pagecontents{$key}[$i]} == 1) {
790: print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>|;
791: } elsif (@{$pagecontents{$key}[$i]} == 2) {
792: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][1]}.html" id="2" type="finish" title="$title{$pagecontents{$key}[$i][1]}"></resource>|;
793: } else {
794: for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
795: my $curr_id = $j+1;
796: my $next_id = $j+2;
797: my $resource = $filestem.'/resfiles/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html';
798: print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$title{$pagecontents{$key}[$i][$j]}"></resource>
799: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
800: }
801: my $final_id = @{$pagecontents{$key}[$i]};
802: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][-1]}.html" id="$final_id" type="finish" title="$title{$pagecontents{$key}[$i][-1]}"></resource>\n|;
803: }
804: print PAGEFILE "</map>";
805: close(PAGEFILE);
806: }
807: }
808: system(" rm -r $docroot/temp");
809: return($totseq,$totpage,$totprob);
810: }
811:
812:
813: sub process_user {
814: my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_;
815: my $xmlfile = $docroot."/temp/".$res.".dat";
816: my $filecount = 0;
817: my @state;
818: my $userid = '';
819: my $linknum = 0;
820:
821: my $p = HTML::Parser->new
822: (
823: xml_mode => 1,
824: start_h =>
825: [sub {
826: my ($tagname, $attr) = @_;
827: push @state, $tagname;
828: if (@state eq "USERS USER") {
829: $userid = $attr->{value};
830: %{$$settings{$userid}} = ();
831: @{$$settings{$userid}{links}} = ();
832: } elsif (@state eq "USERS USER LOGINID") {
833: $$settings{$userid}{loginid} = $attr->{value};
834: } elsif (@state eq "USERS USER PASSPHRASE") {
835: $$settings{$userid}{passphrase} = $attr->{value};
836: } elsif ("@state" eq "USERS USER STUDENTID" ) {
837: $$settings{$userid}{studentid} = $attr->{value};
838: } elsif ("@state" eq "USERS USER NAMES FAMILY" ) {
839: $$settings{$userid}{family} = $attr->{value};
840: } elsif ("@state" eq "USERS USER NAMES GIVEN" ) {
841: $$settings{$userid}{given} = $attr->{value};
842: } elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") {
843: $$settings{$userid}{email} = $attr->{value};
844: } elsif ("@state" eq "USERS USER USER_ROLE") {
845: $$settings{$userid}{user_role} = $attr->{value};
846: } elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") {
847: $$settings{$userid}{isavailable} = $attr->{value};
848: } elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") {
849: $$settings{$userid}{image} = $attr->{value};
850: } elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) {
851: %{$$settings{$userid}{links}[$linknum]} = ();
852: $$settings{$userid}{links}[$linknum]{url} = $attr->{value};
853: $linknum ++;
854: }
855: }, "tagname, attr"],
856: text_h =>
857: [sub {
858: my ($text) = @_;
859: if ("@state" eq "USERS USER PERSONALPAGE TITLE") {
860: $$settings{$userid}{title} = $text;
861: } elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") {
862: $$settings{$userid}{description} = $text;
863: } elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) {
864: $$settings{$userid}{links}[$linknum]{title} = $text;
865: } elsif (($state[-3] eq "LINK") && ($state[-2] eq "DESCRIPTION") && ($state[-1] eq "TEXT")) {
866: $$settings{$userid}{links}[$linknum]{text} = $text;
867: }
868: }, "dtext"],
869: end_h =>
870: [sub {
871: my ($tagname) = @_;
872: if (@state eq "USERS USER") {
873: $linknum = 0;
874: }
875: pop @state;
876: }, "tagname"],
877: );
878: $p->unbroken_text(1);
879: $p->parse_file($xmlfile);
880: $p->eof;
881:
882: my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
883: my $xmlstem = $$configvars{'lonDaemons'}."/tmp/".$dom."_".$crs."_";
884:
885: open (STUFILE,">
886: foreach my $user_id (keys %{$settings}) {
887: if ($$settings{$user_id}{user_role} eq "s") {
888: # enroll as a single student
889: } elsif ($user_handling eq 'enrollall') {
890: # enroll as another user type
891: }
892: }
893: }
894:
895: sub process_group {
896: my ($res,$docroot,$destdir,$settings) = @_;
897: my $xmlfile = $docroot."/".$res.".dat";
898: my $filecount = 0;
899: my @state;
900: my $grp;
901:
902: my $p = HTML::Parser->new
903: (
904: xml_mode => 1,
905: start_h =>
906: [sub {
907: my ($tagname, $attr) = @_;
908: push @state, $tagname;
909: if (@state eq "GROUPS GROUP") {
910: $grp = $attr->{id};
911: }
912: if (@state eq "GROUPS GROUP TITLE") {
913: $$settings{$grp}{title} = $attr->{value};
914: } elsif (@state eq "GROUPS GROUP FLAGS ISAVAILABLE") {
915: $$settings{$grp}{isavailable} = $attr->{value};
916: } elsif (@state eq "GROUPS GROUP FLAGS HASCHATROOM") {
917: $$settings{$grp}{chat} = $attr->{value};
918: } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
919: $$settings{$grp}{discussion} = $attr->{value};
920: } elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") {
921: $$settings{$grp}{transfer} = $attr->{value};
922: } elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") {
923: $$settings{$grp}{public} = $attr->{value};
924: }
925: }, "tagname, attr"],
926: text_h =>
927: [sub {
928: my ($text) = @_;
929: if ("@state" eq "GROUPS DESCRIPTION") {
930: $$settings{$grp}{description} = $text;
931: # print "Staff text is $text\n";
932: }
933: }, "dtext"],
934: end_h =>
935: [sub {
936: my ($tagname) = @_;
937: pop @state;
938: }, "tagname"],
939: );
940: $p->unbroken_text(1);
941: $p->parse_file($xmlfile);
942: $p->eof;
943: }
944:
945: sub process_staff {
946: my ($res,$docroot,$dirname,$destdir,$settings) = @_;
947: my $xmlfile = $docroot."/temp/".$res.".dat";
948: my $filecount = 0;
949: my @state;
950: %{$$settings{name}} = ();
951: %{$$settings{office}} = ();
952:
953: my $p = HTML::Parser->new
954: (
955: xml_mode => 1,
956: start_h =>
957: [sub {
958: my ($tagname, $attr) = @_;
959: push @state, $tagname;
960: if (@state eq "STAFFINFO TITLE") {
961: $$settings{title} = $attr->{value};
962: } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
963: $$settings{textcolor} = $attr->{value};
964: } elsif (@state eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
965: $$settings{ishtml} = $attr->{value};
966: } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
967: $$settings{isavailable} = $attr->{value};
968: } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) {
969: $$settings{isfolder} = $attr->{value};
970: } elsif ("@state" eq "STAFFINFO POSITION" ) {
971: $$settings{position} = $attr->{value};
972: } elsif ("@state" eq "STAFFINFO HOMEPAGE" ) {
973: $$settings{homepage} = $attr->{value};
974: } elsif ("@state" eq "STAFFINFO IMAGE") {
975: $$settings{image} = $attr->{value};
976: }
977: }, "tagname, attr"],
978: text_h =>
979: [sub {
980: my ($text) = @_;
981: if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") {
982: $$settings{text} = $text;
983: # print "Staff text is $text\n";
984: } elsif ("@state" eq "STAFFINFO CONTACT PHONE") {
985: $$settings{phone} = $text;
986: } elsif ("@state" eq "STAFFINFO CONTACT EMAIL") {
987: $$settings{email} = $text;
988: } elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") {
989: $$settings{name}{formaltitle} = $text;
990: } elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") {
991: $$settings{name}{family} = $text;
992: } elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") {
993: $$settings{name}{given} = $text;
994: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") {
995: $$settings{office}{hours} = $text;
996: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") {
997: $$settings{office}{address} = $text;
998: }
999: }, "dtext"],
1000: end_h =>
1001: [sub {
1002: my ($tagname) = @_;
1003: pop @state;
1004: }, "tagname"],
1005: );
1006: $p->unbroken_text(1);
1007: $p->parse_file($xmlfile);
1008: $p->eof;
1009:
1010: my $fontcol = '';
1011: if (defined($$settings{textcolor})) {
1012: $fontcol = qq|color="$$settings{textcolor}"|;
1013: }
1014: if (defined($$settings{text})) {
1015: if ($$settings{ishtml} eq "true") {
1016: $$settings{text} = &HTML::Entities::decode($$settings{text});
1017: }
1018: }
1019: my $staffentry = qq|
1020: <table border="0" cellpadding="0" cellspacing="0" width="100%">
1021: <tr>
1022: <td colspan="2"><hr /><font face="arial,helv" size="3"><b>$$settings{name}{formaltitle} $$settings{name}{given} $$settings{name}{family}</b></font>
1023: </td>
1024: </tr>
1025: <tr>
1026: <td valign="top">
1027: <table width="100% border="0" cols="2" cellpadding="0" cellspacing="0">|;
1028: if ( defined($$settings{email}) && $$settings{email} ne '') {
1029: $staffentry .= qq|
1030: <tr>
1031: <td width="100" valign="top">
1032: <font face="arial" size="2"><b>Email:</b></font>
1033: </td>
1034: <td>
1035: <font face="arial" size="2"><a href="mailto:$$settings{email}">$$settings{email}</a></font>
1036: </td>
1037: </tr>
1038: |;
1039: }
1040: if (defined($$settings{phone}) && $$settings{phone} ne '') {
1041: $staffentry .= qq|
1042: <tr>
1043: <td width="100" valign="top">
1044: <font face="arial" size="2"><b>Phone:</b></font>
1045: </td>
1046: <td>
1047: <font face="arial" size="2">$$settings{phone}</font>
1048: </td>
1049: </tr>
1050: |;
1051: }
1052: if (defined($$settings{office}{address}) && $$settings{office}{address} ne '') {
1053: $staffentry .= qq|
1054: <tr>
1055: <td width="100" valign="top">
1056: <font face="arial" size="2"><b>Address:</b></font>
1057: </td>
1058: <td>
1059: <font face="arial" size="2">$$settings{office}{address}</font>
1060: </td>
1061: </tr>
1062: |;
1063: }
1064: if (defined($$settings{office}{hours}) && $$settings{office}{hours} ne '') {
1065: $staffentry .= qq|
1066: <tr>
1067: <td width="100" valign="top">
1068: <font face="arial" size="2"><b>Office Hours:</b></font>
1069: </td>
1070: <td>
1071: <font face=arial size=2>$$settings{office}{hours}</font>
1072: </td>
1073: </tr>
1074: |;
1075: }
1076: if ( defined($$settings{homepage}) && $$settings{homepage} ne '') {
1077: $staffentry .= qq|
1078: <tr>
1079: <td width="100" valign="top">
1080: <font face="arial" size="2"><b>Personal Link:</b></font>
1081: </td>
1082: <td>
1083: <font face="arial" size="2"><a href="$$settings{homepage}">$$settings{homepage}</a></font>
1084: </td>
1085: </tr>
1086: |;
1087: }
1088: if (defined($$settings{text}) && $$settings{text} ne '') {
1089: $staffentry .= qq|
1090: <tr>
1091: <td colspan="2">
1092: <font face="arial" size="2" $fontcol><b>Other Information:</b><br/>$$settings{text}</font>
1093: </td>
1094: </tr>
1095: |;
1096: }
1097: $staffentry .= qq|
1098: </table>
1099: </td>
1100: <td align="right" valign="top">
1101: |;
1102: if ( defined($$settings{image}) ) {
1103: $staffentry .= qq|
1104: <img src="$dirname/resfiles/$res/$$settings{image}">
1105: |;
1106: }
1107: $staffentry .= qq|
1108: </td>
1109: </tr>
1110: </table>
1111: |;
1112: open(FILE,">$destdir/resfiles/$res.html");
1113: print FILE qq|<html>
1114: <head>
1115: <title>$$settings{title}</title>
1116: </head>
1117: <body bgcolor='#ffffff'>
1118: $staffentry
1119: </body>
1120: </html>|;
1121: close(FILE);
1122: }
1123:
1124: sub process_link {
1125: my ($res,$docroot,$dirname,$destdir,$settings) = @_;
1126: my $xmlfile = $docroot."/temp/".$res.".dat";
1127: my @state = ();
1128: my $p = HTML::Parser->new
1129: (
1130: xml_mode => 1,
1131: start_h =>
1132: [sub {
1133: my ($tagname, $attr) = @_;
1134: push @state, $tagname;
1135: if (@state eq "EXTERNALLINK TITLE") {
1136: $$settings{title} = $attr->{value};
1137: } elsif (@state eq "EXTERNALLINK TEXTCOLOR") {
1138: $$settings{textcolor} = $attr->{value};
1139: } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {
1140: $$settings{ishtml} = $attr->{value};
1141: } elsif ("@state" eq "EXTERNALLINKS FLAGS ISAVAILABLE" ) {
1142: $$settings{isavailable} = $attr->{value};
1143: } elsif ("@state" eq "EXTERNALLINKS FLAGS LAUNCHINNEWWINDOW" ) {
1144: $$settings{newwindow} = $attr->{value};
1145: } elsif ("@state" eq "EXTERNALLINKS FLAGS ISFOLDER" ) {
1146: $$settings{isfolder} = $attr->{value};
1147: } elsif ("@state" eq "EXTERNALLINKS POSITION" ) {
1148: $$settings{position} = $attr->{value};
1149: } elsif ("@state" eq "EXTERNALLINKS URL" ) {
1150: $$settings{url} = $attr->{value};
1151: }
1152: }, "tagname, attr"],
1153: text_h =>
1154: [sub {
1155: my ($text) = @_;
1156: if ("@state" eq "EXTERNALLINKS DESCRIPTION TEXT") {
1157: $$settings{text} = $text;
1158: }
1159: }, "dtext"],
1160: end_h =>
1161: [sub {
1162: my ($tagname) = @_;
1163: pop @state;
1164: }, "tagname"],
1165: );
1166: $p->unbroken_text(1);
1167: $p->parse_file($xmlfile);
1168: $p->eof;
1169:
1170: my $linktag = '';
1171: my $fontcol = '';
1172: if (defined($$settings{textcolor})) {
1173: $fontcol = qq|<font color="$$settings{textcolor}">|;
1174: }
1175: if (defined($$settings{text})) {
1176: if ($$settings{ishtml} eq "true") {
1177: $$settings{text} = &HTML::Entities::decode($$settings{text});
1178: }
1179: }
1180:
1181: if (defined($$settings{url}) ) {
1182: $linktag = qq|<a href="$$settings{url}"|;
1183: if ($$settings{newwindow} eq "true") {
1184: $linktag .= qq| target="launch"|;
1185: }
1186: $linktag .= qq|>$$settings{title}</a>|;
1187: }
1188:
1189: open(FILE,">$destdir/resfiles/$res.html");
1190: print FILE qq|<html>
1191: <head>
1192: <title>$$settings{title}</title>
1193: </head>
1194: <body bgcolor='#ffffff'>
1195: $fontcol
1196: $linktag
1197: $$settings{text}
1198: |;
1199: if (defined($$settings{textcolor})) {
1200: print FILE qq|</font>|;
1201: }
1202: print FILE qq|
1203: </body>
1204: </html>|;
1205: close(FILE);
1206: }
1207:
1208: sub process_db {
1209: my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings) = @_;
1210: my $xmlfile = $docroot."/temp/".$res.".dat";
1211: my @state = ();
1212: my @allmsgs = ();
1213: my %msgidx = ();
1214: my $longcrs = '';
1215: if ($crs =~ m/^(\d)(\d)(\d)/) {
1216: $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
1217: }
1218: my %threads; # all quotes, keyed by message ID
1219: my $msg_id; # the current message ID
1220: my %message; # the current message being accumulated for $msg_id
1221:
1222: my $p = HTML::Parser->new
1223: (
1224: xml_mode => 1,
1225: start_h =>
1226: [sub {
1227: my ($tagname, $attr) = @_;
1228: push @state, $tagname;
1229: my $depth = 0;
1230: my @seq = ();
1231: if ("@state" eq "FORUM TITLE") {
1232: $$settings{title} = $attr->{value};
1233: } elsif ("@state" eq "FORUM DESCRIPTION TEXTCOLOR") {
1234: $$settings{textcolor} = $attr->{value};
1235: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISHTML") {
1236: $$settings{ishtml} = $attr->{value};
1237: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") {
1238: $$settings{newline} = $attr->{value};
1239: } elsif ("@state" eq "FORUM POSITION" ) {
1240: $$settings{position} = $attr->{value};
1241: } elsif ("@state" eq "FORUM FLAGS ISREADONLY") {
1242: $$settings{isreadonly} = $attr->{value};
1243: } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) {
1244: $$settings{isavailable} = $attr->{value};
1245: } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) {
1246: $$settings{allowanon} = $attr->{value};
1247: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1248: if ($state[-1] eq "MSG") {
1249: unless ($msg_id eq '') {
1250: push @{$threads{$msg_id}}, { %message };
1251: $depth = @state - 3;
1252: if ($depth > @seq) {
1253: push @seq, $msg_id;
1254: }
1255: }
1256: if ($depth < @seq) {
1257: pop @seq;
1258: }
1259: $msg_id = $attr->{id};
1260: push @allmsgs, $msg_id;
1261: $msgidx{$msg_id} = @allmsgs;
1262: %message = ();
1263: $message{depth} = $depth;
1264: if ($depth > 0) {
1265: $message{parent} = $seq[-1];
1266: } else {
1267: $message{parent} = "None";
1268: }
1269: } elsif ($state[-1] eq "TITLE") {
1270: $message{title} = $attr->{value};
1271: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISHTML" ) ) {
1272: $message{ishtml} = $attr->{value};
1273: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISNEWLINELITERAL" ) ) {
1274: $message{newline} = $attr->{value};
1275: } elsif ( ( $state[-2] eq "DATES" ) && ( $state[-1] eq "CREATED" ) ) {
1276: $message{created} = $attr->{value};
1277: } elsif ( $state[@state-2] eq "FLAGS") {
1278: if ($state[@state-1] eq "ISANONYMOUS") {
1279: $message{isanonymous} = $attr->{value};
1280: }
1281: } elsif ( $state[-2] eq "USER" ) {
1282: if ($state[-1] eq "USERID") {
1283: $message{userid} = $attr->{value};
1284: } elsif ($state[@state-1] eq "USERNAME") {
1285: $message{username} = $attr->{value};
1286: } elsif ($state[@state-1] eq "EMAIL") {
1287: $message{email} = $attr->{value};
1288: }
1289: } elsif ( ($state[-2] eq "FILELIST") && ($state[-1] eq "IMAGE") ) {
1290: $message{attachment} = $attr->{value};
1291: }
1292: }
1293: }, "tagname, attr"],
1294: text_h =>
1295: [sub {
1296: my ($text) = @_;
1297: if ("@state" eq "FORUM DESCRIPTION TEXT") {
1298: $$settings{text} = $text;
1299: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1300: if ( ($state[-2] eq "MESSAGETEXT") && ($state[-1] eq "TEXT") ){
1301: $message{text} = $text;
1302: }
1303: }
1304: }, "dtext"],
1305: end_h =>
1306: [sub {
1307: my ($tagname) = @_;
1308: if ( $state[-1] eq "MESSAGETHREADS" ) {
1309: push @{$threads{$msg_id}}, { %message };
1310: }
1311: pop @state;
1312: }, "tagname"],
1313: );
1314: $p->unbroken_text(1);
1315: $p->parse_file($xmlfile);
1316: $p->eof;
1317:
1318: # if ($destcourse =~ m/^(\d)(\d)(\d)/) {
1319: # $longcourse = $1.'/'.$2.'/'.$3.'/'.$destcourse;
1320: # }
1321: # my $bbfilename = '/home/httpd/lonUsers/'.$udom.'/'.$longcourse.'bulletinpage_'.$timestamp.'.db';
1322: # my %hash;
1323: # tie(%hash,'GDBM_File',$bbfilename,&GDBM_WRCREAT,0640);
1324: # $hash{'aaa_title'}=$$settings{title};
1325: # untie %hash;
1326: if (defined($$settings{text})) {
1327: if ($$settings{ishtml} eq "false") {
1328: if ($$settings{isnewline} eq "true") {
1329: $$settings{text} =~ s#\n#<br/>#g;
1330: }
1331: } else {
1332: $$settings{text} = &HTML::Entities::decode($$settings{text});
1333: }
1334: if (defined($$settings{fontcolor}) ) {
1335: $$settings{text} = "<font color=\"".$$settings{textcolor}."\">".$$settings{text}."</font>";
1336: }
1337: }
1338: my $boardname = 'bulletinpage_'.$timestamp;
1339: my %boardinfo = (
1340: 'aaa_title' => $$settings{title},
1341: 'bbb_content' => $$settings{text},
1342: 'ccc_webreferences' => '',
1343: 'uploaded.lastmodified' => time,
1344: );
1345:
1346: my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
1347: if ($handling eq 'importall') {
1348: foreach my $msg_id (@allmsgs) {
1349: foreach my $message ( @{$threads{$msg_id}} ) {
1350: my %contrib = (
1351: 'sendername' => $$message{userid},
1352: 'senderdomain' => $cdom,
1353: 'screenname' => '',
1354: 'plainname' => $$message{username},
1355: );
1356: unless ($$message{parent} eq 'None') {
1357: $contrib{replyto} = $msgidx{$$message{parent}};
1358: }
1359: if (defined($$message{isanonymous}) ) {
1360: if ($$message{isanonymous} eq 'true') {
1361: $contrib{'anonymous'} = 'true';
1362: }
1363: }
1364: if ( defined($$message{attachment}) ) {
1365: my $url = $$message{attachment};
1366: my $oldurl = $url;
1367: my $newurl = $url;
1368: unless ($url eq '') {
1369: $newurl =~ s/\//_/g;
1370: unless ($longcrs eq '') {
1371: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
1372: mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
1373: }
1374: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
1375: system("cp $destdir/resfiles/$res/$$message{attachment} /home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
1376: }
1377: $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$newurl;
1378: }
1379: }
1380: }
1381: if (defined($$message{title}) ) {
1382: $contrib{'message'} = $$message{title};
1383: }
1384: if (defined($$message{text})) {
1385: if ($$message{ishtml} eq "false") {
1386: if ($$message{isnewline} eq "true") {
1387: $$message{text} =~ s#\n#<br/>#g;
1388: }
1389: } else {
1390: $$message{text} = &HTML::Entities::decode($$message{text});
1391: }
1392: $contrib{'message'} .= '<br /><br />'.$$message{text};
1393: my $symb = 'bulletin___'.$timestamp.'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$timestamp.'/bulletinboard';
1394: my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
1395: }
1396: }
1397: }
1398: }
1399: }
1400:
1401: sub addposting {
1402: my ($symb,$contrib,$cdom,$crs)=@_;
1403: my $status='';
1404: if (($symb) && ($$contrib{message})) {
1405: my $crsdom = $cdom.'_'.$crs;
1406: &Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs);
1407: my %storenewentry=($symb => time);
1408: &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
1409: }
1410: my %record=&Apache::lonnet::restore('_discussion');
1411: my ($temp)=keys %record;
1412: unless ($temp=~/^error\:/) {
1413: my %newrecord=();
1414: $newrecord{'resource'}=$symb;
1415: $newrecord{'subnumber'}=$record{'subnumber'}+1;
1416: &Apache::lonnet::cstore(\%newrecord,'_discussion');
1417: $status = 'ok';
1418: } else {
1419: $status.='Failed.';
1420: }
1421: return $status;
1422: }
1423:
1424: sub process_assessment {
1425: my ($res,$docroot,$container,$dirname,$destdir,$settings,$totpageref,$totprobref) = @_;
1426: my $xmlfile = $docroot."/temp/".$res.".dat";
1427: # print "XML file is $xmlfile\n";
1428: my @state = ();
1429: my @allids = ();
1430: my %allanswers = ();
1431: my %allchoices = ();
1432: my $id; # the current question ID
1433: my $answer_id; # the current answer ID
1434: my %toptag = ( pool => 'POOL',
1435: quiz => 'ASSESSMENT',
1436: survey => 'ASSESSMENT'
1437: );
1438: # print "process_assessment is called, incoming: $res,$docroot,$container,$destdir\n";
1439:
1440: my $p = HTML::Parser->new
1441: (
1442: xml_mode => 1,
1443: start_h =>
1444: [sub {
1445: my ($tagname, $attr) = @_;
1446: push @state, $tagname;
1447: my $depth = 0;
1448: my @seq = ();
1449: my $class;
1450: my $state_str = join(" ",@state);
1451: # print "Current state is $state_str\n";
1452: if ($container eq "pool") {
1453: if ("@state" eq "POOL TITLE") {
1454: $$settings{title} = $attr->{value};
1455: # print "Title is $attr->{value}\n";
1456: }
1457: } else {
1458: if ("@state" eq "ASSESSMENT TITLE") {
1459: $$settings{title} = $attr->{value};
1460: } elsif ("@state" eq "ASSESSMENT FLAG" ) {
1461: $$settings{isnewline} = $attr->{value};
1462: } elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") {
1463: $$settings{isavailable} = $attr->{value};
1464: } elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) {
1465: $$settings{isanonymous} = $attr->{id};
1466: } elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) {
1467: $$settings{feedback} = $attr->{id};
1468: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) {
1469: $$settings{showcorrect} = $attr->{id};
1470: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) {
1471: $$settings{showresults} = $attr->{id};
1472: } elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) {
1473: $$settings{allowmultiple} = $attr->{id};
1474: } elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) {
1475: $$settings{type} = $attr->{id};
1476: }
1477: }
1478: if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {
1479: $id = $attr->{id};
1480: unless ($container eq 'pool') {
1481: push @allids, $id;
1482: }
1483: %{$$settings{$id}} = ();
1484: @{$allanswers{$id}} = ();
1485: $$settings{$id}{class} = $attr->{class};
1486: unless ($container eq "pool") {
1487: $$settings{$id}{points} = $attr->{points};
1488: }
1489: @{$$settings{$id}{correctanswer}} = ();
1490: } elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) {
1491: $id = $attr->{id};
1492: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISHTML") ) {
1493: $$settings{$id}{html} = $attr->{value};
1494: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISNEWLINELITERAL") ) {
1495: $$settings{$id}{newline} = $attr->{value};
1496: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) {
1497: $$settings{$id}{image} = $attr->{value};
1498: $$settings{$id}{style} = $attr->{style};
1499: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) {
1500: $$settings{$id}{url} = $attr->{value};
1501: $$settings{$id}{name} = $attr->{name};
1502: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
1503: $answer_id = $attr->{id};
1504: push @{$allanswers{$id}},$answer_id;
1505: %{$$settings{$id}{$answer_id}} = ();
1506: $$settings{$id}{$answer_id}{position} = $attr->{position};
1507: if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
1508: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1509: $$settings{$id}{$answer_id}{type} = 'answer';
1510: }
1511: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
1512: $answer_id = $attr->{id};
1513: push @{$allchoices{$id}},$answer_id;
1514: %{$$settings{$id}{$answer_id}} = ();
1515: $$settings{$id}{$answer_id}{position} = $attr->{position};
1516: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1517: $$settings{$id}{$answer_id}{type} = 'choice';
1518: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "IMAGE") ) {
1519: $$settings{$id}{$answer_id}{image} = $attr->{value};
1520: $$settings{$id}{$answer_id}{style} = $attr->{style};
1521: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "URL") ) {
1522: $$settings{$id}{$answer_id}{url} = $attr->{value};
1523: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "IMAGE") ) {
1524: $$settings{$id}{$answer_id}{image} = $attr->{value};
1525: $$settings{$id}{$answer_id}{style} = $attr->{style};
1526: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "URL") ) {
1527: $$settings{$id}{$answer_id}{url} = $attr->{value};
1528: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) {
1529: my $corr_answer = $attr->{answer_id};
1530: push @{$$settings{$id}{correctanswer}}, $corr_answer;
1531: # print "Answer $corr_answer for question $id is correct\n";
1532: my $type = $1;
1533: if ($type eq 'TRUEFALSE') {
1534: $$settings{$id}{$corr_answer}{answer_position} = $attr->{position};
1535: } elsif ($type eq 'ORDER') {
1536: $$settings{$id}{$corr_answer}{order} = $attr->{order};
1537: } elsif ($type eq 'MATCH') {
1538: $$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id};
1539: }
1540: }
1541: }, "tagname, attr"],
1542: text_h =>
1543: [sub {
1544: my ($text) = @_;
1545: unless ($container eq "pool") {
1546: if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
1547: $$settings{description} = $text;
1548: } elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") {
1549: $$settings{instructions}{text} = $text;
1550: }
1551: }
1552: if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "TEXT") ) {
1553: $$settings{$id}{text} = $text;
1554: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) {
1555: $$settings{$id}{$answer_id}{text} = $text;
1556: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) {
1557: $$settings{$id}{$answer_id}{text} = $text;
1558: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) {
1559: $$settings{$id}{feedback_corr} = $text;
1560: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) {
1561: $$settings{$id}{feedback_incorr} = $text;
1562: }
1563: }, "dtext"],
1564: end_h =>
1565: [sub {
1566: my ($tagname) = @_;
1567: pop @state;
1568: }, "tagname"],
1569: );
1570: $p->unbroken_text(1);
1571: $p->parse_file($xmlfile);
1572: $p->eof;
1573:
1574: my $dirtitle = $$settings{'title'};
1575: $dirtitle =~ s/\W//g;
1576: $dirtitle .= '_'.$res;
1577: if (!-e "$destdir/problems/$dirtitle") {
1578: mkdir("$destdir/problems/$dirtitle",0755);
1579: }
1580: my $newdir = "$destdir/problems/$dirtitle";
1581: my $pagedir = "$destdir/pages";
1582: my $curr_id = 0;
1583: my $next_id = 0;
1584: unless ($container eq 'pool') {
1585: open(PAGEFILE,">$pagedir/$res.page");
1586: print PAGEFILE qq|<map>
1587: |;
1588: $$totpageref ++;
1589: }
1590: foreach my $id (@allids) {
1591: $curr_id ++;
1592: $next_id = $curr_id + 1;
1593: if ($curr_id == 0) {
1594: print PAGEFILE qq|<resource id="1" src="$newdir/$id.problem" type="start"></resource>\n|;
1595: } else {
1596: print PAGEFILE qq|
1597: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
1598: <resource id="$curr_id" src="$newdir/$id.problem"|;
1599: $curr_id ++;
1600: $next_id = $curr_id + 1;
1601: if ($curr_id == @allids) {
1602: print PAGEFILE qq| type="finish"></resource>\n|;
1603: } else {
1604: print PAGEFILE qq|></resource>|;
1605: }
1606: }
1607: # print "Current ID is $id, type is $$settings{$id}{class} \n";
1608: if (@allids == 1) {
1609: print PAGEFILE qq|<link from="1" to="2" index="1"></link>
1610: <resource id="2" src="" type="finish">\n|;
1611: }
1612:
1613: my $output = qq|<problem>
1614: |;
1615: $$totprobref ++;
1616: if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
1617: $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
1618: <essayresponse>
1619: <textfield></textfield>
1620: </essayresponse>
1621: <postanswerdate>
1622: $$settings{$id}{feedbackcorr}
1623: </postanswerdate>
1624: |;
1625: } else {
1626: $output .= qq|<startouttext />$$settings{$id}{text}\n|;
1627: if ( defined($$settings{$id}{image}) ) {
1628: if ( $$settings{$id}{style} eq 'embed' ) {
1629: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{image}" /><br />|;
1630: } else {
1631: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
1632: }
1633: }
1634: if ( defined($$settings{$id}{url}) ) {
1635: $output .= qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
1636: }
1637: $output .= qq|
1638: <endouttext />|;
1639: if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
1640: my $numfoils = @{$allanswers{$id}};
1641: $output .= qq|
1642: <radiobuttonresponse max="$numfoils" randomize="yes">
1643: <foilgroup>
1644: |;
1645: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1646: $output .= " <foil name=\"foil".$k."\" value=\"";
1647: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1648: $output .= "true\" location=\"";
1649: } else {
1650: $output .= "false\" location=\"";
1651: }
1652: if (lc ($allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
1653: $output .= "bottom\"";
1654: } else {
1655: $output .= "random\"";
1656: }
1657: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};
1658: if ( defined($$settings{$id}{$allanswers{$id}[$k]}{image}) ) {
1659: if ( $$settings{$id}{$allanswers{$id}[$k]}{style} eq 'embed' ) {
1660: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" /><br />|;
1661: } else {
1662: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
1663: }
1664: }
1665: $output .= qq|<endouttext /></foil>\n|;
1666: }
1667: chomp($output);
1668: $output .= qq|
1669: </foilgroup>
1670: </radiobuttonresponse>
1671: |;
1672: } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
1673: my $numfoils = @{$allanswers{$id}};
1674: # print "Number of foils is $numfoils\n";
1675: $output .= qq|
1676: <radiobuttonresponse max="$numfoils" randomize="yes">
1677: <foilgroup>
1678: |;
1679: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1680: $output .= " <foil name=\"foil".$k."\" value=\"";
1681: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1682: $output .= "true\" location=\"random\"";
1683: } else {
1684: $output .= "false\" location=\"random\"";
1685: }
1686: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1687: }
1688: chomp($output);
1689: $output .= qq|
1690: </foilgroup>
1691: </radiobuttonresponse>
1692: |;
1693: } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
1694: my $numfoils = @{$allanswers{$id}};
1695: # print "Number of foils is $numfoils\n";
1696: $output .= qq|
1697: <optionresponse max="$numfoils" randomize="yes">
1698: <foilgroup options="('True','False')">
1699: |;
1700: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1701: $output .= " <foil name=\"foil".$k."\" value=\"";
1702: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1703: $output .= "True\"";
1704: } else {
1705: $output .= "False\"";
1706: }
1707: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1708: }
1709: chomp($output);
1710: $output .= qq|
1711: </foilgroup>
1712: </optionresponse>
1713: |;
1714: } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
1715: my $numfoils = @{$allanswers{$id}};
1716: $output .= qq|
1717: <rankresponse max="$numfoils" randomize="yes">
1718: <foilgroup>
1719: |;
1720: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1721: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1722: }
1723: chomp($output);
1724: $output .= qq|
1725: </foilgroup>
1726: </rankresponse>
1727: |;
1728: } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
1729: my $numerical = 1;
1730: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1731: if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
1732: $numerical = 0;
1733: }
1734: }
1735: if ($numerical) {
1736: my $numans;
1737: my $tol;
1738: if (@{$allanswers{$id}} == 1) {
1739: $tol = 5;
1740: $numans = $$settings{$id}{$allanswers{$id}[0]}{text};
1741: } else {
1742: my $min = $$settings{$id}{$allanswers{$id}[0]}{text};
1743: my $max = $$settings{$id}{$allanswers{$id}[0]}{text};
1744: for (my $k=1; $k<@{$allanswers{$id}}; $k++) {
1745: if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {
1746: $min = $$settings{$id}{$allanswers{$id}[$k]}{text};
1747: }
1748: if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {
1749: $max = $$settings{$id}{$allanswers{$id}[$k]}{text};
1750: }
1751: }
1752: $numans = ($max + $min)/2;
1753: $tol = 100*($max - $min)/($numans*2);
1754: }
1755: $output .= qq|
1756: <numericalresponse answer="$numans">
1757: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
1758: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
1759: />
1760: <textline />
1761: </numericalresponse>
1762: |;
1763: } else {
1764: if (@{$allanswers{$id}} == 1) {
1765: $output .= qq|
1766: <stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">
1767: <textline>
1768: </textline>
1769: </stringresponse>
1770: |;
1771: } else {
1772: my @answertext = ();
1773: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1774: $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
1775: push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};
1776: }
1777: my $regexpans = join('|',@answertext);
1778: $regexpans = '/^('.$regexpans.')\b/';
1779: $output .= qq|
1780: <stringresponse answer="$regexpans" type="re">
1781: <textline>
1782: </textline>
1783: </stringresponse>
1784: |;
1785: }
1786: }
1787: } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
1788: $output .= qq|
1789: <matchresponse max="10" randomize="yes">
1790: <foilgroup>
1791: <itemgroup>
1792: |;
1793: for (my $k=0; $k<@{$allchoices{$id}}; $k++) {
1794: $output .= qq|
1795: <item name="$allchoices{$id}[$k]">
1796: <startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />
1797: </item>
1798: |;
1799: }
1800: $output .= qq|
1801: </itemgroup>
1802: |;
1803: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1804: $output .= qq|
1805: <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">
1806: <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />
1807: </foil>
1808: |;
1809: }
1810: $output .= qq|
1811: </foilgroup>
1812: </matchresponse>
1813: |;
1814: }
1815: }
1816: $output .= qq|</problem>
1817: |;
1818: open(PROB,">$newdir/$id.problem");
1819: print PROB $output;
1820: close PROB;
1821: }
1822: unless ($container eq 'pool') {
1823: print PAGEFILE qq|</map>|;
1824: close(PAGEFILE);
1825: }
1826: }
1827:
1828:
1829: sub create_ess {
1830: my ($newdir,$qnid,$qsettings,$container) = @_;
1831: my $output;
1832: if ($container eq 'pool') {
1833: $output = qq|<problem>
1834: <startouttext />$$qsettings{text}<endouttext />
1835: |;
1836: } else {
1837: $output = qq|<problem>
1838: <startouttext />$$qsettings{text}<endouttext />
1839: |;
1840: }
1841: $output .= qq|
1842: <essayresponse>
1843: <textfield></textfield>
1844: </essayresponse>
1845: <postanswerdate>
1846: $$qsettings{feedbackcorr}
1847: </postanswerdate>
1848: |;
1849: if ($container eq 'pool') {
1850: $output .= qq|</problem>
1851: |;
1852: open(PROB,">$newdir/$qnid.problem");
1853: print PROB $output;
1854: close PROB;
1855: } else {
1856: $output .= qq|</problem>
1857: |;
1858: open(PROB,">$newdir/$qnid.problem");
1859: print PROB $output;
1860: close PROB;
1861: }
1862: return;
1863: }
1864:
1865: sub process_announce {
1866: my ($res,$docroot,$destdir,$settings) = @_;
1867: my $xmlfile = $docroot."/temp/".$res.".dat";
1868: my @state = ();
1869: my @assess = ();
1870: my $id;
1871: my $p = HTML::Parser->new
1872: (
1873: xml_mode => 1,
1874: start_h =>
1875: [sub {
1876: my ($tagname, $attr) = @_;
1877: push @state, $tagname;
1878: if ("@state" eq "ANNOUNCEMENT TITLE") {
1879: $$settings{title} = $attr->{value};
1880: $$settings{startassessment} = ();
1881: # print "Title is $$settings{title}\n";
1882: } elsif (@state eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {
1883: $$settings{ishtml} = $attr->{value};
1884: } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
1885: $$settings{isnewline} = $attr->{value};
1886: } elsif ("@state" eq "CONTENT ISPERMANENT" ) {
1887: $$settings{ispermanent} = $attr->{value};
1888: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) {
1889: $id = $attr->{id};
1890: %{$$settings{startassessment}{$id}} = ();
1891: push @assess,$id;
1892: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) {
1893: my $key = $attr->{key};
1894: $$settings{startassessment}{$id}{$key} = $attr->{value};
1895: }
1896: }, "tagname, attr"],
1897: text_h =>
1898: [sub {
1899: my ($text) = @_;
1900: if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") {
1901: $$settings{text} = $text;
1902: # print "TEXT $text\n";
1903: }
1904: }, "dtext"],
1905: end_h =>
1906: [sub {
1907: my ($tagname) = @_;
1908: pop @state;
1909: }, "tagname"],
1910: );
1911: $p->unbroken_text(1);
1912: $p->parse_file($xmlfile);
1913: $p->eof;
1914:
1915: if (defined($$settings{text})) {
1916: if ($$settings{ishtml} eq "false") {
1917: if ($$settings{isnewline} eq "true") {
1918: $$settings{text} =~ s#\n#<br/>#g;
1919: }
1920: } else {
1921: $$settings{text} = &HTML::Entities::decode($$settings{text});
1922: }
1923: }
1924:
1925: if (@assess > 0) {
1926: foreach my $id (@assess) {
1927: $$settings{text} .= "Please use 'NAV' to locate the link to the folder of problems entitled -";
1928: foreach my $key (keys %{$$settings{startassessment}{$id}}) {
1929: # print STDERR "Quiz announcement - $id, key: $key, value: $$settings{startassessment}{$id}{$key}\n";
1930: }
1931: }
1932: }
1933:
1934: open(FILE,">$destdir/resfiles/$res.html");
1935: print FILE qq|<html>
1936: <head>
1937: <title>$$settings{title}</title>
1938: </head>
1939: <body bgcolor='#ffffff'>
1940: $$settings{text}
1941: |;
1942: print FILE qq|
1943: </body>
1944: </html>|;
1945: close(FILE);
1946: }
1947:
1948: sub process_content {
1949: my ($res,$docroot,$destdir,$settings,$dom,$user) = @_;
1950: my $xmlfile = $docroot."/temp/".$res.".dat";
1951: my $destresdir = $destdir;
1952: $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
1953: my $filecount = 0;
1954: my @state;
1955: @{$$settings{files}} = ();
1956: my $p = HTML::Parser->new
1957: (
1958: xml_mode => 1,
1959: start_h =>
1960: [sub {
1961: my ($tagname, $attr) = @_;
1962: push @state, $tagname;
1963: if (@state eq "CONTENT MAINDATA") {
1964: %{$$settings{maindata}} = ();
1965: } elsif (@state eq "CONTENT MAINDATA TEXTCOLOR") {
1966: $$settings{maindata}{color} = $attr->{value};
1967: } elsif (@state eq "CONTENT MAINDATA FLAGS ISHTML") {
1968: $$settings{maindata}{ishtml} = $attr->{value};
1969: } elsif (@state eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {
1970: $$settings{maindata}{isnewline} = $attr->{value};
1971: } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
1972: $$settings{isavailable} = $attr->{value};
1973: } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
1974: $$settings{isfolder} = $attr->{value};
1975: } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
1976: $$settings{newwindow} = $attr->{value};
1977: } elsif ("@state" eq "CONTENT FILES") {
1978: # @{$$settings{files}} = ();
1979: } elsif ("@state" eq "CONTENT FILES FILEREF") {
1980: %{$$settings{files}[$filecount]} = ();
1981: %{$$settings{files}[$filecount]{registry}} = ();
1982: } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
1983: $$settings{files}[$filecount]{'relfile'} = $attr->{value};
1984: } elsif ("@state" eq "CONTENT FILES FILEREF MIMETYPE") {
1985: $$settings{files}[$filecount]{mimetype} = $attr->{value};
1986: } elsif ("@state" eq "CONTENT FILES FILEREF CONTENTTYPE") {
1987: $$settings{files}[$filecount]{contenttype} = $attr->{value};
1988: } elsif ("@state" eq "CONTENT FILES FILEREF FILEACTION") {
1989: $$settings{files}[$filecount]{fileaction} = $attr->{value};
1990: } elsif ("@state" eq "CONTENT FILES FILEREF PACKAGEPARENT") {
1991: $$settings{files}[$filecount]{packageparent} = $attr->{value};
1992: } elsif ("@state" eq "CONTENT FILES FILEREF LINKNAME") {
1993: $$settings{files}[$filecount]{linkname} = $attr->{value};
1994: } elsif ("@state" eq "CONTENT FILES FILEREF REGISTRY REGISTRYENTRY") {
1995: my $key = $attr->{key};
1996: $$settings{files}[$filecount]{registry}{$key} = $attr->{value};
1997: }
1998: }, "tagname, attr"],
1999: text_h =>
2000: [sub {
2001: my ($text) = @_;
2002: if ("@state" eq "CONTENT TITLE") {
2003: $$settings{title} = $text;
2004: } elsif ("@state" eq "CONTENT MAINDATA TEXT") {
2005: $$settings{maindata}{text} = $text;
2006: } elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") {
2007: $$settings{files}[$filecount]{reftext} = $text;
2008: }
2009: }, "dtext"],
2010: end_h =>
2011: [sub {
2012: my ($tagname) = @_;
2013: if ("@state" eq "CONTENT FILES FILEREF") {
2014: $filecount ++;
2015: }
2016: pop @state;
2017: }, "tagname"],
2018: );
2019: $p->unbroken_text(1);
2020: $p->parse_file($xmlfile);
2021: $p->eof;
2022: my $linktag = '';
2023: my $fontcol = '';
2024: if (@{$$settings{files}} > 0) {
2025: for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) {
2026: if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') {
2027: if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) {
2028: my $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"/>|;
2029: $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#;
2030: } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) {
2031: my $reftag = $1;
2032: my $newtag;
2033: if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) {
2034: $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
2035: if ( defined($$settings{files}[$filecount]{registry}{alttext}) ) {
2036: $newtag .= qq| alt="$$settings{files}[$filecount]{registry}{alttext}"|;
2037: }
2038: if ( defined($$settings{files}[$filecount]{registry}{alignment}) )
2039: {
2040: $newtag .= qq| align="$$settings{files}[$filecount]{registry}{alignment}"|;
2041: }
2042: if ( defined($$settings{files}[$filecount]{registry}{border}) ) {
2043: $newtag .= qq| border="$$settings{files}[$filecount]{registry}{border}"|;
2044: }
2045: $newtag .= " />";
2046: my $reftext = $$settings{files}[$filecount]{reftext};
2047: my $fname = $$settings{files}[$filecount]{'relfile'};
2048: $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
2049: # $$settings{maindata}{text} =~ s/DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
2050: $$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//;
2051: $$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/;
2052: $$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//;
2053: $$settings{maindata}{text} =~ s/\-\->//;
2054: # $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n\]+_\/$reftag\\_[\s\n]+END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n\]+\-\->/$newtag/;
2055: # print STDERR $$settings{maindata}{text};
2056: }
2057: } else {
2058: my $filename=$$settings{files}[$filecount]{'relfile'};
2059: # print "File is $filename\n";
2060: my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
2061: # print "New filename is $newfilename\n";
2062: $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g;
2063: }
2064: } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
2065: $linktag = qq|<a href="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
2066: if ($$settings{newwindow} eq "true") {
2067: $linktag .= qq| target="$res$filecount"|;
2068: }
2069: foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {
2070: $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
2071: }
2072: $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a>|;
2073: } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') {
2074: # print "Found a package\n";
2075: }
2076: }
2077: }
2078: if (defined($$settings{maindata}{textcolor})) {
2079: $fontcol = qq|<font color="$$settings{maindata}{textcolor}">|;
2080: }
2081: if (defined($$settings{maindata}{text})) {
2082: if ($$settings{maindata}{ishtml} eq "false") {
2083: if ($$settings{maindata}{isnewline} eq "true") {
2084: $$settings{maindata}{text} =~ s#\n#<br/>#g;
2085: }
2086: } else {
2087: $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
2088: }
2089: }
2090:
2091: open(FILE,">$destdir/resfiles/$res.html");
2092: print FILE qq|<html>
2093: <head>
2094: <title>$$settings{title}</title>
2095: </head>
2096: <body bgcolor='#ffffff'>
2097: $fontcol
2098: |;
2099: unless ($$settings{title} eq '') {
2100: print FILE qq|$$settings{title}<br/><br/>\n|;
2101: }
2102: print FILE qq|
2103: $$settings{maindata}{text}
2104: $linktag|;
2105: if (defined($$settings{maindata}{textcolor})) {
2106: print FILE qq|</font>|;
2107: }
2108: print FILE qq|
2109: </body>
2110: </html>|;
2111: close(FILE);
2112: }
2113:
2114: sub expand_angel {
2115: my ($r,$uname,$udom,$fn,$page) = @_;
2116: my @state = ();
2117: my @seq = "Top";
2118: my $lastitem;
2119: my $itm = '';
2120: my %resnum = ();
2121: my %title = ();
2122: my %filepath = ();
2123: my %contentscount = ("Top" => 0);
2124: my %contents = ();
2125: my %parentseq = ();
2126: my %file = ();
2127: my %type = ();
2128: my %href = ();
2129: my $identifier = '';
2130: my %resinfo = ();
2131: my $numfolders = 0;
2132: my $numpages = 0;
2133: my $docroot = $ENV{'form.newdir'};
2134: if (!-e "$docroot/temp") {
2135: mkdir "$docroot/temp";
2136: }
2137: my $newdir = '';
2138: if ($docroot =~ m|public_html/(.+)$|) {
2139: $newdir = $1;
2140: }
2141: my $dirname = "/res/$udom/$uname/$newdir";
2142: my $zipfile = '/home/'.$uname.'/public_html'.$fn;
2143: if ($fn =~ m|\.zip$|i) {
2144: open(OUTPUT, "unzip -o $zipfile -d $docroot/temp 2> /dev/null |");
2145: while (<OUTPUT>) {
2146: print "$_<br />";
2147: }
2148: close(OUTPUT);
2149: }
2150:
2151: my $xmlfile = $docroot.'/temp/imsmanifest.xml';
2152: my $p = HTML::Parser->new
2153: (
2154: xml_mode => 1,
2155: start_h =>
2156: [sub {
2157: my ($tagname, $attr) = @_;
2158: push @state, $tagname;
2159: my $num = @state - 3;
2160: my $start = $num;
2161: my $statestr = '';
2162: foreach (@state) {
2163: $statestr .= "$_ ";
2164: }
2165: if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "organization") ) {
2166: my $searchstr = "manifest organizations organization";
2167: while ($num > 0) {
2168: $searchstr .= " item";
2169: $num --;
2170: }
2171: if (("@state" eq $searchstr) && (@state > 3)) {
2172: $itm = $attr->{identifier};
2173: $resnum{$itm} = $attr->{identifierref};
2174: if ($start > @seq) {
2175: unless ($lastitem eq '') {
2176: push @seq, $lastitem;
2177: unless ( defined($contents{$seq[-1]}) ) {
2178: @{$contents{$seq[-1]}} = ();
2179: }
2180: push @{$contents{$seq[-1]}},$itm;
2181: $parentseq{$itm} = $seq[-1];
2182: }
2183: }
2184: elsif ($start < @seq) {
2185: my $diff = @seq - $start;
2186: while ($diff > 0) {
2187: pop @seq;
2188: $diff --;
2189: }
2190: if (@seq) {
2191: push @{$contents{$seq[-1]}}, $itm;
2192: }
2193: } else {
2194: push @{$contents{$seq[-1]}}, $itm;
2195: }
2196: my $path;
2197: if (@seq > 1) {
2198: $path = join(',',@seq);
2199: } elsif (@seq > 0) {
2200: $path = $seq[0];
2201: }
2202: $filepath{$itm} = $path;
2203: $contentscount{$seq[-1]} ++;
2204: $lastitem = $itm;
2205: }
2206: } elsif ("@state" eq "manifest resources resource" ) {
2207: $identifier = $attr->{identifier};
2208: $file{$identifier} = $attr->{href};
2209: @{$href{$identifier}} = ();
2210: } elsif ("@state" eq "manifest resources resource file") {
2211: push @{$href{$identifier}},$attr->{href};
2212: if ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
2213: $type{$identifier} = $1;
2214: }
2215: }
2216: }, "tagname, attr"],
2217: text_h =>
2218: [sub {
2219: my ($text) = @_;
2220: if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq "organization" && $state[-1] eq "title") {
2221: $title{$itm} = $text;
2222: }
2223: }, "dtext"],
2224: end_h =>
2225: [sub {
2226: my ($tagname) = @_;
2227: pop @state;
2228: }, "tagname"],
2229: );
2230: $p->parse_file($xmlfile);
2231: $p->eof;
2232:
2233: my $topnum = 0;
2234: my $destdir = $docroot;
2235: if (!-e "$destdir") {
2236: mkdir("$destdir",0755);
2237: }
2238: if (!-e "$destdir/sequences") {
2239: mkdir("$destdir/sequences",0755);
2240: }
2241: if (!-e "$destdir/resfiles") {
2242: mkdir("$destdir/resfiles",0755);
2243: }
2244: if (!-e "$destdir/pages") {
2245: mkdir("$destdir/pages",0755);
2246: }
2247: if (!-e "$destdir/problems") {
2248: mkdir("$destdir/problems",0755);
2249: }
2250: foreach my $key (sort keys %href) {
2251: foreach my $file (@{$href{$key}}) {
2252: if ($file =~ m/^_assoc/) {
2253: my $filepath = $file;
2254: if (!-e "$destdir/resfiles/$key") {
2255: mkdir("$destdir/resfiles/$key",0755);
2256: }
2257: while ($filepath =~ m-(\w+)\\(.+)-) {
2258: $filepath = $2;
2259: if (!-e "$destdir/resfiles/$key/$1") {
2260: mkdir("$destdir/resfiles/$key/$1",0755);
2261: }
2262: }
2263: system("cp $docroot/temp/$key/$file $destdir/resfiles/$key/$file");
2264: }
2265: }
2266: }
2267:
2268: # ANGEL types FILE FOLDER PAGE MESSAGE FORM QUIZ BOARD
2269:
2270: foreach my $key (sort keys %type) {
2271: if ($type{$key} eq "BOARD") {
2272: %{$resinfo{$key}} = ();
2273: &angel_db($key,$docroot,$destdir,\%{$resinfo{$key}},$udom,$uname);
2274: } elsif ($type{$key} eq "FILE" || $type{$key} eq "FOLDER" || $type{$key} eq "PAGE") {
2275: %{$resinfo{$key}} = ();
2276: &angel_content($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
2277: } elsif ($type{$key} eq "QUIZ") {
2278: %{$resinfo{$key}} = ();
2279: &angel_assessment($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
2280: } elsif ($type{$key} eq "FORM") {
2281: %{$resinfo{$key}} = ();
2282: &angel_assessment($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
2283: }
2284: }
2285:
2286: my $nextnum = 0;
2287: open(TOPFILE,">$destdir/sequences/ims_import.sequence");
2288: print TOPFILE "<map>\n";
2289: my $fileopen = 0;
2290: my $areakey;
2291: my $areacount = 0;
2292: my $lastentry = '';
2293: my $notlastentry = '';
2294: my %pagecount = ();
2295: my %pagecontents = ();
2296: my %pageflag = ();
2297: my %seqflag = ();
2298: my %seqcount = ();
2299:
2300: foreach my $key (sort keys %resnum) {
2301: $pageflag{$key} = 0;
2302: $seqflag{$key} = 0;
2303: $seqcount{$key} = 0;
2304: $pagecount{$key} = -1;
2305: if ($filepath{$key} eq 'Top') {
2306: $topnum ++;
2307: $nextnum = $topnum +1;
2308: print TOPFILE qq|<resource id="$topnum" src="/res/$udom/$uname/$newdir/sequences/$key.sequence" title="$title{$key}"|;
2309: if ($topnum == 1) {
2310: print TOPFILE qq| type="start"></resource>
2311: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
2312: if ($topnum == $contentscount{'Top'}) {
2313: print TOPFILE qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
2314: }
2315: } else {
2316: if ($topnum == $contentscount{'Top'}) {
2317: print TOPFILE qq| type="finish"></resource>\n|;
2318: } else {
2319: print TOPFILE qq|></resource>
2320: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
2321: }
2322: }
2323:
2324: my $src ="";
2325: my $next_id = 1;
2326: my $curr_id = 0;
2327: if ($type{$resnum{$key}} eq "FOLDER") {
2328: open(LOCFILE,">$destdir/sequences/$key.sequence");
2329: print LOCFILE "<map>\n";
2330: if ($contentscount{$key} == 0) {
2331: print LOCFILE qq|<resource id="1" src="" type="start"></resource>
2332: <link from="1" to="2" index="1"></link>
2333: <resource id="2" src="" type="finish"></resource>\n|;
2334: } else {
2335: if ($type{$resnum{$contents{$key}[0]}} eq "FOLDER") {
2336: $src = 'sequences/'.$contents{$key}[0].".sequence";
2337: $pageflag{$key} = 0;
2338: $seqflag{$key} = 1;
2339: $seqcount{$key} ++;
2340: } else {
2341: if ($pageflag{$key}) {
2342: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[0]; } else {
2343: $pagecount{$key} ++;
2344: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
2345: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[0]");
2346: $seqflag{$key} = 0;
2347: }
2348: }
2349: unless ($pageflag{$key}) {
2350: print LOCFILE qq|<resource id="1" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[0]}" type="start"|;
2351: unless ($seqflag{$key}) {
2352: $pageflag{$key} = 1;
2353: }
2354: }
2355: if ($contentscount{$key} == 1) {
2356: print LOCFILE qq|></resource>
2357: <link from="1" to="2" index="1"></link>
2358: <resource id="2" src="" type="finish"></resource>\n|;
2359: } else {
2360: if ($contentscount{$key} > 2 ) {
2361: for (my $i=1; $i<$contentscount{$key}-1; $i++) {
2362: if ($resinfo{$resnum{$contents{$key}[$i]}}{'isfolder'} eq "true") {
2363: $src = 'sequences/'.$contents{$key}[$i].".sequence";
2364: $pageflag{$key} = 0;
2365: $seqflag{$key} = 1;
2366: $seqcount{$key} ++;
2367: } else {
2368: if ($pageflag{$key}) {
2369: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$i];
2370: } else {
2371: $pagecount{$key} ++;
2372: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
2373: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$i]");
2374: $seqflag{$key} = 0;
2375: }
2376: }
2377: unless ($pageflag{$key}) {
2378: $curr_id ++;
2379: $next_id ++;
2380: print LOCFILE qq|></resource>
2381: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
2382: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$i]}"|;
2383: unless ($seqflag{$key}) {
2384: $pageflag{$key} = 1;
2385: }
2386: }
2387: }
2388: }
2389: if ($resinfo{$resnum{$contents{$key}[$contentscount{$key}-1]}}{'isfolder'} eq "true") {
2390: $src = 'sequences/'.$contents{$key}[$contentscount{$key}-1].".sequence";
2391: $pageflag{$key} = 0;
2392: $seqflag{$key} = 1;
2393: } else {
2394: if ($pageflag{$key}) {
2395: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$contentscount{$key}-1];
2396: } else {
2397: $pagecount{$key} ++;
2398: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
2399: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$contentscount{$key}-1]");
2400: }
2401: }
2402: if ($pageflag{$key}) {
2403: if ($seqcount{$key} + $pagecount{$key} +1 == 1) {
2404: print LOCFILE qq|></resource>
2405: <link from="1" index="1" to="2">
2406: <resource id ="2" src="" title="" type="finish"></resource>\n|;
2407: } else {
2408: print LOCFILE qq| type="finish"></resource>\n|;
2409: }
2410: } else {
2411: $curr_id ++;
2412: $next_id ++;
2413: print LOCFILE qq|></resource>
2414: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
2415: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$contentscount{$key}-1]}" type="finish"></resource>\n|;
2416: }
2417: }
2418: }
2419: print LOCFILE "</map>\n";
2420: close(LOCFILE);
2421: }
2422: }
2423:
2424: foreach my $key (sort keys %pagecontents) {
2425: for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
2426: my $filestem = "/res/$udom/$uname/$newdir";
2427: my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
2428: open(PAGEFILE,">$filename");
2429: print PAGEFILE qq|<map>
2430: <resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][0]}.html" id="1" type="start" title="$title{$pagecontents{$key}[$i][0]}"></resource>
2431: <link to="2" index="1" from="1">\n|;
2432: if (@{$pagecontents{$key}[$i]} == 1) {
2433: print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>|;
2434: } elsif (@{$pagecontents{$key}[$i]} == 2) {
2435: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][1]}.html" id="2" type="finish" title="$title{$pagecontents{$key}[$i][1]}"></resource>|;
2436: } else {
2437: for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
2438: my $curr_id = $j+1;
2439: my $next_id = $j+2;
2440: my $resource = $filestem.'/resfiles/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html';
2441: print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$title{$pagecontents{$key}[$i][$j]}"></resource>
2442: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
2443: }
2444: my $final_id = @{$pagecontents{$key}[$i]};
2445: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][-1]}.html" id="$final_id" type="finish" title="$title{$pagecontents{$key}[$i][-1]}"></resource>\n|;
2446: }
2447: print PAGEFILE "</map>";
2448: close(PAGEFILE);
2449: }
2450: }
2451: system(" rm -r $docroot/temp");
2452: }
2453:
2454: sub get_ccroles {
2455: my ($uname,$dom,$crsentry) = @_;
2456: my %roles = ();
2457: unless ($uname eq '') {
2458: %roles = &Apache::lonnet::dump('roles',$dom,$uname);
2459: }
2460: my $iter = 0;
2461: my @codes = ();
2462: my %courses = ();
2463: my @crslist = ();
2464: my %descrip =();
2465: foreach my $key (keys %roles ) {
2466: if ($key =~ m/^\/(\w+)\/(\w+)_cc$/) {
2467: my $cdom = $1;
2468: my $crs = $2;
2469: my $role_end = 0;
2470: my $role_start = 0;
2471: my $active_chk = 1;
2472: if ( $roles{$key} =~ m/^cc_(\d+)/ ) {
2473: $role_end = $1;
2474: if ( $roles{$key} =~ m/^cc_($role_end)_(\d+)$/ )
2475: {
2476: $role_start = $2;
2477: }
2478: }
2479: if ($role_start > 0) {
2480: if (time < $role_start) {
2481: $active_chk = 0;
2482: }
2483: }
2484: if ($role_end > 0) {
2485: if (time > $role_end) {
2486: $active_chk = 0;
2487: }
2488: }
2489: if ($active_chk) {
2490: my $currcode = '';
2491: my %settings = &Apache::lonnet::get('environment',['internal.coursecode','description'],$cdom,$crs);
2492: if (defined($settings{'description'}) ) {
2493: $descrip{$crs} = $settings{'description'};
2494: } else {
2495: $descrip{$crs} = 'Unknown';
2496: }
2497: if (defined($settings{'internal.coursecode'}) ) {
2498: $currcode = $settings{'internal.coursecode'};
2499: if ($currcode eq '') {
2500: $currcode = "____".$iter;
2501: $iter ++;
2502: }
2503: } else {
2504: $currcode = "____".$iter;
2505: $iter ++;
2506: }
2507: unless (grep/^$currcode$/,@codes) {
2508: push @codes,$currcode;
2509: @{$courses{$currcode}} = ();
2510: }
2511: push @{$courses{$currcode}}, $cdom.'/'.$crs;
2512: }
2513: }
2514: }
2515: foreach my $code (sort @codes) {
2516: foreach my $crsdom (@{$courses{$code}}) {
2517: my ($cdom,$crs) = split/\//,$crsdom;
2518: my $showcode = '';
2519: unless ($code =~m/^____\d+$/) { $showcode = $code; }
2520: $$crsentry{$crsdom} = $showcode.':'.$descrip{$crs};
2521: push @crslist, $crsdom;
2522: }
2523: }
2524: return @crslist;
2525: }
2526:
2527: # ---------------------------------------------------------------- Main Handler
2528: sub handler {
2529: my $r=shift;
2530: my $uname;
2531: my $udom;
2532: my $javascript = '';
2533: my $page_name = '';
2534: my $current_page = '';
2535: my $loadentries = '';
2536: my $qcount = '';
2537: #
2538: # phase two: re-attach user
2539: #
2540: if ($ENV{'form.uploaduname'}) {
2541: $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
2542: $ENV{'form.filename'};
2543: }
2544: ($uname,$udom)=
2545: &Apache::loncacc::constructaccess($ENV{'form.filename'},
2546: $r->dir_config('lonDefDomain'));
2547: unless (($uname) && ($udom)) {
2548: $r->log_reason($uname.' at '.$udom.
2549: ' trying to publish file '.$ENV{'form.filename'}.
2550: ' - not authorized',
2551: $r->filename);
2552: return HTTP_NOT_ACCEPTABLE;
2553: }
2554:
2555: my $fn;
2556: if ($ENV{'form.filename'}) {
2557: $fn=$ENV{'form.filename'};
2558: $fn=~s/^http\:\/\/[^\/]+\///;
2559: $fn=~s/^\///;
2560: $fn=~s/(\~|priv\/)(\w+)//;
2561: $fn=~s/\/+/\//g;
2562: } else {
2563: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
2564: ' unspecified filename for upload', $r->filename);
2565: return HTTP_NOT_FOUND;
2566: }
2567: my $pathname = &File::Basename::dirname($fn);
2568: my $fullpath = '/priv/'.$uname.$pathname;
2569: unless ($pathname eq '/') {
2570: $fullpath .= '/';
2571: }
2572: my $loadentries = '';
2573: # ----------------------------------------------------------- Start page output
2574: &Apache::loncommon::content_type($r,'text/html');
2575: $r->send_http_header;
2576:
2577: if ($ENV{'form.phase'} eq 'three') {
2578: $current_page = &display_control();
2579: my @PAGES = ('ChooseDir','Blackboard5','ANGEL','WebCT');
2580: $page_name = $PAGES[$current_page];
2581:
2582: if ($page_name eq 'ChooseDir') {
2583: &jscript_zero($fullpath,\$javascript,$uname,$udom);
2584: } elsif ($page_name eq 'Confirmation') {
2585: &jscript_two(\$javascript,$uname);
2586: }
2587: } elsif ($ENV{'form.phase'} eq 'two') {
2588: &jscript_zero($fullpath,\$javascript,$uname,$udom);
2589: }
2590: $r->print("<html><head><title>LON-CAPA Construction Space</title><script type=\"text/javascript\">\n//<!--\n$javascript\n// --></script>\n</head>");
2591:
2592: $r->print(&Apache::loncommon::bodytag('Upload IMS package to Construction Space',undef,$loadentries));
2593:
2594: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
2595: $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
2596: &mt(' at ').$udom.'</font></h3>');
2597: }
2598:
2599: if ($ENV{'form.phase'} eq 'three') {
2600: my $bb_crs = '';
2601: my $bb_cdom = '';
2602: my $bb_handling = '';
2603: if ( defined($ENV{'form.bb_crs'}) ) {
2604: ($bb_cdom,$bb_crs) = split/\//,$ENV{'form.bb_crs'};
2605: }
2606: if ( defined($ENV{'form.bb_handling'}) ) {
2607: $bb_handling = $ENV{'form.bb_handling'};
2608: }
2609: my $users_crs = '';
2610: my $users_cdom = '';
2611: my $users_handling = '';
2612: if ( defined($ENV{'form.user_crs'}) ) {
2613: ($users_cdom,$users_crs) = split/\//,$ENV{'form.user_crs'};
2614: }
2615: if ( defined($ENV{'form.user_handling'}) ) {
2616: $users_handling = $ENV{'form.user_handling'};
2617: }
2618: my ($totseq,$totpage,$totprob);
2619: &display_zero ($r,$uname,$fn,$current_page,$fullpath) if $page_name eq 'ChooseDir';
2620: ($totseq,$totpage,$totprob) = &expand_bb5 ($r,$uname,$udom,$fn,$current_page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling) if $page_name eq 'Blackboard5';
2621: ($totseq,$totpage,$totprob) = &expand_angel ($r,$uname,$udom,$fn,$current_page) if $page_name eq 'ANGEL';
2622: &expand_webct ($r,$uname,$udom,$fn,$current_page) if $page_name eq 'WebCT';
2623: $r->print("<h3>Step 3: Publish your new LON-CAPA materials</h3>");
2624: $r->print("<font face='arial,helvetica,sans-serif'>Your IMS package has been processed successfully. A total of $totseq sequences, $totpage pages, and $totprob problems have been created.<br /><br />\n");
2625:
2626: } elsif ($ENV{'form.phase'} eq 'two') {
2627: my $flag = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'imsimport');
2628: if ($flag eq 'ok') {
2629: my $current_page = 0;
2630: &display_zero($r,$uname,$fn,$current_page,$fullpath);
2631: }
2632: } else {
2633: &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'imsimport');
2634: }
2635: $r->print('</body></html>');
2636: return OK;
2637: }
2638: 1;
2639: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to imsimport.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / imspackages