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