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