Annotation of loncom/imspackages/imsimport.pm, revision 1.3
1.1 raeburn 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 {
1.2 raeburn 35: my ($fullpath,$jsref,$uname,$dom) = @_;
1.1 raeburn 36: my $source = '';
37: if (exists($ENV{'form.go'}) ) {
38: $source = $ENV{'form.go'};
39: }
1.2 raeburn 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:
1.1 raeburn 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
1.2 raeburn 66: }
1.1 raeburn 67: return true
68: }
1.2 raeburn 69:
1.1 raeburn 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: }
1.2 raeburn 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:
1.1 raeburn 131: END_OF_ONE
132:
133: }
134:
135: # ---------------------------------------------------------------- Display Zero
136: sub display_zero {
1.2 raeburn 137: my ($r,$uname,$fn,$page,$fullpath) = @_;
1.1 raeburn 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'>
1.2 raeburn 149: <td valign='middle'><img src='/res/adm/pages/bl_step1.gif'>
1.1 raeburn 150: </td>
151: <td width='100%' align='left'>
1.2 raeburn 152: <font face='arial,helvetica,sans-serif'><b>Specify the Course Management system used to create the package.</b>
153: </font>
1.1 raeburn 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'>
1.2 raeburn 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>
1.1 raeburn 170: </td>
171: </tr>
172: <tr>
173: <td colspan='2'> </td>
174: </tr>
175: <tr>
1.2 raeburn 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>
1.1 raeburn 184: <tr>
1.2 raeburn 185: <td colspan='2'> </td>
186: </tr>
1.1 raeburn 187: <td> </td>
188: <td>
189: <font face='Arial,Helvetica,sans-serif'>
1.2 raeburn 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>
1.1 raeburn 191: </td>
192: </tr>
193: <tr>
1.2 raeburn 194: <td colspan='2'> <br /><br /></td>
1.1 raeburn 195: </tr>
196: <tr bgcolor='#ccddaa'>
1.2 raeburn 197: <td valign='middle'><img src='/res/adm/pages/bl_step3.gif'>
1.1 raeburn 198: </td>
199: <td width='100%' align='left'>
1.2 raeburn 200: <font face='arial,helvetica,sans-serif'><b>Indicate how any discussion boards and user data in the package should be handled</b></font>
1.1 raeburn 201: </td>
202: </tr>
203: <tr>
204: <td colspan='2'> </td>
205: </tr>
206: <tr>
207: <td> </td>
208: <td>
1.2 raeburn 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>
1.1 raeburn 265: </td>
266: </tr>
267: <tr>
1.2 raeburn 268: <td colspan='2'> <br /><br /></td>
1.1 raeburn 269: </tr>
270: <tr>
271: <td> </td>
1.2 raeburn 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>
1.1 raeburn 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>
1.2 raeburn 290: <td align='left'>
291: <input type='button' name='exitpage' value='Exit now' onClick="javascript:location.href='$fullpath'">
1.1 raeburn 292: </td>
293: <td align='right'>
1.2 raeburn 294: <input type="button" name="nextpage" value="Convert" onClick="javascript:nextPage()">
1.1 raeburn 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:
1.2 raeburn 308: # ---------------------------------------------------------------- Expand bb5
1.1 raeburn 309: sub expand_bb5 {
1.2 raeburn 310: my ($r,$uname,$udom,$fn,$page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling) = @_;
1.1 raeburn 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;
1.2 raeburn 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;
1.1 raeburn 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) {
1.2 raeburn 347: open(OUTPUT, "unzip -o $zipfile -d $docroot/temp 2> /dev/null |");
348: while (<OUTPUT>) {
349: print "$_<br />";
350: }
351: close(OUTPUT);
1.1 raeburn 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) {
1.2 raeburn 366: $statestr .= "$_ ";
1.1 raeburn 367: }
368: if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "tableofcontents") ) {
1.2 raeburn 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;
1.1 raeburn 396: }
1.2 raeburn 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];
1.1 raeburn 405: }
1.2 raeburn 406: $filepath{$itm} = $path;
407: $contentscount{$seq[-1]} ++;
408: $lastitem = $itm;
1.1 raeburn 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") {
1.2 raeburn 416: push @{$href{$identifier}},$attr->{href};
1.1 raeburn 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}} = ();
1.2 raeburn 472: &process_staff($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
1.1 raeburn 473: } elsif ($type{$key} eq "resource/x-bb-externallink") {
474: %{$resinfo{$key}} = ();
1.2 raeburn 475: &process_link($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
1.1 raeburn 476: } elsif ($type{$key} eq "resource/x-bb-discussionboard") {
477: %{$resinfo{$key}} = ();
1.2 raeburn 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: }
1.1 raeburn 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}} = ();
1.2 raeburn 491: &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob);
1.1 raeburn 492: } elsif ($type{$key} eq "assessment/x-bb-quiz") {
493: %{$resinfo{$key}} = ();
1.2 raeburn 494: &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob);
1.1 raeburn 495: } elsif ($type{$key} eq "assessment/x-bb-survey") {
496: %{$resinfo{$key}} = ();
1.2 raeburn 497: &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$resinfo{$key}},\$totpage,\$totprob);
1.1 raeburn 498: } elsif ($type{$key} eq "assessment/x-bb-group") {
499: %{$resinfo{$key}} = ();
1.2 raeburn 500: $contentscount{Top} ++;
501: push @groups, $key;
1.1 raeburn 502: &process_group($key,$docroot,$destdir,\%{$resinfo{$key}});
503: } elsif ($type{$key} eq "resource/x-bb-user") {
504: %{$resinfo{$key}} = ();
1.3 ! raeburn 505: unless ($users_handling eq 'ignore') {
! 506: &process_user($key,$docroot,$destdir,\%{$resinfo{$key}},$users_crs,$users_cdom,$users_handling);
1.2 raeburn 507: }
1.1 raeburn 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: open(LOCFILE,">$destdir/sequences/$key.sequence");
632: print LOCFILE "<map>\n";
1.2 raeburn 633: $totseq ++;
1.1 raeburn 634: if ($contentscount{$key} == 0) {
635: print LOCFILE qq|<resource id="1" src="" type="start"></resource>
636: <link from="1" to="2" index="1"></link>
637: <resource id="2" src="" type="finish"></resource>\n|;
638: } else {
639: if ($resinfo{$resnum{$contents{$key}[0]}}{'isfolder'} eq "true") {
640: $src = 'sequences/'.$contents{$key}[0].".sequence";
641: $pageflag{$key} = 0;
642: $seqflag{$key} = 1;
643: $seqcount{$key} ++;
644: } else {
645: if ($pageflag{$key}) {
646: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[0];
647: } else {
648: $pagecount{$key} ++;
649: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
650: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[0]");
651: $seqflag{$key} = 0;
652: }
653: }
654: unless ($pageflag{$key}) {
655: print LOCFILE qq|<resource id="1" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[0]}" type="start"|;
656: unless ($seqflag{$key}) {
657: $pageflag{$key} = 1;
658: }
659: }
660: if ($contentscount{$key} == 1) {
661: print LOCFILE qq|></resource>
662: <link from="1" to="2" index="1"></link>
663: <resource id="2" src="" type="finish"></resource>\n|;
664: } else {
665: if ($contentscount{$key} > 2 ) {
666: for (my $i=1; $i<$contentscount{$key}-1; $i++) {
667: if ($resinfo{$resnum{$contents{$key}[$i]}}{'isfolder'} eq "true") {
668: $src = 'sequences/'.$contents{$key}[$i].".sequence";
669: $pageflag{$key} = 0;
670: $seqflag{$key} = 1;
671: $seqcount{$key} ++;
672: } else {
673: if ($pageflag{$key}) {
674: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$i];
675: } else {
676: $pagecount{$key} ++;
677: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
678: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$i]");
679: $seqflag{$key} = 0;
680: }
681: }
682: unless ($pageflag{$key}) {
683: $curr_id ++;
684: $next_id ++;
685: print LOCFILE qq|></resource>
686: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
687: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$i]}"|;
688: unless ($seqflag{$key}) {
689: $pageflag{$key} = 1;
690: }
691: }
692: }
693: }
694: if ($resinfo{$resnum{$contents{$key}[$contentscount{$key}-1]}}{'isfolder'} eq "true") {
695: $src = 'sequences/'.$contents{$key}[$contentscount{$key}-1].".sequence";
696: $pageflag{$key} = 0;
697: $seqflag{$key} = 1;
698: } else {
699: if ($pageflag{$key}) {
700: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$contentscount{$key}-1];
701: } else {
702: $pagecount{$key} ++;
703: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
704: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$contentscount{$key}-1]");
705: }
706: }
707: if ($pageflag{$key}) {
708: if ($seqcount{$key} + $pagecount{$key} +1 == 1) {
709: print LOCFILE qq|></resource>
710: <link from="1" index="1" to="2">
711: <resource id ="2" src="" title="" type="finish"></resource>\n|;
712: } else {
713: print LOCFILE qq| type="finish"></resource>\n|;
714: }
715: } else {
716: $curr_id ++;
717: $next_id ++;
718: print LOCFILE qq|></resource>
719: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
720: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$contentscount{$key}-1]}" type="finish"></resource>\n|;
721: }
722: }
723: }
724: print LOCFILE "</map>\n";
725: close(LOCFILE);
726: }
727: }
728: }
1.2 raeburn 729: if (@boards > 0) {
730: $topnum ++;
731: print TOPFILE qq|<resource id="$topnum" src="/res/$udom/$uname/$newdir/sequences/bulletinboards.sequence" title="Course Bulletin Boards"|;
732: $nextnum = $topnum +1;
733: if ($topnum == 1) {
734: print TOPFILE qq| type="start"></resource>
735: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
736: if ($topnum == $contentscount{'Top'}) {
737: print TOPFILE qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
738: }
739: } else {
740: if ($topnum == $contentscount{'Top'}) {
741: print TOPFILE qq| type="finish"></resource>\n|;
742: } else {
743: print TOPFILE qq|></resource>
744: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
745: }
746: }
747: open(BOARD,">$destdir/sequences/bulletinboards.sequence");
748: print BOARD qq|<map>
749: <resource id="1" src="/adm/$udom/$uname/$timestamp[0]/bulletinboard" title="$resinfo{$boards[0]}{title}" type="start"></resource>
750: <link from="1" to="2" index="1"></link>|;
751: if (@boards == 1) {
752: print BOARD qq|
753: <resource id="2" src="" type="finish"></resource>\n|;
754: } else {
755: for (my $i=1; $i<@boards; $i++) {
756: print BOARD qq|<resource id="$i" src="/adm/$udom/$uname/$timestamp[$i]/bulletinboard" title="$resinfo{$boards[$i]}{title}"|;
757: my $curr = $i+1;
758: my $next = $i+2;
759: if (@boards == $i) {
760: print BOARD qq| type="finish"></resource>\n|;
761: } else {
762: print BOARD qq|></resource>
763: <link from="$curr" to="$next" index="$next">\n|;
764: }
765: }
766: }
767: print BOARD qq|</map>|;
768: close(BOARD);
769: }
1.1 raeburn 770: print TOPFILE "</map>";
771: close(TOPFILE);
772: foreach my $key (sort keys %pagecontents) {
773: for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
774: my $filestem = "/res/$udom/$uname/$newdir";
775: my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
1.2 raeburn 776: $totpage ++;
1.1 raeburn 777: open(PAGEFILE,">$filename");
778: print PAGEFILE qq|<map>
779: <resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][0]}.html" id="1" type="start" title="$title{$pagecontents{$key}[$i][0]}"></resource>
780: <link to="2" index="1" from="1">\n|;
781: if (@{$pagecontents{$key}[$i]} == 1) {
782: print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>|;
783: } elsif (@{$pagecontents{$key}[$i]} == 2) {
784: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][1]}.html" id="2" type="finish" title="$title{$pagecontents{$key}[$i][1]}"></resource>|;
785: } else {
786: for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
787: my $curr_id = $j+1;
788: my $next_id = $j+2;
789: my $resource = $filestem.'/resfiles/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html';
790: print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$title{$pagecontents{$key}[$i][$j]}"></resource>
791: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
792: }
793: my $final_id = @{$pagecontents{$key}[$i]};
794: 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|;
795: }
796: print PAGEFILE "</map>";
797: close(PAGEFILE);
798: }
799: }
800: system(" rm -r $docroot/temp");
1.2 raeburn 801: return($totseq,$totpage,$totprob);
1.1 raeburn 802: }
803:
1.2 raeburn 804:
1.1 raeburn 805: sub process_user {
1.2 raeburn 806: my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_;
1.1 raeburn 807: my $xmlfile = $docroot."/temp/".$res.".dat";
808: my $filecount = 0;
809: my @state;
810: my $userid = '';
811: my $linknum = 0;
812:
813: my $p = HTML::Parser->new
814: (
815: xml_mode => 1,
816: start_h =>
817: [sub {
818: my ($tagname, $attr) = @_;
819: push @state, $tagname;
1.2 raeburn 820: if (@state eq "USERS USER") {
1.1 raeburn 821: $userid = $attr->{value};
1.2 raeburn 822: %{$$settings{$userid}} = ();
1.1 raeburn 823: @{$$settings{$userid}{links}} = ();
824: } elsif (@state eq "USERS USER LOGINID") {
825: $$settings{$userid}{loginid} = $attr->{value};
826: } elsif (@state eq "USERS USER PASSPHRASE") {
827: $$settings{$userid}{passphrase} = $attr->{value};
828: } elsif ("@state" eq "USERS USER STUDENTID" ) {
829: $$settings{$userid}{studentid} = $attr->{value};
830: } elsif ("@state" eq "USERS USER NAMES FAMILY" ) {
831: $$settings{$userid}{family} = $attr->{value};
832: } elsif ("@state" eq "USERS USER NAMES GIVEN" ) {
833: $$settings{$userid}{given} = $attr->{value};
834: } elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") {
835: $$settings{$userid}{email} = $attr->{value};
836: } elsif ("@state" eq "USERS USER USER_ROLE") {
837: $$settings{$userid}{user_role} = $attr->{value};
838: } elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") {
839: $$settings{$userid}{isavailable} = $attr->{value};
840: } elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") {
841: $$settings{$userid}{image} = $attr->{value};
842: } elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) {
843: %{$$settings{$userid}{links}[$linknum]} = ();
844: $$settings{$userid}{links}[$linknum]{url} = $attr->{value};
845: $linknum ++;
846: }
847: }, "tagname, attr"],
848: text_h =>
849: [sub {
850: my ($text) = @_;
851: if ("@state" eq "USERS USER PERSONALPAGE TITLE") {
852: $$settings{$userid}{title} = $text;
853: } elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") {
854: $$settings{$userid}{description} = $text;
855: } elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) {
856: $$settings{$userid}{links}[$linknum]{title} = $text;
857: } elsif (($state[-3] eq "LINK") && ($state[-2] eq "DESCRIPTION") && ($state[-1] eq "TEXT")) {
858: $$settings{$userid}{links}[$linknum]{text} = $text;
859: }
860: }, "dtext"],
861: end_h =>
862: [sub {
863: my ($tagname) = @_;
864: if (@state eq "USERS USER") {
865: $linknum = 0;
866: }
867: pop @state;
868: }, "tagname"],
869: );
870: $p->unbroken_text(1);
871: $p->parse_file($xmlfile);
872: $p->eof;
1.2 raeburn 873:
874: my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
1.3 ! raeburn 875: my $xmlstem = $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";
1.2 raeburn 876:
877: foreach my $user_id (keys %{$settings}) {
878: if ($$settings{$user_id}{user_role} eq "s") {
1.3 ! raeburn 879:
1.2 raeburn 880: } elsif ($user_handling eq 'enrollall') {
1.3 ! raeburn 881:
1.2 raeburn 882: }
883: }
1.1 raeburn 884: }
885:
886: sub process_group {
887: my ($res,$docroot,$destdir,$settings) = @_;
888: my $xmlfile = $docroot."/".$res.".dat";
889: my $filecount = 0;
890: my @state;
891: my $grp;
892:
893: my $p = HTML::Parser->new
894: (
895: xml_mode => 1,
896: start_h =>
897: [sub {
898: my ($tagname, $attr) = @_;
899: push @state, $tagname;
900: if (@state eq "GROUPS GROUP") {
901: $grp = $attr->{id};
902: }
903: if (@state eq "GROUPS GROUP TITLE") {
904: $$settings{$grp}{title} = $attr->{value};
905: } elsif (@state eq "GROUPS GROUP FLAGS ISAVAILABLE") {
906: $$settings{$grp}{isavailable} = $attr->{value};
907: } elsif (@state eq "GROUPS GROUP FLAGS HASCHATROOM") {
908: $$settings{$grp}{chat} = $attr->{value};
909: } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
910: $$settings{$grp}{discussion} = $attr->{value};
911: } elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") {
912: $$settings{$grp}{transfer} = $attr->{value};
913: } elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") {
914: $$settings{$grp}{public} = $attr->{value};
915: }
916: }, "tagname, attr"],
917: text_h =>
918: [sub {
919: my ($text) = @_;
920: if ("@state" eq "GROUPS DESCRIPTION") {
921: $$settings{$grp}{description} = $text;
922: # print "Staff text is $text\n";
923: }
924: }, "dtext"],
925: end_h =>
926: [sub {
927: my ($tagname) = @_;
928: pop @state;
929: }, "tagname"],
930: );
931: $p->unbroken_text(1);
932: $p->parse_file($xmlfile);
933: $p->eof;
934: }
935:
936: sub process_staff {
1.2 raeburn 937: my ($res,$docroot,$dirname,$destdir,$settings) = @_;
1.1 raeburn 938: my $xmlfile = $docroot."/temp/".$res.".dat";
939: my $filecount = 0;
940: my @state;
941: %{$$settings{name}} = ();
942: %{$$settings{office}} = ();
943:
944: my $p = HTML::Parser->new
945: (
946: xml_mode => 1,
947: start_h =>
948: [sub {
949: my ($tagname, $attr) = @_;
950: push @state, $tagname;
951: if (@state eq "STAFFINFO TITLE") {
952: $$settings{title} = $attr->{value};
1.2 raeburn 953: } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
1.1 raeburn 954: $$settings{textcolor} = $attr->{value};
1.2 raeburn 955: } elsif (@state eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
956: $$settings{ishtml} = $attr->{value};
1.1 raeburn 957: } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
958: $$settings{isavailable} = $attr->{value};
959: } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) {
960: $$settings{isfolder} = $attr->{value};
961: } elsif ("@state" eq "STAFFINFO POSITION" ) {
962: $$settings{position} = $attr->{value};
963: } elsif ("@state" eq "STAFFINFO HOMEPAGE" ) {
964: $$settings{homepage} = $attr->{value};
965: } elsif ("@state" eq "STAFFINFO IMAGE") {
966: $$settings{image} = $attr->{value};
967: }
968: }, "tagname, attr"],
969: text_h =>
970: [sub {
971: my ($text) = @_;
972: if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") {
973: $$settings{text} = $text;
974: # print "Staff text is $text\n";
975: } elsif ("@state" eq "STAFFINFO CONTACT PHONE") {
976: $$settings{phone} = $text;
977: } elsif ("@state" eq "STAFFINFO CONTACT EMAIL") {
978: $$settings{email} = $text;
979: } elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") {
980: $$settings{name}{formaltitle} = $text;
981: } elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") {
982: $$settings{name}{family} = $text;
983: } elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") {
984: $$settings{name}{given} = $text;
985: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") {
986: $$settings{office}{hours} = $text;
987: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") {
988: $$settings{office}{address} = $text;
989: }
990: }, "dtext"],
991: end_h =>
992: [sub {
993: my ($tagname) = @_;
994: pop @state;
995: }, "tagname"],
996: );
997: $p->unbroken_text(1);
998: $p->parse_file($xmlfile);
999: $p->eof;
1.2 raeburn 1000:
1001: my $fontcol = '';
1002: if (defined($$settings{textcolor})) {
1003: $fontcol = qq|color="$$settings{textcolor}"|;
1004: }
1005: if (defined($$settings{text})) {
1006: if ($$settings{ishtml} eq "true") {
1007: $$settings{text} = &HTML::Entities::decode($$settings{text});
1008: }
1009: }
1010: my $staffentry = qq|
1011: <table border="0" cellpadding="0" cellspacing="0" width="100%">
1012: <tr>
1013: <td colspan="2"><hr /><font face="arial,helv" size="3"><b>$$settings{name}{formaltitle} $$settings{name}{given} $$settings{name}{family}</b></font>
1014: </td>
1015: </tr>
1016: <tr>
1017: <td valign="top">
1018: <table width="100% border="0" cols="2" cellpadding="0" cellspacing="0">|;
1019: if ( defined($$settings{email}) && $$settings{email} ne '') {
1020: $staffentry .= qq|
1021: <tr>
1022: <td width="100" valign="top">
1023: <font face="arial" size="2"><b>Email:</b></font>
1024: </td>
1025: <td>
1026: <font face="arial" size="2"><a href="mailto:$$settings{email}">$$settings{email}</a></font>
1027: </td>
1028: </tr>
1029: |;
1030: }
1031: if (defined($$settings{phone}) && $$settings{phone} ne '') {
1032: $staffentry .= qq|
1033: <tr>
1034: <td width="100" valign="top">
1035: <font face="arial" size="2"><b>Phone:</b></font>
1036: </td>
1037: <td>
1038: <font face="arial" size="2">$$settings{phone}</font>
1039: </td>
1040: </tr>
1041: |;
1042: }
1043: if (defined($$settings{office}{address}) && $$settings{office}{address} ne '') {
1044: $staffentry .= qq|
1045: <tr>
1046: <td width="100" valign="top">
1047: <font face="arial" size="2"><b>Address:</b></font>
1048: </td>
1049: <td>
1050: <font face="arial" size="2">$$settings{office}{address}</font>
1051: </td>
1052: </tr>
1053: |;
1054: }
1055: if (defined($$settings{office}{hours}) && $$settings{office}{hours} ne '') {
1056: $staffentry .= qq|
1057: <tr>
1058: <td width="100" valign="top">
1059: <font face="arial" size="2"><b>Office Hours:</b></font>
1060: </td>
1061: <td>
1062: <font face=arial size=2>$$settings{office}{hours}</font>
1063: </td>
1064: </tr>
1065: |;
1066: }
1067: if ( defined($$settings{homepage}) && $$settings{homepage} ne '') {
1068: $staffentry .= qq|
1069: <tr>
1070: <td width="100" valign="top">
1071: <font face="arial" size="2"><b>Personal Link:</b></font>
1072: </td>
1073: <td>
1074: <font face="arial" size="2"><a href="$$settings{homepage}">$$settings{homepage}</a></font>
1075: </td>
1076: </tr>
1077: |;
1078: }
1079: if (defined($$settings{text}) && $$settings{text} ne '') {
1080: $staffentry .= qq|
1081: <tr>
1082: <td colspan="2">
1083: <font face="arial" size="2" $fontcol><b>Other Information:</b><br/>$$settings{text}</font>
1084: </td>
1085: </tr>
1086: |;
1087: }
1088: $staffentry .= qq|
1089: </table>
1090: </td>
1091: <td align="right" valign="top">
1092: |;
1093: if ( defined($$settings{image}) ) {
1094: $staffentry .= qq|
1095: <img src="$dirname/resfiles/$res/$$settings{image}">
1096: |;
1097: }
1098: $staffentry .= qq|
1099: </td>
1100: </tr>
1101: </table>
1102: |;
1103: open(FILE,">$destdir/resfiles/$res.html");
1104: print FILE qq|<html>
1105: <head>
1106: <title>$$settings{title}</title>
1107: </head>
1108: <body bgcolor='#ffffff'>
1109: $staffentry
1110: </body>
1111: </html>|;
1112: close(FILE);
1.1 raeburn 1113: }
1114:
1115: sub process_link {
1.2 raeburn 1116: my ($res,$docroot,$dirname,$destdir,$settings) = @_;
1117: my $xmlfile = $docroot."/temp/".$res.".dat";
1118: my @state = ();
1119: my $p = HTML::Parser->new
1120: (
1121: xml_mode => 1,
1122: start_h =>
1123: [sub {
1124: my ($tagname, $attr) = @_;
1125: push @state, $tagname;
1126: if (@state eq "EXTERNALLINK TITLE") {
1127: $$settings{title} = $attr->{value};
1128: } elsif (@state eq "EXTERNALLINK TEXTCOLOR") {
1129: $$settings{textcolor} = $attr->{value};
1130: } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {
1131: $$settings{ishtml} = $attr->{value};
1132: } elsif ("@state" eq "EXTERNALLINKS FLAGS ISAVAILABLE" ) {
1133: $$settings{isavailable} = $attr->{value};
1134: } elsif ("@state" eq "EXTERNALLINKS FLAGS LAUNCHINNEWWINDOW" ) {
1135: $$settings{newwindow} = $attr->{value};
1136: } elsif ("@state" eq "EXTERNALLINKS FLAGS ISFOLDER" ) {
1137: $$settings{isfolder} = $attr->{value};
1138: } elsif ("@state" eq "EXTERNALLINKS POSITION" ) {
1139: $$settings{position} = $attr->{value};
1140: } elsif ("@state" eq "EXTERNALLINKS URL" ) {
1141: $$settings{url} = $attr->{value};
1142: }
1143: }, "tagname, attr"],
1144: text_h =>
1145: [sub {
1146: my ($text) = @_;
1147: if ("@state" eq "EXTERNALLINKS DESCRIPTION TEXT") {
1148: $$settings{text} = $text;
1149: }
1150: }, "dtext"],
1151: end_h =>
1152: [sub {
1153: my ($tagname) = @_;
1154: pop @state;
1155: }, "tagname"],
1156: );
1157: $p->unbroken_text(1);
1158: $p->parse_file($xmlfile);
1159: $p->eof;
1160:
1161: my $linktag = '';
1162: my $fontcol = '';
1163: if (defined($$settings{textcolor})) {
1164: $fontcol = qq|<font color="$$settings{textcolor}">|;
1165: }
1166: if (defined($$settings{text})) {
1167: if ($$settings{ishtml} eq "true") {
1168: $$settings{text} = &HTML::Entities::decode($$settings{text});
1169: }
1170: }
1171:
1172: if (defined($$settings{url}) ) {
1173: $linktag = qq|<a href="$$settings{url}"|;
1174: if ($$settings{newwindow} eq "true") {
1175: $linktag .= qq| target="launch"|;
1176: }
1177: $linktag .= qq|>$$settings{title}</a>|;
1178: }
1179:
1180: open(FILE,">$destdir/resfiles/$res.html");
1181: print FILE qq|<html>
1182: <head>
1183: <title>$$settings{title}</title>
1184: </head>
1185: <body bgcolor='#ffffff'>
1186: $fontcol
1187: $linktag
1188: $$settings{text}
1189: |;
1190: if (defined($$settings{textcolor})) {
1191: print FILE qq|</font>|;
1192: }
1193: print FILE qq|
1194: </body>
1195: </html>|;
1196: close(FILE);
1197: }
1198:
1199: sub process_db {
1200: my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings) = @_;
1201: my $xmlfile = $docroot."/temp/".$res.".dat";
1202: my @state = ();
1203: my @allmsgs = ();
1204: my %msgidx = ();
1205: my $longcrs = '';
1206: if ($crs =~ m/^(\d)(\d)(\d)/) {
1207: $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
1208: }
1209: my %threads; # all quotes, keyed by message ID
1210: my $msg_id; # the current message ID
1211: my %message; # the current message being accumulated for $msg_id
1.1 raeburn 1212:
1.2 raeburn 1213: my $p = HTML::Parser->new
1.1 raeburn 1214: (
1.2 raeburn 1215: xml_mode => 1,
1216: start_h =>
1217: [sub {
1218: my ($tagname, $attr) = @_;
1219: push @state, $tagname;
1220: my $depth = 0;
1221: my @seq = ();
1222: if ("@state" eq "FORUM TITLE") {
1223: $$settings{title} = $attr->{value};
1224: } elsif ("@state" eq "FORUM DESCRIPTION TEXTCOLOR") {
1225: $$settings{textcolor} = $attr->{value};
1226: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISHTML") {
1227: $$settings{ishtml} = $attr->{value};
1228: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") {
1229: $$settings{newline} = $attr->{value};
1230: } elsif ("@state" eq "FORUM POSITION" ) {
1231: $$settings{position} = $attr->{value};
1232: } elsif ("@state" eq "FORUM FLAGS ISREADONLY") {
1233: $$settings{isreadonly} = $attr->{value};
1234: } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) {
1235: $$settings{isavailable} = $attr->{value};
1236: } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) {
1237: $$settings{allowanon} = $attr->{value};
1238: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1239: if ($state[-1] eq "MSG") {
1240: unless ($msg_id eq '') {
1241: push @{$threads{$msg_id}}, { %message };
1242: $depth = @state - 3;
1243: if ($depth > @seq) {
1244: push @seq, $msg_id;
1245: }
1246: }
1247: if ($depth < @seq) {
1248: pop @seq;
1249: }
1250: $msg_id = $attr->{id};
1251: push @allmsgs, $msg_id;
1252: $msgidx{$msg_id} = @allmsgs;
1253: %message = ();
1254: $message{depth} = $depth;
1255: if ($depth > 0) {
1256: $message{parent} = $seq[-1];
1257: } else {
1258: $message{parent} = "None";
1259: }
1260: } elsif ($state[-1] eq "TITLE") {
1261: $message{title} = $attr->{value};
1262: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISHTML" ) ) {
1263: $message{ishtml} = $attr->{value};
1264: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISNEWLINELITERAL" ) ) {
1265: $message{newline} = $attr->{value};
1266: } elsif ( ( $state[-2] eq "DATES" ) && ( $state[-1] eq "CREATED" ) ) {
1267: $message{created} = $attr->{value};
1268: } elsif ( $state[@state-2] eq "FLAGS") {
1269: if ($state[@state-1] eq "ISANONYMOUS") {
1270: $message{isanonymous} = $attr->{value};
1271: }
1272: } elsif ( $state[-2] eq "USER" ) {
1273: if ($state[-1] eq "USERID") {
1274: $message{userid} = $attr->{value};
1275: } elsif ($state[@state-1] eq "USERNAME") {
1276: $message{username} = $attr->{value};
1277: } elsif ($state[@state-1] eq "EMAIL") {
1278: $message{email} = $attr->{value};
1279: }
1280: } elsif ( ($state[-2] eq "FILELIST") && ($state[-1] eq "IMAGE") ) {
1281: $message{attachment} = $attr->{value};
1282: }
1283: }
1284: }, "tagname, attr"],
1285: text_h =>
1286: [sub {
1287: my ($text) = @_;
1288: if ("@state" eq "FORUM DESCRIPTION TEXT") {
1289: $$settings{text} = $text;
1290: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1291: if ( ($state[-2] eq "MESSAGETEXT") && ($state[-1] eq "TEXT") ){
1292: $message{text} = $text;
1293: }
1294: }
1295: }, "dtext"],
1296: end_h =>
1297: [sub {
1298: my ($tagname) = @_;
1299: if ( $state[-1] eq "MESSAGETHREADS" ) {
1300: push @{$threads{$msg_id}}, { %message };
1301: }
1302: pop @state;
1303: }, "tagname"],
1304: );
1305: $p->unbroken_text(1);
1306: $p->parse_file($xmlfile);
1307: $p->eof;
1308:
1309: if (defined($$settings{text})) {
1310: if ($$settings{ishtml} eq "false") {
1311: if ($$settings{isnewline} eq "true") {
1312: $$settings{text} =~ s#\n#<br/>#g;
1313: }
1314: } else {
1315: $$settings{text} = &HTML::Entities::decode($$settings{text});
1316: }
1317: if (defined($$settings{fontcolor}) ) {
1318: $$settings{text} = "<font color=\"".$$settings{textcolor}."\">".$$settings{text}."</font>";
1.1 raeburn 1319: }
1.2 raeburn 1320: }
1321: my $boardname = 'bulletinpage_'.$timestamp;
1322: my %boardinfo = (
1323: 'aaa_title' => $$settings{title},
1324: 'bbb_content' => $$settings{text},
1325: 'ccc_webreferences' => '',
1326: 'uploaded.lastmodified' => time,
1327: );
1328:
1329: my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
1330: if ($handling eq 'importall') {
1331: foreach my $msg_id (@allmsgs) {
1332: foreach my $message ( @{$threads{$msg_id}} ) {
1333: my %contrib = (
1334: 'sendername' => $$message{userid},
1335: 'senderdomain' => $cdom,
1336: 'screenname' => '',
1337: 'plainname' => $$message{username},
1338: );
1339: unless ($$message{parent} eq 'None') {
1340: $contrib{replyto} = $msgidx{$$message{parent}};
1341: }
1342: if (defined($$message{isanonymous}) ) {
1343: if ($$message{isanonymous} eq 'true') {
1344: $contrib{'anonymous'} = 'true';
1345: }
1346: }
1347: if ( defined($$message{attachment}) ) {
1348: my $url = $$message{attachment};
1349: my $oldurl = $url;
1350: my $newurl = $url;
1351: unless ($url eq '') {
1352: $newurl =~ s/\//_/g;
1353: unless ($longcrs eq '') {
1354: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
1355: mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
1356: }
1357: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
1358: system("cp $destdir/resfiles/$res/$$message{attachment} /home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
1359: }
1360: $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$newurl;
1361: }
1362: }
1363: }
1364: if (defined($$message{title}) ) {
1365: $contrib{'message'} = $$message{title};
1366: }
1367: if (defined($$message{text})) {
1368: if ($$message{ishtml} eq "false") {
1369: if ($$message{isnewline} eq "true") {
1370: $$message{text} =~ s#\n#<br/>#g;
1371: }
1372: } else {
1373: $$message{text} = &HTML::Entities::decode($$message{text});
1374: }
1375: $contrib{'message'} .= '<br /><br />'.$$message{text};
1376: my $symb = 'bulletin___'.$timestamp.'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$timestamp.'/bulletinboard';
1377: my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
1378: }
1379: }
1.1 raeburn 1380: }
1.2 raeburn 1381: }
1382: }
1383:
1384: sub addposting {
1385: my ($symb,$contrib,$cdom,$crs)=@_;
1386: my $status='';
1387: if (($symb) && ($$contrib{message})) {
1388: my $crsdom = $cdom.'_'.$crs;
1389: &Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs);
1390: my %storenewentry=($symb => time);
1391: &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
1392: }
1393: my %record=&Apache::lonnet::restore('_discussion');
1394: my ($temp)=keys %record;
1395: unless ($temp=~/^error\:/) {
1396: my %newrecord=();
1397: $newrecord{'resource'}=$symb;
1398: $newrecord{'subnumber'}=$record{'subnumber'}+1;
1399: &Apache::lonnet::cstore(\%newrecord,'_discussion');
1400: $status = 'ok';
1401: } else {
1402: $status.='Failed.';
1403: }
1404: return $status;
1.1 raeburn 1405: }
1406:
1.2 raeburn 1407: sub process_assessment {
1408: my ($res,$docroot,$container,$dirname,$destdir,$settings,$totpageref,$totprobref) = @_;
1.1 raeburn 1409: my $xmlfile = $docroot."/temp/".$res.".dat";
1.2 raeburn 1410: # print "XML file is $xmlfile\n";
1.1 raeburn 1411: my @state = ();
1.2 raeburn 1412: my @allids = ();
1413: my %allanswers = ();
1414: my %allchoices = ();
1415: my $id; # the current question ID
1416: my $answer_id; # the current answer ID
1417: my %toptag = ( pool => 'POOL',
1418: quiz => 'ASSESSMENT',
1419: survey => 'ASSESSMENT'
1420: );
1421: # print "process_assessment is called, incoming: $res,$docroot,$container,$destdir\n";
1.1 raeburn 1422:
1423: my $p = HTML::Parser->new
1424: (
1425: xml_mode => 1,
1426: start_h =>
1427: [sub {
1428: my ($tagname, $attr) = @_;
1429: push @state, $tagname;
1430: my $depth = 0;
1431: my @seq = ();
1.2 raeburn 1432: my $class;
1433: my $state_str = join(" ",@state);
1434: # print "Current state is $state_str\n";
1435: if ($container eq "pool") {
1.1 raeburn 1436: if ("@state" eq "POOL TITLE") {
1437: $$settings{title} = $attr->{value};
1438: # print "Title is $attr->{value}\n";
1439: }
1440: } else {
1441: if ("@state" eq "ASSESSMENT TITLE") {
1442: $$settings{title} = $attr->{value};
1443: } elsif ("@state" eq "ASSESSMENT FLAG" ) {
1444: $$settings{isnewline} = $attr->{value};
1445: } elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") {
1446: $$settings{isavailable} = $attr->{value};
1447: } elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) {
1448: $$settings{isanonymous} = $attr->{id};
1449: } elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) {
1450: $$settings{feedback} = $attr->{id};
1451: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) {
1452: $$settings{showcorrect} = $attr->{id};
1453: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) {
1454: $$settings{showresults} = $attr->{id};
1455: } elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) {
1456: $$settings{allowmultiple} = $attr->{id};
1457: } elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) {
1458: $$settings{type} = $attr->{id};
1459: }
1460: }
1461: if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {
1462: $id = $attr->{id};
1.2 raeburn 1463: unless ($container eq 'pool') {
1464: push @allids, $id;
1465: }
1.1 raeburn 1466: %{$$settings{$id}} = ();
1467: @{$allanswers{$id}} = ();
1468: $$settings{$id}{class} = $attr->{class};
1469: unless ($container eq "pool") {
1470: $$settings{$id}{points} = $attr->{points};
1471: }
1472: @{$$settings{$id}{correctanswer}} = ();
1473: } elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) {
1474: $id = $attr->{id};
1475: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISHTML") ) {
1476: $$settings{$id}{html} = $attr->{value};
1477: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISNEWLINELITERAL") ) {
1478: $$settings{$id}{newline} = $attr->{value};
1479: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) {
1480: $$settings{$id}{image} = $attr->{value};
1481: $$settings{$id}{style} = $attr->{style};
1482: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) {
1483: $$settings{$id}{url} = $attr->{value};
1484: $$settings{$id}{name} = $attr->{name};
1485: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
1486: $answer_id = $attr->{id};
1487: push @{$allanswers{$id}},$answer_id;
1488: %{$$settings{$id}{$answer_id}} = ();
1489: $$settings{$id}{$answer_id}{position} = $attr->{position};
1490: if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
1491: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1492: $$settings{$id}{$answer_id}{type} = 'answer';
1493: }
1494: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
1495: $answer_id = $attr->{id};
1496: push @{$allchoices{$id}},$answer_id;
1497: %{$$settings{$id}{$answer_id}} = ();
1498: $$settings{$id}{$answer_id}{position} = $attr->{position};
1499: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1500: $$settings{$id}{$answer_id}{type} = 'choice';
1501: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "IMAGE") ) {
1502: $$settings{$id}{$answer_id}{image} = $attr->{value};
1503: $$settings{$id}{$answer_id}{style} = $attr->{style};
1504: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "URL") ) {
1505: $$settings{$id}{$answer_id}{url} = $attr->{value};
1506: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "IMAGE") ) {
1507: $$settings{$id}{$answer_id}{image} = $attr->{value};
1508: $$settings{$id}{$answer_id}{style} = $attr->{style};
1509: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "URL") ) {
1510: $$settings{$id}{$answer_id}{url} = $attr->{value};
1511: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) {
1512: my $corr_answer = $attr->{answer_id};
1513: push @{$$settings{$id}{correctanswer}}, $corr_answer;
1514: # print "Answer $corr_answer for question $id is correct\n";
1515: my $type = $1;
1516: if ($type eq 'TRUEFALSE') {
1517: $$settings{$id}{$corr_answer}{answer_position} = $attr->{position};
1518: } elsif ($type eq 'ORDER') {
1519: $$settings{$id}{$corr_answer}{order} = $attr->{order};
1520: } elsif ($type eq 'MATCH') {
1521: $$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id};
1522: }
1523: }
1524: }, "tagname, attr"],
1525: text_h =>
1526: [sub {
1527: my ($text) = @_;
1528: unless ($container eq "pool") {
1529: if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
1530: $$settings{description} = $text;
1531: } elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") {
1532: $$settings{instructions}{text} = $text;
1533: }
1534: }
1535: if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "TEXT") ) {
1536: $$settings{$id}{text} = $text;
1537: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) {
1538: $$settings{$id}{$answer_id}{text} = $text;
1539: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) {
1540: $$settings{$id}{$answer_id}{text} = $text;
1541: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) {
1542: $$settings{$id}{feedback_corr} = $text;
1543: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) {
1544: $$settings{$id}{feedback_incorr} = $text;
1545: }
1546: }, "dtext"],
1547: end_h =>
1548: [sub {
1549: my ($tagname) = @_;
1550: pop @state;
1551: }, "tagname"],
1552: );
1553: $p->unbroken_text(1);
1554: $p->parse_file($xmlfile);
1555: $p->eof;
1556:
1557: my $dirtitle = $$settings{'title'};
1558: $dirtitle =~ s/\W//g;
1559: $dirtitle .= '_'.$res;
1560: if (!-e "$destdir/problems/$dirtitle") {
1561: mkdir("$destdir/problems/$dirtitle",0755);
1562: }
1563: my $newdir = "$destdir/problems/$dirtitle";
1.2 raeburn 1564: my $pagedir = "$destdir/pages";
1565: my $curr_id = 0;
1566: my $next_id = 0;
1567: unless ($container eq 'pool') {
1568: open(PAGEFILE,">$pagedir/$res.page");
1569: print PAGEFILE qq|<map>
1570: |;
1571: $$totpageref ++;
1572: }
1.1 raeburn 1573: foreach my $id (@allids) {
1.2 raeburn 1574: $curr_id ++;
1575: $next_id = $curr_id + 1;
1576: if ($curr_id == 0) {
1577: print PAGEFILE qq|<resource id="1" src="$newdir/$id.problem" type="start"></resource>\n|;
1578: } else {
1579: print PAGEFILE qq|
1580: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
1581: <resource id="$curr_id" src="$newdir/$id.problem"|;
1582: $curr_id ++;
1583: $next_id = $curr_id + 1;
1584: if ($curr_id == @allids) {
1585: print PAGEFILE qq| type="finish"></resource>\n|;
1586: } else {
1587: print PAGEFILE qq|></resource>|;
1588: }
1589: }
1.1 raeburn 1590: # print "Current ID is $id, type is $$settings{$id}{class} \n";
1.2 raeburn 1591: if (@allids == 1) {
1592: print PAGEFILE qq|<link from="1" to="2" index="1"></link>
1593: <resource id="2" src="" type="finish">\n|;
1594: }
1595:
1596: my $output = qq|<problem>
1597: |;
1598: $$totprobref ++;
1.1 raeburn 1599: if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
1.2 raeburn 1600: $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
1.1 raeburn 1601: <essayresponse>
1602: <textfield></textfield>
1603: </essayresponse>
1604: <postanswerdate>
1605: $$settings{$id}{feedbackcorr}
1606: </postanswerdate>
1607: |;
1608: } else {
1609: $output .= qq|<startouttext />$$settings{$id}{text}\n|;
1610: if ( defined($$settings{$id}{image}) ) {
1611: if ( $$settings{$id}{style} eq 'embed' ) {
1612: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{image}" /><br />|;
1613: } else {
1614: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
1615: }
1616: }
1617: if ( defined($$settings{$id}{url}) ) {
1618: $output .= qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
1619: }
1620: $output .= qq|
1621: <endouttext />|;
1622: if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
1623: my $numfoils = @{$allanswers{$id}};
1624: $output .= qq|
1625: <radiobuttonresponse max="$numfoils" randomize="yes">
1626: <foilgroup>
1627: |;
1628: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1629: $output .= " <foil name=\"foil".$k."\" value=\"";
1630: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1631: $output .= "true\" location=\"";
1632: } else {
1633: $output .= "false\" location=\"";
1634: }
1635: if (lc ($allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
1636: $output .= "bottom\"";
1637: } else {
1638: $output .= "random\"";
1639: }
1640: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};
1641: if ( defined($$settings{$id}{$allanswers{$id}[$k]}{image}) ) {
1642: if ( $$settings{$id}{$allanswers{$id}[$k]}{style} eq 'embed' ) {
1643: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" /><br />|;
1644: } else {
1645: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
1646: }
1647: }
1648: $output .= qq|<endouttext /></foil>\n|;
1649: }
1650: chomp($output);
1651: $output .= qq|
1652: </foilgroup>
1653: </radiobuttonresponse>
1654: |;
1655: } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
1656: my $numfoils = @{$allanswers{$id}};
1657: # print "Number of foils is $numfoils\n";
1658: $output .= qq|
1659: <radiobuttonresponse max="$numfoils" randomize="yes">
1660: <foilgroup>
1661: |;
1662: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1663: $output .= " <foil name=\"foil".$k."\" value=\"";
1664: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1665: $output .= "true\" location=\"random\"";
1666: } else {
1667: $output .= "false\" location=\"random\"";
1668: }
1669: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1670: }
1671: chomp($output);
1672: $output .= qq|
1673: </foilgroup>
1674: </radiobuttonresponse>
1675: |;
1676: } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
1677: my $numfoils = @{$allanswers{$id}};
1678: # print "Number of foils is $numfoils\n";
1679: $output .= qq|
1680: <optionresponse max="$numfoils" randomize="yes">
1681: <foilgroup options="('True','False')">
1682: |;
1683: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1684: $output .= " <foil name=\"foil".$k."\" value=\"";
1685: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1686: $output .= "True\"";
1687: } else {
1688: $output .= "False\"";
1689: }
1690: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1691: }
1692: chomp($output);
1693: $output .= qq|
1694: </foilgroup>
1.2 raeburn 1695: </optionresponse>
1.1 raeburn 1696: |;
1697: } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
1698: my $numfoils = @{$allanswers{$id}};
1699: $output .= qq|
1700: <rankresponse max="$numfoils" randomize="yes">
1701: <foilgroup>
1702: |;
1703: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1704: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1705: }
1706: chomp($output);
1707: $output .= qq|
1708: </foilgroup>
1709: </rankresponse>
1710: |;
1711: } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
1712: my $numerical = 1;
1713: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1.2 raeburn 1714: if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
1.1 raeburn 1715: $numerical = 0;
1716: }
1717: }
1718: if ($numerical) {
1719: my $numans;
1720: my $tol;
1721: if (@{$allanswers{$id}} == 1) {
1722: $tol = 5;
1723: $numans = $$settings{$id}{$allanswers{$id}[0]}{text};
1724: } else {
1725: my $min = $$settings{$id}{$allanswers{$id}[0]}{text};
1726: my $max = $$settings{$id}{$allanswers{$id}[0]}{text};
1727: for (my $k=1; $k<@{$allanswers{$id}}; $k++) {
1728: if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {
1729: $min = $$settings{$id}{$allanswers{$id}[$k]}{text};
1730: }
1731: if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {
1732: $max = $$settings{$id}{$allanswers{$id}[$k]}{text};
1733: }
1734: }
1735: $numans = ($max + $min)/2;
1736: $tol = 100*($max - $min)/($numans*2);
1737: }
1738: $output .= qq|
1739: <numericalresponse answer="$numans">
1740: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
1741: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
1742: />
1743: <textline />
1744: </numericalresponse>
1745: |;
1746: } else {
1747: if (@{$allanswers{$id}} == 1) {
1748: $output .= qq|
1749: <stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">
1750: <textline>
1751: </textline>
1752: </stringresponse>
1753: |;
1754: } else {
1755: my @answertext = ();
1756: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1757: $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
1758: push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};
1759: }
1760: my $regexpans = join('|',@answertext);
1761: $regexpans = '/^('.$regexpans.')\b/';
1762: $output .= qq|
1763: <stringresponse answer="$regexpans" type="re">
1764: <textline>
1765: </textline>
1766: </stringresponse>
1767: |;
1768: }
1769: }
1770: } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
1771: $output .= qq|
1772: <matchresponse max="10" randomize="yes">
1773: <foilgroup>
1774: <itemgroup>
1775: |;
1776: for (my $k=0; $k<@{$allchoices{$id}}; $k++) {
1777: $output .= qq|
1778: <item name="$allchoices{$id}[$k]">
1779: <startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />
1780: </item>
1781: |;
1782: }
1783: $output .= qq|
1784: </itemgroup>
1785: |;
1786: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1787: $output .= qq|
1788: <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">
1789: <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />
1790: </foil>
1791: |;
1792: }
1793: $output .= qq|
1794: </foilgroup>
1795: </matchresponse>
1796: |;
1797: }
1798: }
1.2 raeburn 1799: $output .= qq|</problem>
1800: |;
1801: open(PROB,">$newdir/$id.problem");
1802: print PROB $output;
1803: close PROB;
1804: }
1805: unless ($container eq 'pool') {
1806: print PAGEFILE qq|</map>|;
1807: close(PAGEFILE);
1.1 raeburn 1808: }
1809: }
1810:
1811:
1812: sub create_ess {
1813: my ($newdir,$qnid,$qsettings,$container) = @_;
1814: my $output;
1815: if ($container eq 'pool') {
1816: $output = qq|<problem>
1817: <startouttext />$$qsettings{text}<endouttext />
1818: |;
1819: } else {
1820: $output = qq|<problem>
1821: <startouttext />$$qsettings{text}<endouttext />
1822: |;
1823: }
1824: $output .= qq|
1825: <essayresponse>
1826: <textfield></textfield>
1827: </essayresponse>
1828: <postanswerdate>
1829: $$qsettings{feedbackcorr}
1830: </postanswerdate>
1831: |;
1832: if ($container eq 'pool') {
1833: $output .= qq|</problem>
1834: |;
1835: open(PROB,">$newdir/$qnid.problem");
1836: print PROB $output;
1837: close PROB;
1838: } else {
1839: $output .= qq|</problem>
1840: |;
1841: open(PROB,">$newdir/$qnid.problem");
1842: print PROB $output;
1843: close PROB;
1844: }
1845: return;
1846: }
1847:
1848: sub process_announce {
1849: my ($res,$docroot,$destdir,$settings) = @_;
1850: my $xmlfile = $docroot."/temp/".$res.".dat";
1851: my @state = ();
1.2 raeburn 1852: my @assess = ();
1.1 raeburn 1853: my $id;
1854: my $p = HTML::Parser->new
1855: (
1856: xml_mode => 1,
1857: start_h =>
1858: [sub {
1859: my ($tagname, $attr) = @_;
1860: push @state, $tagname;
1861: if ("@state" eq "ANNOUNCEMENT TITLE") {
1862: $$settings{title} = $attr->{value};
1863: $$settings{startassessment} = ();
1864: # print "Title is $$settings{title}\n";
1865: } elsif (@state eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {
1866: $$settings{ishtml} = $attr->{value};
1867: } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
1868: $$settings{isnewline} = $attr->{value};
1869: } elsif ("@state" eq "CONTENT ISPERMANENT" ) {
1870: $$settings{ispermanent} = $attr->{value};
1871: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) {
1872: $id = $attr->{id};
1.2 raeburn 1873: %{$$settings{startassessment}{$id}} = ();
1874: push @assess,$id;
1.1 raeburn 1875: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) {
1876: my $key = $attr->{key};
1877: $$settings{startassessment}{$id}{$key} = $attr->{value};
1878: }
1879: }, "tagname, attr"],
1880: text_h =>
1881: [sub {
1882: my ($text) = @_;
1883: if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") {
1.2 raeburn 1884: $$settings{text} = $text;
1.1 raeburn 1885: # print "TEXT $text\n";
1886: }
1887: }, "dtext"],
1888: end_h =>
1889: [sub {
1890: my ($tagname) = @_;
1891: pop @state;
1892: }, "tagname"],
1893: );
1894: $p->unbroken_text(1);
1895: $p->parse_file($xmlfile);
1896: $p->eof;
1.2 raeburn 1897:
1898: if (defined($$settings{text})) {
1899: if ($$settings{ishtml} eq "false") {
1900: if ($$settings{isnewline} eq "true") {
1901: $$settings{text} =~ s#\n#<br/>#g;
1902: }
1903: } else {
1904: $$settings{text} = &HTML::Entities::decode($$settings{text});
1905: }
1906: }
1907:
1908: if (@assess > 0) {
1909: foreach my $id (@assess) {
1910: $$settings{text} .= "Please use 'NAV' to locate the link to the folder of problems entitled -";
1911: foreach my $key (keys %{$$settings{startassessment}{$id}}) {
1912: # print STDERR "Quiz announcement - $id, key: $key, value: $$settings{startassessment}{$id}{$key}\n";
1913: }
1914: }
1915: }
1916:
1917: open(FILE,">$destdir/resfiles/$res.html");
1918: print FILE qq|<html>
1919: <head>
1920: <title>$$settings{title}</title>
1921: </head>
1922: <body bgcolor='#ffffff'>
1923: $$settings{text}
1924: |;
1925: print FILE qq|
1926: </body>
1927: </html>|;
1928: close(FILE);
1.1 raeburn 1929: }
1930:
1931: sub process_content {
1932: my ($res,$docroot,$destdir,$settings,$dom,$user) = @_;
1933: my $xmlfile = $docroot."/temp/".$res.".dat";
1934: my $destresdir = $destdir;
1935: $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
1936: my $filecount = 0;
1937: my @state;
1938: @{$$settings{files}} = ();
1939: my $p = HTML::Parser->new
1940: (
1941: xml_mode => 1,
1942: start_h =>
1943: [sub {
1944: my ($tagname, $attr) = @_;
1945: push @state, $tagname;
1946: if (@state eq "CONTENT MAINDATA") {
1947: %{$$settings{maindata}} = ();
1948: } elsif (@state eq "CONTENT MAINDATA TEXTCOLOR") {
1949: $$settings{maindata}{color} = $attr->{value};
1950: } elsif (@state eq "CONTENT MAINDATA FLAGS ISHTML") {
1951: $$settings{maindata}{ishtml} = $attr->{value};
1952: } elsif (@state eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {
1953: $$settings{maindata}{isnewline} = $attr->{value};
1954: } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
1955: $$settings{isavailable} = $attr->{value};
1956: } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
1957: $$settings{isfolder} = $attr->{value};
1958: } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
1959: $$settings{newwindow} = $attr->{value};
1960: } elsif ("@state" eq "CONTENT FILES") {
1961: # @{$$settings{files}} = ();
1962: } elsif ("@state" eq "CONTENT FILES FILEREF") {
1963: %{$$settings{files}[$filecount]} = ();
1964: %{$$settings{files}[$filecount]{registry}} = ();
1965: } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
1966: $$settings{files}[$filecount]{'relfile'} = $attr->{value};
1967: } elsif ("@state" eq "CONTENT FILES FILEREF MIMETYPE") {
1968: $$settings{files}[$filecount]{mimetype} = $attr->{value};
1969: } elsif ("@state" eq "CONTENT FILES FILEREF CONTENTTYPE") {
1970: $$settings{files}[$filecount]{contenttype} = $attr->{value};
1971: } elsif ("@state" eq "CONTENT FILES FILEREF FILEACTION") {
1972: $$settings{files}[$filecount]{fileaction} = $attr->{value};
1973: } elsif ("@state" eq "CONTENT FILES FILEREF PACKAGEPARENT") {
1974: $$settings{files}[$filecount]{packageparent} = $attr->{value};
1975: } elsif ("@state" eq "CONTENT FILES FILEREF LINKNAME") {
1976: $$settings{files}[$filecount]{linkname} = $attr->{value};
1977: } elsif ("@state" eq "CONTENT FILES FILEREF REGISTRY REGISTRYENTRY") {
1978: my $key = $attr->{key};
1979: $$settings{files}[$filecount]{registry}{$key} = $attr->{value};
1980: }
1981: }, "tagname, attr"],
1982: text_h =>
1983: [sub {
1984: my ($text) = @_;
1985: if ("@state" eq "CONTENT TITLE") {
1986: $$settings{title} = $text;
1987: } elsif ("@state" eq "CONTENT MAINDATA TEXT") {
1988: $$settings{maindata}{text} = $text;
1989: } elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") {
1990: $$settings{files}[$filecount]{reftext} = $text;
1991: }
1992: }, "dtext"],
1993: end_h =>
1994: [sub {
1995: my ($tagname) = @_;
1996: if ("@state" eq "CONTENT FILES FILEREF") {
1997: $filecount ++;
1998: }
1999: pop @state;
2000: }, "tagname"],
2001: );
2002: $p->unbroken_text(1);
2003: $p->parse_file($xmlfile);
2004: $p->eof;
2005: my $linktag = '';
2006: my $fontcol = '';
2007: if (@{$$settings{files}} > 0) {
2008: for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) {
2009: if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') {
2010: if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) {
2011: my $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"/>|;
2012: $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#;
2013: } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) {
2014: my $reftag = $1;
2015: my $newtag;
2016: if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) {
2017: $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
2018: if ( defined($$settings{files}[$filecount]{registry}{alttext}) ) {
2019: $newtag .= qq| alt="$$settings{files}[$filecount]{registry}{alttext}"|;
2020: }
2021: if ( defined($$settings{files}[$filecount]{registry}{alignment}) )
2022: {
2023: $newtag .= qq| align="$$settings{files}[$filecount]{registry}{alignment}"|;
2024: }
2025: if ( defined($$settings{files}[$filecount]{registry}{border}) ) {
2026: $newtag .= qq| border="$$settings{files}[$filecount]{registry}{border}"|;
2027: }
2028: $newtag .= " />";
2029: my $reftext = $$settings{files}[$filecount]{reftext};
2030: my $fname = $$settings{files}[$filecount]{'relfile'};
2031: $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
2032: # $$settings{maindata}{text} =~ s/DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
2033: $$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//;
2034: $$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/;
2035: $$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//;
2036: $$settings{maindata}{text} =~ s/\-\->//;
2037: # $$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/;
2038: # print STDERR $$settings{maindata}{text};
2039: }
2040: } else {
2041: my $filename=$$settings{files}[$filecount]{'relfile'};
2042: # print "File is $filename\n";
2043: my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
2044: # print "New filename is $newfilename\n";
2045: $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g;
2046: }
2047: } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
2048: $linktag = qq|<a href="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
2049: if ($$settings{newwindow} eq "true") {
2050: $linktag .= qq| target="$res$filecount"|;
2051: }
2052: foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {
2053: $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
2054: }
2055: $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a>|;
2056: } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') {
2057: # print "Found a package\n";
2058: }
2059: }
2060: }
2061: if (defined($$settings{maindata}{textcolor})) {
2062: $fontcol = qq|<font color="$$settings{maindata}{textcolor}">|;
2063: }
2064: if (defined($$settings{maindata}{text})) {
2065: if ($$settings{maindata}{ishtml} eq "false") {
2066: if ($$settings{maindata}{isnewline} eq "true") {
2067: $$settings{maindata}{text} =~ s#\n#<br/>#g;
2068: }
2069: } else {
2070: $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
2071: }
2072: }
2073:
2074: open(FILE,">$destdir/resfiles/$res.html");
2075: print FILE qq|<html>
2076: <head>
2077: <title>$$settings{title}</title>
2078: </head>
2079: <body bgcolor='#ffffff'>
2080: $fontcol
2081: |;
2082: unless ($$settings{title} eq '') {
2083: print FILE qq|$$settings{title}<br/><br/>\n|;
2084: }
2085: print FILE qq|
2086: $$settings{maindata}{text}
2087: $linktag|;
2088: if (defined($$settings{maindata}{textcolor})) {
2089: print FILE qq|</font>|;
2090: }
2091: print FILE qq|
2092: </body>
2093: </html>|;
2094: close(FILE);
2095: }
2096:
1.2 raeburn 2097: sub expand_angel {
1.3 ! raeburn 2098: my ($r,$uname,$udom,$fn,$page,$bb_crs,$bb_cdom,$bb_handling) = @_;
1.2 raeburn 2099: my @state = ();
2100: my @seq = "Top";
2101: my $lastitem;
2102: my $itm = '';
2103: my %resnum = ();
1.3 ! raeburn 2104: my %revitm = ();
1.2 raeburn 2105: my %title = ();
2106: my %filepath = ();
2107: my %contentscount = ("Top" => 0);
2108: my %contents = ();
2109: my %parentseq = ();
2110: my %file = ();
2111: my %type = ();
2112: my %href = ();
2113: my $identifier = '';
2114: my %resinfo = ();
2115: my $numfolders = 0;
2116: my $numpages = 0;
2117: my $docroot = $ENV{'form.newdir'};
2118: if (!-e "$docroot/temp") {
2119: mkdir "$docroot/temp";
2120: }
2121: my $newdir = '';
2122: if ($docroot =~ m|public_html/(.+)$|) {
2123: $newdir = $1;
2124: }
2125: my $dirname = "/res/$udom/$uname/$newdir";
2126: my $zipfile = '/home/'.$uname.'/public_html'.$fn;
2127: if ($fn =~ m|\.zip$|i) {
2128: open(OUTPUT, "unzip -o $zipfile -d $docroot/temp 2> /dev/null |");
2129: while (<OUTPUT>) {
2130: print "$_<br />";
2131: }
2132: close(OUTPUT);
2133: }
2134:
2135: my $xmlfile = $docroot.'/temp/imsmanifest.xml';
2136: my $p = HTML::Parser->new
2137: (
2138: xml_mode => 1,
2139: start_h =>
2140: [sub {
2141: my ($tagname, $attr) = @_;
2142: push @state, $tagname;
2143: my $num = @state - 3;
2144: my $start = $num;
2145: my $statestr = '';
2146: foreach (@state) {
2147: $statestr .= "$_ ";
2148: }
2149: if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "organization") ) {
2150: my $searchstr = "manifest organizations organization";
2151: while ($num > 0) {
2152: $searchstr .= " item";
2153: $num --;
2154: }
2155: if (("@state" eq $searchstr) && (@state > 3)) {
2156: $itm = $attr->{identifier};
1.3 ! raeburn 2157: if ($attr->{identifierref} =~ m/^res(.+)$/) {
! 2158: $resnum{$itm} = $1;
! 2159: }
! 2160: $revitm{$resnum{$itm}} = $itm;
1.2 raeburn 2161: if ($start > @seq) {
2162: unless ($lastitem eq '') {
2163: push @seq, $lastitem;
2164: unless ( defined($contents{$seq[-1]}) ) {
2165: @{$contents{$seq[-1]}} = ();
2166: }
2167: push @{$contents{$seq[-1]}},$itm;
2168: $parentseq{$itm} = $seq[-1];
2169: }
2170: }
2171: elsif ($start < @seq) {
2172: my $diff = @seq - $start;
2173: while ($diff > 0) {
2174: pop @seq;
2175: $diff --;
2176: }
2177: if (@seq) {
2178: push @{$contents{$seq[-1]}}, $itm;
2179: }
2180: } else {
2181: push @{$contents{$seq[-1]}}, $itm;
2182: }
2183: my $path;
2184: if (@seq > 1) {
2185: $path = join(',',@seq);
2186: } elsif (@seq > 0) {
2187: $path = $seq[0];
2188: }
2189: $filepath{$itm} = $path;
2190: $contentscount{$seq[-1]} ++;
2191: $lastitem = $itm;
2192: }
2193: } elsif ("@state" eq "manifest resources resource" ) {
2194: $identifier = $attr->{identifier};
1.3 ! raeburn 2195: $identifier = substr($identifier,3);
! 2196: if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
! 2197: $file{$identifier} = $1;
! 2198: }
1.2 raeburn 2199: @{$href{$identifier}} = ();
2200: } elsif ("@state" eq "manifest resources resource file") {
1.3 ! raeburn 2201: if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
! 2202: push @{$href{$identifier}},$1;
! 2203: } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
1.2 raeburn 2204: $type{$identifier} = $1;
1.3 ! raeburn 2205: }
1.2 raeburn 2206: }
2207: }, "tagname, attr"],
2208: text_h =>
2209: [sub {
2210: my ($text) = @_;
2211: if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq "organization" && $state[-1] eq "title") {
2212: $title{$itm} = $text;
2213: }
2214: }, "dtext"],
2215: end_h =>
2216: [sub {
2217: my ($tagname) = @_;
2218: pop @state;
2219: }, "tagname"],
2220: );
2221: $p->parse_file($xmlfile);
2222: $p->eof;
2223:
2224: my $topnum = 0;
2225: my $destdir = $docroot;
2226: if (!-e "$destdir") {
2227: mkdir("$destdir",0755);
2228: }
2229: if (!-e "$destdir/sequences") {
2230: mkdir("$destdir/sequences",0755);
2231: }
2232: if (!-e "$destdir/resfiles") {
2233: mkdir("$destdir/resfiles",0755);
2234: }
2235: if (!-e "$destdir/pages") {
2236: mkdir("$destdir/pages",0755);
2237: }
2238: if (!-e "$destdir/problems") {
2239: mkdir("$destdir/problems",0755);
2240: }
2241: foreach my $key (sort keys %href) {
2242: foreach my $file (@{$href{$key}}) {
1.3 ! raeburn 2243: print STDERR "File is $file, for $key\n";
! 2244: $file =~ s-\\-/-g;
! 2245: my $filepath = $file;
! 2246: if (!-e "$destdir/resfiles/$key") {
! 2247: mkdir("$destdir/resfiles/$key",0755);
! 2248: }
! 2249: while ($filepath =~ m-(\w+)/(.+)-) {
! 2250: $filepath = $2;
! 2251: if (!-e "$destdir/resfiles/$key/$1") {
! 2252: mkdir("$destdir/resfiles/$key/$1",0755);
1.2 raeburn 2253: }
2254: }
1.3 ! raeburn 2255: system("cp $docroot/temp/_assoc/$key/$file $destdir/resfiles/$key/$file");
1.2 raeburn 2256: }
2257: }
2258:
2259:
1.3 ! raeburn 2260: # ANGEL types FILE FOLDER PAGE LINK MESSAGE FORM QUIZ BOARD
! 2261: my $currboard = '';
! 2262: my @boards = ();
! 2263: my %messages = ();
! 2264: my @timestamp = ();
! 2265: my %boardnum = ();
! 2266: my $board_id = time;
! 2267: my $board_count = 0;
1.2 raeburn 2268: foreach my $key (sort keys %type) {
2269: if ($type{$key} eq "BOARD") {
1.3 ! raeburn 2270: push @boards, $key;
! 2271: $boardnum{$revitm{$key}} = $board_count ;
! 2272: $currboard = $key;
! 2273: @{$messages{$key}} = ();
! 2274: $timestamp[$board_count] = $board_id;
! 2275: $board_id ++;
! 2276: $board_count ++;
! 2277: } elsif ($type{$key} eq "MESSAGE") {
! 2278: push @{$messages{$currboard}}, $key;
! 2279: } elsif ($type{$key} eq "FILE" || $type{$key} eq "FOLDER" || $type{$key} eq "PAGE" || $type{$key} eq "LINK") {
1.2 raeburn 2280: %{$resinfo{$key}} = ();
2281: } elsif ($type{$key} eq "QUIZ") {
2282: %{$resinfo{$key}} = ();
1.3 ! raeburn 2283: # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
1.2 raeburn 2284: } elsif ($type{$key} eq "FORM") {
2285: %{$resinfo{$key}} = ();
1.3 ! raeburn 2286: # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$resinfo{$key}});
1.2 raeburn 2287: }
2288: }
2289:
1.3 ! raeburn 2290: my $longcrs = '';
! 2291: if ($bb_crs =~ m/^(\d)(\d)(\d)/) {
! 2292: $longcrs = $1.'/'.$2.'/'.$3.'/'.$bb_crs;
! 2293: }
! 2294: for (my $i=0; $i<@boards; $i++) {
! 2295: my %msgidx = ();
! 2296: my $forumtext = '';
! 2297: my $boardname = 'bulletinpage_'.$timestamp[$i];
! 2298: my $forumfile = "$destdir/resfiles/$boards[$i]/$file{$boards[$i]}";
! 2299: my @state = ();
! 2300: my $p = HTML::Parser->new
! 2301: (
! 2302: xml_mode => 1,
! 2303: start_h =>
! 2304: [sub {
! 2305: my ($tagname, $attr) = @_;
! 2306: push @state, $tagname;
! 2307: }, "tagname, attr"],
! 2308: text_h =>
! 2309: [sub {
! 2310: my ($text) = @_;
! 2311: if ("@state" eq "html body div div") {
! 2312: $forumtext = $text;
! 2313: }
! 2314: }, "dtext"],
! 2315: end_h =>
! 2316: [sub {
! 2317: my ($tagname) = @_;
! 2318: pop @state;
! 2319: }, "tagname"],
! 2320: );
! 2321: $p->parse_file($xmlfile);
! 2322: $p->eof;
! 2323:
! 2324: my %boardinfo = (
! 2325: 'aaa_title' => $title{$revitm{$boards[$i]}},
! 2326: 'bbb_content' => $forumtext,
! 2327: 'ccc_webreferences' => '',
! 2328: 'uploaded.lastmodified' => time,
! 2329: );
! 2330: my $msgcount = 0;
! 2331:
! 2332: my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$bb_cdom,$bb_crs);
! 2333: if ($bb_handling eq 'importall') {
! 2334: foreach my $msg_id (@{$messages{$boards[$i]}}) {
! 2335: $msgcount ++;
! 2336: $msgidx{$msg_id} = $msgcount;
! 2337: my %contrib = (
! 2338: 'sendername' => 'Username not recorded',
! 2339: 'senderdomain' => $bb_cdom,
! 2340: 'screenname' => '',
! 2341: 'message' => $title{$revitm{$msg_id}}
! 2342: );
! 2343: unless ( $parentseq{$revitm{$msg_id}} eq $revitm{$boards[$i]} ) {
! 2344: $contrib{replyto} = $msgidx{$resnum{$parentseq{$revitm{$msg_id}}}};
! 2345: }
! 2346: if ( @{$href{$msg_id}} > 1 ) {
! 2347: my $newurl = '';
! 2348: foreach my $file (@{$href{$msg_id}}) {
! 2349: unless ($file eq 'pg'.$msg_id.'.htm') {
! 2350: $newurl = $msg_id.$file;
! 2351: unless ($longcrs eq '') {
! 2352: if (!-e "/home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles") {
! 2353: mkdir("/home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles",0755);
! 2354: }
! 2355: if (!-e "/home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles/$newurl") {
! 2356: system("cp $destdir/resfiles/$file /home/httpd/lonUsers/$bb_cdom/$longcrs/userfiles/$newurl");
! 2357: }
! 2358: $contrib{attachmenturl} = '/uploaded/'.$bb_cdom.'/'.$bb_crs.'/'.$newurl;
! 2359: }
! 2360: }
! 2361: }
! 2362: }
! 2363: my $xmlfile = "$destdir/resfiles/$msg_id/$file{$msg_id}";
! 2364: &angel_message($msg_id,\%contrib,$xmlfile);
! 2365: unless ($file{$msg_id} eq '') {
! 2366: unlink($xmlfile);
! 2367: }
! 2368: my $symb = 'bulletin___'.$timestamp[$i].'___adm/wrapper/adm/'.$bb_cdom.'/'.$uname.'/'.$timestamp[$i].'/bulletinboard';
! 2369: my $postresult = &addposting($symb,\%contrib,$bb_cdom,$bb_crs);
! 2370: }
! 2371: }
! 2372: }
! 2373:
! 2374: my @resources = sort keys %resnum;
! 2375: unshift @resources, "Top";
! 2376: $resnum{'Top'} = 'toplevel';
! 2377: $type{'toplevel'} = "FOLDER";
! 2378:
1.2 raeburn 2379: my %pagecount = ();
2380: my %pagecontents = ();
2381: my %pageflag = ();
2382: my %seqflag = ();
2383: my %seqcount = ();
1.3 ! raeburn 2384: my %boardflag = ();
! 2385: my %boardcount = ();
1.2 raeburn 2386:
1.3 ! raeburn 2387: foreach my $key (@resources) {
! 2388: print STDERR "Key is $key, resnum is $resnum{$key}, type is $type{$resnum{$key}}\n";
1.2 raeburn 2389: $pageflag{$key} = 0;
2390: $seqflag{$key} = 0;
2391: $seqcount{$key} = 0;
2392: $pagecount{$key} = -1;
1.3 ! raeburn 2393: $boardflag{$key} = 0;
! 2394: $boardcount{$key} = 0;
! 2395: my $src ="";
! 2396: my $next_id = 1;
! 2397: my $curr_id = 0;
! 2398: if ($type{$resnum{$key}} eq "FOLDER") {
! 2399: open(LOCFILE,">$destdir/sequences/$key.sequence");
! 2400: print LOCFILE "<map>\n";
! 2401: if ($contentscount{$key} == 0) {
! 2402: print LOCFILE qq|<resource id="1" src="" type="start"></resource>
1.2 raeburn 2403: <link from="1" to="2" index="1"></link>
2404: <resource id="2" src="" type="finish"></resource>\n|;
1.3 ! raeburn 2405: } else {
! 2406: if ($type{$resnum{$contents{$key}[0]}} eq "FOLDER") {
! 2407: $src = 'sequences/'.$contents{$key}[0].".sequence";
! 2408: $pageflag{$key} = 0;
! 2409: $seqflag{$key} = 1;
! 2410: $seqcount{$key} ++;
! 2411: } elsif ($type{$resnum{$contents{$key}[0]}} eq "BOARD") {
! 2412: $src = "/adm/$bb_cdom/$uname/$timestamp[$boardnum{$key}]/bulletinboard";
! 2413: $pageflag{$key} = 0;
! 2414: $boardflag{$key} = 1;
! 2415: $boardcount{$key} ++;
! 2416: } elsif ($type{$resnum{$contents{$key}[0]}} ne "MESSAGE") {
! 2417: if ($pageflag{$key}) {
! 2418: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[0];
1.2 raeburn 2419: } else {
1.3 ! raeburn 2420: $pagecount{$key} ++;
! 2421: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
! 2422: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[0]");
! 2423: $seqflag{$key} = 0;
1.2 raeburn 2424: }
1.3 ! raeburn 2425: }
! 2426: unless ($pageflag{$key}) {
! 2427: print LOCFILE qq|<resource id="1" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[0]}" type="start"|;
! 2428: unless ($seqflag{$key} || $boardflag{$key}) {
! 2429: $pageflag{$key} = 1;
1.2 raeburn 2430: }
1.3 ! raeburn 2431: }
! 2432: if ($contentscount{$key} == 1) {
! 2433: print LOCFILE qq|></resource>
1.2 raeburn 2434: <link from="1" to="2" index="1"></link>
2435: <resource id="2" src="" type="finish"></resource>\n|;
1.3 ! raeburn 2436: } else {
! 2437: if ($contentscount{$key} > 2 ) {
! 2438: for (my $i=1; $i<$contentscount{$key}-1; $i++) {
! 2439: if ($type{$resnum{$contents{$key}[$i]}} eq "FOLDER") {
! 2440: $src = 'sequences/'.$contents{$key}[$i].".sequence";
! 2441: $pageflag{$key} = 0;
! 2442: $seqflag{$key} = 1;
! 2443: $seqcount{$key} ++;
! 2444: } elsif ($type{$resnum{$contents{$key}[0]}} eq "BOARD") {
! 2445: $src = "/adm/$bb_cdom/$uname/$timestamp[$boardnum{$key}]/bulletinboard";
! 2446: $pageflag{$key} = 0;
! 2447: $boardflag{$key} = 1;
! 2448: $boardcount{$key} ++;
! 2449: } elsif ($type{$resnum{$contents{$key}[0]}} ne "MESSAGE") {
! 2450: if ($pageflag{$key}) {
! 2451: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$i];
1.2 raeburn 2452: } else {
1.3 ! raeburn 2453: $pagecount{$key} ++;
! 2454: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
! 2455: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$i]");
! 2456: $seqflag{$key} = 0;
1.2 raeburn 2457: }
1.3 ! raeburn 2458: }
! 2459: unless ($pageflag{$key}) {
! 2460: $curr_id ++;
! 2461: $next_id ++;
! 2462: print LOCFILE qq|></resource>
1.2 raeburn 2463: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
2464: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$i]}"|;
1.3 ! raeburn 2465: unless ($seqflag{$key} || $boardflag{$key}) {
! 2466: $pageflag{$key} = 1;
1.2 raeburn 2467: }
2468: }
2469: }
1.3 ! raeburn 2470: }
! 2471: if ($type{$resnum{$contents{$key}[$contentscount{$key}-1]}} eq "FOLDER") {
! 2472: $src = 'sequences/'.$contents{$key}[$contentscount{$key}-1].".sequence";
! 2473: $pageflag{$key} = 0;
! 2474: $seqflag{$key} = 1;
! 2475: } elsif ($type{$resnum{$contents{$key}[0]}} eq "BOARD") {
! 2476: $src = "/adm/$bb_cdom/$uname/$timestamp[$boardnum{$key}]/bulletinboard";
! 2477: $pageflag{$key} = 0;
! 2478: $boardflag{$key} = 1;
! 2479: } elsif ($type{$resnum{$contents{$key}[0]}} ne "MESSAGE") {
! 2480: if ($pageflag{$key}) {
! 2481: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$contentscount{$key}-1];
1.2 raeburn 2482: } else {
1.3 ! raeburn 2483: $pagecount{$key} ++;
! 2484: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
! 2485: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$contentscount{$key}-1]");
1.2 raeburn 2486: }
1.3 ! raeburn 2487: }
! 2488: if ($pageflag{$key}) {
! 2489: if ($seqcount{$key} + $pagecount{$key} + $boardcount{$key} +1 == 1) {
! 2490: print LOCFILE qq|></resource>
1.2 raeburn 2491: <link from="1" index="1" to="2">
2492: <resource id ="2" src="" title="" type="finish"></resource>\n|;
2493: } else {
1.3 ! raeburn 2494: print LOCFILE qq| type="finish"></resource>\n|;
! 2495: }
! 2496: } else {
! 2497: $curr_id ++;
! 2498: $next_id ++;
! 2499: print LOCFILE qq|></resource>
1.2 raeburn 2500: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
2501: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$contentscount{$key}-1]}" type="finish"></resource>\n|;
2502: }
2503: }
2504: }
1.3 ! raeburn 2505: print LOCFILE "</map>\n";
! 2506: close(LOCFILE);
! 2507: }
1.2 raeburn 2508: }
2509:
2510: foreach my $key (sort keys %pagecontents) {
2511: for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
2512: my $filestem = "/res/$udom/$uname/$newdir";
2513: my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
2514: open(PAGEFILE,">$filename");
2515: print PAGEFILE qq|<map>
2516: <resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][0]}.html" id="1" type="start" title="$title{$pagecontents{$key}[$i][0]}"></resource>
2517: <link to="2" index="1" from="1">\n|;
2518: if (@{$pagecontents{$key}[$i]} == 1) {
2519: print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>|;
2520: } elsif (@{$pagecontents{$key}[$i]} == 2) {
2521: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][1]}.html" id="2" type="finish" title="$title{$pagecontents{$key}[$i][1]}"></resource>|;
2522: } else {
2523: for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
2524: my $curr_id = $j+1;
2525: my $next_id = $j+2;
2526: my $resource = $filestem.'/resfiles/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html';
2527: print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$title{$pagecontents{$key}[$i][$j]}"></resource>
2528: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
2529: }
2530: my $final_id = @{$pagecontents{$key}[$i]};
2531: 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|;
2532: }
2533: print PAGEFILE "</map>";
2534: close(PAGEFILE);
2535: }
2536: }
1.3 ! raeburn 2537: # system(" rm -r $docroot/temp");
! 2538: }
! 2539:
! 2540: sub angel_message {
! 2541: my ($msg_id,$contrib,$xmlfile) = @_;
! 2542: my @state = ();
! 2543: my $p = HTML::Parser->new
! 2544: (
! 2545: xml_mode => 1,
! 2546: start_h =>
! 2547: [sub {
! 2548: my ($tagname, $attr) = @_;
! 2549: push @state, $tagname;
! 2550: }, "tagname, attr"],
! 2551: text_h =>
! 2552: [sub {
! 2553: my ($text) = @_;
! 2554: if ("@state" eq "html body table tr td div small span") {
! 2555: $$contrib{'plainname'} = $text;
! 2556: } elsif ("@state" eq "html body div div") {
! 2557: $$contrib{'message'} .= '<br /><br />'.$text;
! 2558: }
! 2559: }, "dtext"],
! 2560: end_h =>
! 2561: [sub {
! 2562: my ($tagname) = @_;
! 2563: pop @state;
! 2564: }, "tagname"],
! 2565: );
! 2566: $p->parse_file($xmlfile);
! 2567: $p->eof;
1.2 raeburn 2568: }
2569:
2570: sub get_ccroles {
2571: my ($uname,$dom,$crsentry) = @_;
2572: my %roles = ();
2573: unless ($uname eq '') {
2574: %roles = &Apache::lonnet::dump('roles',$dom,$uname);
2575: }
2576: my $iter = 0;
2577: my @codes = ();
2578: my %courses = ();
2579: my @crslist = ();
2580: my %descrip =();
2581: foreach my $key (keys %roles ) {
2582: if ($key =~ m/^\/(\w+)\/(\w+)_cc$/) {
2583: my $cdom = $1;
2584: my $crs = $2;
2585: my $role_end = 0;
2586: my $role_start = 0;
2587: my $active_chk = 1;
2588: if ( $roles{$key} =~ m/^cc_(\d+)/ ) {
2589: $role_end = $1;
2590: if ( $roles{$key} =~ m/^cc_($role_end)_(\d+)$/ )
2591: {
2592: $role_start = $2;
2593: }
2594: }
2595: if ($role_start > 0) {
2596: if (time < $role_start) {
2597: $active_chk = 0;
2598: }
2599: }
2600: if ($role_end > 0) {
2601: if (time > $role_end) {
2602: $active_chk = 0;
2603: }
2604: }
2605: if ($active_chk) {
2606: my $currcode = '';
2607: my %settings = &Apache::lonnet::get('environment',['internal.coursecode','description'],$cdom,$crs);
2608: if (defined($settings{'description'}) ) {
2609: $descrip{$crs} = $settings{'description'};
2610: } else {
2611: $descrip{$crs} = 'Unknown';
2612: }
2613: if (defined($settings{'internal.coursecode'}) ) {
2614: $currcode = $settings{'internal.coursecode'};
2615: if ($currcode eq '') {
2616: $currcode = "____".$iter;
2617: $iter ++;
2618: }
2619: } else {
2620: $currcode = "____".$iter;
2621: $iter ++;
2622: }
2623: unless (grep/^$currcode$/,@codes) {
2624: push @codes,$currcode;
2625: @{$courses{$currcode}} = ();
2626: }
2627: push @{$courses{$currcode}}, $cdom.'/'.$crs;
2628: }
2629: }
2630: }
2631: foreach my $code (sort @codes) {
2632: foreach my $crsdom (@{$courses{$code}}) {
2633: my ($cdom,$crs) = split/\//,$crsdom;
2634: my $showcode = '';
2635: unless ($code =~m/^____\d+$/) { $showcode = $code; }
2636: $$crsentry{$crsdom} = $showcode.':'.$descrip{$crs};
2637: push @crslist, $crsdom;
2638: }
2639: }
2640: return @crslist;
2641: }
1.1 raeburn 2642:
2643: # ---------------------------------------------------------------- Main Handler
2644: sub handler {
2645: my $r=shift;
2646: my $uname;
2647: my $udom;
2648: my $javascript = '';
2649: my $page_name = '';
2650: my $current_page = '';
2651: my $loadentries = '';
2652: my $qcount = '';
2653: #
2654: # phase two: re-attach user
2655: #
2656: if ($ENV{'form.uploaduname'}) {
2657: $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
2658: $ENV{'form.filename'};
2659: }
2660: ($uname,$udom)=
2661: &Apache::loncacc::constructaccess($ENV{'form.filename'},
2662: $r->dir_config('lonDefDomain'));
2663: unless (($uname) && ($udom)) {
2664: $r->log_reason($uname.' at '.$udom.
2665: ' trying to publish file '.$ENV{'form.filename'}.
2666: ' - not authorized',
2667: $r->filename);
2668: return HTTP_NOT_ACCEPTABLE;
2669: }
2670:
2671: my $fn;
2672: if ($ENV{'form.filename'}) {
2673: $fn=$ENV{'form.filename'};
2674: $fn=~s/^http\:\/\/[^\/]+\///;
2675: $fn=~s/^\///;
2676: $fn=~s/(\~|priv\/)(\w+)//;
2677: $fn=~s/\/+/\//g;
2678: } else {
2679: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
2680: ' unspecified filename for upload', $r->filename);
2681: return HTTP_NOT_FOUND;
2682: }
2683: my $pathname = &File::Basename::dirname($fn);
2684: my $fullpath = '/priv/'.$uname.$pathname;
2685: unless ($pathname eq '/') {
2686: $fullpath .= '/';
2687: }
2688: my $loadentries = '';
2689: # ----------------------------------------------------------- Start page output
2690: &Apache::loncommon::content_type($r,'text/html');
2691: $r->send_http_header;
2692:
2693: if ($ENV{'form.phase'} eq 'three') {
2694: $current_page = &display_control();
1.3 ! raeburn 2695: my @PAGES = ('ChooseDir','Confirmation');
1.1 raeburn 2696: $page_name = $PAGES[$current_page];
2697:
2698: if ($page_name eq 'ChooseDir') {
1.2 raeburn 2699: &jscript_zero($fullpath,\$javascript,$uname,$udom);
1.1 raeburn 2700: } elsif ($page_name eq 'Confirmation') {
1.3 ! raeburn 2701: # &jscript_two(\$javascript,$uname);
1.1 raeburn 2702: }
2703: } elsif ($ENV{'form.phase'} eq 'two') {
1.2 raeburn 2704: &jscript_zero($fullpath,\$javascript,$uname,$udom);
1.1 raeburn 2705: }
2706: $r->print("<html><head><title>LON-CAPA Construction Space</title><script type=\"text/javascript\">\n//<!--\n$javascript\n// --></script>\n</head>");
2707:
2708: $r->print(&Apache::loncommon::bodytag('Upload IMS package to Construction Space',undef,$loadentries));
2709:
2710: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
2711: $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
2712: &mt(' at ').$udom.'</font></h3>');
2713: }
2714:
2715: if ($ENV{'form.phase'} eq 'three') {
1.2 raeburn 2716: my $bb_crs = '';
2717: my $bb_cdom = '';
2718: my $bb_handling = '';
1.3 ! raeburn 2719: my $source = $ENV{'form.source'};
1.2 raeburn 2720: if ( defined($ENV{'form.bb_crs'}) ) {
2721: ($bb_cdom,$bb_crs) = split/\//,$ENV{'form.bb_crs'};
2722: }
2723: if ( defined($ENV{'form.bb_handling'}) ) {
2724: $bb_handling = $ENV{'form.bb_handling'};
2725: }
2726: my $users_crs = '';
2727: my $users_cdom = '';
2728: my $users_handling = '';
2729: if ( defined($ENV{'form.user_crs'}) ) {
2730: ($users_cdom,$users_crs) = split/\//,$ENV{'form.user_crs'};
2731: }
2732: if ( defined($ENV{'form.user_handling'}) ) {
2733: $users_handling = $ENV{'form.user_handling'};
2734: }
2735: my ($totseq,$totpage,$totprob);
1.3 ! raeburn 2736: print STDERR "Page name is $page_name\n";
! 2737: if ($page_name eq 'ChooseDir') {
! 2738: &display_zero ($r,$uname,$fn,$current_page,$fullpath);
! 2739: } elsif ($page_name eq 'Confirmation') {
! 2740: ($totseq,$totpage,$totprob) = &expand_bb5 ($r,$uname,$udom,$fn,$current_page,$bb_crs,$bb_cdom,$bb_handling,$users_crs,$users_cdom,$users_handling) if $source eq 'bb5';
! 2741: ($totseq,$totpage,$totprob) = &expand_angel ($r,$uname,$udom,$fn,$current_page,$bb_crs,$bb_cdom,$bb_handling) if $source eq 'angel';
! 2742: &expand_webct ($r,$uname,$udom,$fn,$current_page) if $source eq 'webct';
! 2743: }
1.2 raeburn 2744: $r->print("<h3>Step 3: Publish your new LON-CAPA materials</h3>");
2745: $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");
1.1 raeburn 2746:
2747: } elsif ($ENV{'form.phase'} eq 'two') {
2748: my $flag = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'imsimport');
2749: if ($flag eq 'ok') {
2750: my $current_page = 0;
1.2 raeburn 2751: &display_zero($r,$uname,$fn,$current_page,$fullpath);
1.1 raeburn 2752: }
2753: } else {
2754: &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'imsimport');
2755: }
2756: $r->print('</body></html>');
2757: return OK;
2758: }
2759: 1;
2760: __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