Annotation of loncom/imspackages/imsprocessor.pm, revision 1.8
1.1 raeburn 1: package Apache::imsprocessor;
2:
3: use Apache::lonnet;
4: use LONCAPA::Configuration;
1.2 raeburn 5: use strict;
1.3 raeburn 6:
7: sub ims_config {
8: my ($areas,$cmsmap,$areaname) = @_;
9: @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users");
10: %{$$cmsmap{bb5}} = (
11: announce => 'resource/x-bb-announcement',
12: board => 'resource/x-bb-discussionboard',
13: doc => 'resource/x-bb-document',
14: extlink => 'resource/x-bb-externallink',
15: pool => 'assessment/x-bb-pool',
16: quiz => 'assessment/x-bb-quiz',
17: staff => 'resource/x-bb-staffinfo',
18: survey => 'assessment/x-bb-survey',
19: users => 'course/x-bb-user',
20: );
21:
22: %{$$cmsmap{angel}} = (
23: board => 'BOARD',
24: extlink => 'LINK',
25: msg => 'MESSAGE',
26: quiz => 'QUIZ',
27: survey => 'FORM',
28: );
29:
30: @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
31:
32:
33: %{$areaname} = (
34: announce => 'Announcements',
35: board => 'Discussion Boards',
36: doc => 'Documents, pages, and folders',
37: extlink => 'Links to external sites',
38: pool => 'Question pools',
39: quiz => 'Quizzes',
40: staff => 'Staff information',
41: survey => 'Surveys',
42: users => 'Enrollment',
43: );
44:
45: }
1.1 raeburn 46:
47: sub create_tempdir {
1.3 raeburn 48: my ($context,$pathinfo,$timenow) = @_;
1.1 raeburn 49: my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
50: my $tempdir;
1.3 raeburn 51: if ($context eq 'DOCS') {
1.1 raeburn 52: $tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
53: if (!-e "$tempdir") {
1.2 raeburn 54: mkdir("$tempdir",0770);
55: }
56: $tempdir .= '/'.$timenow;
57: if (!-e "$tempdir") {
58: mkdir("$tempdir",0770);
59: }
1.3 raeburn 60: } elsif ($context eq "CSTR") {
1.1 raeburn 61: if (!-e "$pathinfo/temp") {
1.2 raeburn 62: mkdir("$pathinfo/temp",0770);
1.1 raeburn 63: }
64: $tempdir = $pathinfo.'/temp';
65: }
66: return $tempdir;
67: }
68:
1.3 raeburn 69: sub uploadzip {
70: my ($context,$tempdir,$source) = @_;
71: my $fname;
72: if ($context eq 'DOCS') {
73: $fname=$ENV{'form.uploadname.filename'};
74: # Replace Windows backslashes by forward slashes
75: $fname=~s/\\/\//g;
76: # Get rid of everything but the actual filename
77: $fname=~s/^.*\/([^\/]+)$/$1/;
78: # Replace spaces by underscores
79: $fname=~s/\s+/\_/g;
80: # Replace all other weird characters by nothing
81: $fname=~s/[^\w\.\-]//g;
82: # See if there is anything left
83: unless ($fname) { return 'error: no uploaded file'; }
84: # Save the file
85: chomp($ENV{'form.uploadname'});
86: open(my $fh,'>'.$tempdir.'/'.$fname);
87: print $fh $ENV{'form.uploadname'};
88: close($fh);
89: } elsif ($context eq 'CSTR') {
90: if ($source =~ m/\/([^\/]+)$/) {
91: $fname = $1;
92: my $destination = $tempdir.'/'.$fname;
93: rename($source,$destination);
94: }
95: }
96: return $fname;
97: }
98:
1.1 raeburn 99: sub expand_zip {
100: my ($tempdir,$filename) = @_;
101: my $zipfile = "$tempdir/$filename";
102: if ($filename =~ m|\.zip$|i) {
103: open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null |");
104: close(OUTPUT);
105: } else {
106: return 'nozip';
107: }
108: if ($filename =~ m|\.zip$|i) {
109: unlink($zipfile);
110: }
111: return 'ok';
112: }
113:
114: sub process_manifest {
1.2 raeburn 115: my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo) = @_;
1.1 raeburn 116: my %toc = (
117: bb5 => 'tableofcontents',
118: angel => 'organization',
119: );
1.2 raeburn 120: my %contents = ();
1.1 raeburn 121: my @state = ();
122: my $itm = '';
123: my $identifier = '';
124: my @seq = "Top";
125: my $lastitem;
1.2 raeburn 126: %{$$items{'Top'}} = (
127: contentscount => 0,
128: resnum => 'toplevel',
129: );
1.3 raeburn 130: %{$$resources{'toplevel'}} = (
131: revitm => 'Top'
132: );
1.2 raeburn 133:
134: if ($cms eq 'angel') {
135: $$resources{'toplevel'}{type} = "FOLDER";
136: } elsif ($cms eq 'bb5') {
137: $$resources{'toplevel'}{type} = 'resource/x-bb-document';
138: }
139:
1.1 raeburn 140:
141: unless (-e "$tempdir/imsmanifest.xml") {
142: return 'nomanifest';
143: }
144:
145: my $xmlfile = $tempdir.'/imsmanifest.xml';
146: my $p = HTML::Parser->new
147: (
148: xml_mode => 1,
149: start_h =>
150: [sub {
151: my ($tagname, $attr) = @_;
152: push @state, $tagname;
153: my $num = @state - 3;
154: my $start = $num;
155: my $statestr = '';
156: foreach (@state) {
157: $statestr .= "$_ ";
158: }
159: if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {
160: my $searchstr = "manifest organizations $toc{$cms}";
161: while ($num > 0) {
162: $searchstr .= " item";
163: $num --;
164: }
165: if (("@state" eq $searchstr) && (@state > 3)) {
166: $itm = $attr->{identifier};
167: %{$$items{$itm}} = ();
168: $$items{$itm}{contentscount} = 0;
169: if ($cms eq 'bb5') {
170: $$items{$itm}{resnum} = $attr->{identifierref};
171: $$items{$itm}{title} = $attr->{title};
172: } elsif ($cms eq 'angel') {
173: if ($attr->{identifierref} =~ m/^res(.+)$/) {
174: $$items{$itm}{resnum} = $1;
175: }
176: }
1.2 raeburn 177: unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
178: %{$$resources{$$items{$itm}{resnum}}} = ();
1.1 raeburn 179: }
180: $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
181:
182: if ($start > @seq) {
183: unless ($lastitem eq '') {
184: push @seq, $lastitem;
185: unless ( defined($contents{$seq[-1]}) ) {
186: @{$contents{$seq[-1]}} = ();
187: }
188: push @{$contents{$seq[-1]}},$itm;
189: $$items{$itm}{parentseq} = $seq[-1];
190: }
191: }
192: elsif ($start < @seq) {
193: my $diff = @seq - $start;
194: while ($diff > 0) {
195: pop @seq;
196: $diff --;
197: }
198: if (@seq) {
199: push @{$contents{$seq[-1]}}, $itm;
200: }
201: } else {
202: push @{$contents{$seq[-1]}}, $itm;
203: }
204: my $path;
205: if (@seq > 1) {
206: $path = join(',',@seq);
207: } elsif (@seq > 0) {
208: $path = $seq[0];
209: }
210: $$items{$itm}{filepath} = $path;
1.2 raeburn 211: if ($cms eq 'bb5') {
212: if ($$items{$itm}{filepath} eq 'Top') {
213: $$items{$itm}{resnum} = $itm;
214: $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
215: $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
216: $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
217: }
218: }
1.1 raeburn 219: $$items{$seq[-1]}{contentscount} ++;
220: $lastitem = $itm;
221: }
222: } elsif ("@state" eq "manifest resources resource" ) {
223: $identifier = $attr->{identifier};
224: if ($cms eq 'bb5') {
225: $$resources{$identifier}{file} = $attr->{file};
226: $$resources{$identifier}{type} = $attr->{type};
227: } elsif ($cms eq 'angel') {
228: $identifier = substr($identifier,3);
229: if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
230: $$resources{$identifier}{file} = $1;
231: }
232: }
233: @{$$hrefs{$identifier}} = ();
234: } elsif ("@state" eq "manifest resources resource file") {
235: if ($cms eq 'bb5') {
236: push @{$$hrefs{$identifier}},$attr->{href};
237: } elsif ($cms eq 'angel') {
238: if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
239: push @{$$hrefs{$identifier}},$1;
240: } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
241: $$resources{$identifier}{type} = $1;
242: }
243: }
244: }
245: }, "tagname, attr"],
246: text_h =>
247: [sub {
248: my ($text) = @_;
1.4 raeburn 249: if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq "organization" && $state[-1] eq "title") {
250: if ($cms eq 'angel') {
251: $$items{$itm}{title} = $text;
252: }
253: }
1.1 raeburn 254: }, "dtext"],
255: end_h =>
256: [sub {
257: my ($tagname) = @_;
258: pop @state;
259: }, "tagname"],
260: );
261: $p->parse_file($xmlfile);
262: $p->eof;
263:
264: foreach my $itm (keys %contents) {
265: @{$$items{$itm}{contents}} = @{$contents{$itm}};
266: }
267: return 'ok' ;
268: }
269:
270: sub target_resources {
1.2 raeburn 271: my ($resources,$oktypes,$targets) = @_;
1.1 raeburn 272: foreach my $key (keys %{$resources}) {
273: if ( defined($$oktypes{$$resources{$key}{type}}) ) {
274: push @{$targets}, $key;
275: }
276: }
277: return;
278: }
279:
280: sub copy_resources {
1.2 raeburn 281: my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$chome,$destdir,$timenow) = @_;
1.1 raeburn 282: if ($context eq 'DOCS') {
283: foreach my $key (sort keys %{$hrefs}) {
284: if (grep/^$key$/,@{$targets}) {
1.2 raeburn 285: %{$$url{$key}} = ();
1.1 raeburn 286: foreach my $file (@{$$hrefs{$key}}) {
1.2 raeburn 287: my $source = $tempdir.'/'.$key.'/'.$file;
288: my $filename = '';
1.3 raeburn 289: my $fpath = $timenow.'/resfiles/'.$key.'/';
290: if ($cms eq 'angel') {
291: if ($file eq 'pg'.$key.'.htm') {
292: next;
1.1 raeburn 293: }
294: }
1.3 raeburn 295: $file =~ s-\\-/-g;
296: $file = $fpath.$file;
297: my $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$file,$source);
1.1 raeburn 298: }
299: }
300: }
301: } elsif ($context eq 'CSTR') {
302: if (!-e "$destdir/resfiles") {
1.2 raeburn 303: mkdir("$destdir/resfiles",0770);
1.1 raeburn 304: }
1.2 raeburn 305: foreach my $key (sort keys %{$hrefs}) {
306: foreach my $file (@{$$hrefs{$key}}) {
307: $file =~ s-\\-/-g;
308: if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') ) {
309: if (!-e "$destdir/resfiles/$key") {
310: mkdir("$destdir/resfiles/$key",0770);
1.1 raeburn 311: }
1.2 raeburn 312:
1.1 raeburn 313: my $filepath = $file;
1.2 raeburn 314: my $front = '';
1.1 raeburn 315: while ($filepath =~ m-(\w+)/(.+)-) {
1.2 raeburn 316: $front .= $1.'/';
1.1 raeburn 317: $filepath = $2;
1.2 raeburn 318: my $fulldir = "$destdir/resfiles/$key/$front";
319: chop($fulldir);
320: if (!-e "$fulldir") {
321: mkdir("$fulldir",0770);
322: }
323: }
324: if ($cms eq 'angel') {
325: rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
326: } elsif ($cms eq 'bb5') {
327: rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
328: }
329: }
330: }
331: }
332: }
333: }
334:
1.3 raeburn 335: sub process_coursefile {
336: my ($crs,$cdom,$chome,$file,$source)=@_;
337: my $fetchresult = '';
338: my $fpath = '';
339: my $fname = $file;
340: ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/])$/);
341: $fpath=$cdom.'/'.$crs.'/'.$fpath;
342: my $filepath=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';
343: unless ($fpath eq '') {
344: my @parts=split(/\//,$fpath);
345: foreach my $part (@parts) {
346: $filepath.= '/'.$part;
347: if ((-e $filepath)!=1) {
348: mkdir($filepath,0777);
349: }
350: }
351: }
352: if ($source eq '') {
353: $fetchresult eq 'no source file provided';
354: } else {
355: my $destination = $filepath.'/'.$fname;
356: rename($source,$destination);
357: $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome);
358: unless ($fetchresult eq 'ok') {
359: &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$fname.' to host '.$chome.': '.$fetchresult);
360: }
361: }
362: return $fetchresult;
363: }
364:
1.2 raeburn 365: sub process_resinfo {
1.7 raeburn 366: my ($cms,$context,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles) = @_;
1.2 raeburn 367: my $board_id = time;
368: my $board_count = 0;
369: my $announce_handling = 'include';
370: my $longcrs = '';
371: if ($crs =~ m/^(\d)(\d)(\d)/) {
372: $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
373: }
374: if ($cms eq 'angel') {
375: my $currboard = '';
376: foreach my $key (sort keys %{$resources}) {
377: if ($$resources{$key}{type} eq "BOARD") {
378: push @{$boards}, $key;
379: $$boardnum{$$resources{$key}{revitm}} = $board_count;
380: $currboard = $key;
381: @{$$messages{$key}} = ();
382: $$timestamp[$board_count] = $board_id;
383: $board_id ++;
384: $board_count ++;
385: } elsif ($$resources{$key}{type} eq "MESSAGE") {
386: push @{$$messages{$currboard}}, $key;
387: } elsif ($$resources{$key}{type} eq "PAGE" || $$resources{$key}{type} eq "LINK") {
388: %{$$resinfo{$key}} = ();
389: &angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
390: } elsif ($$resources{$key}{type} eq "QUIZ") {
391: %{$$resinfo{$key}} = ();
1.3 raeburn 392: push @{$quizzes}, $key;
1.2 raeburn 393: # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
394: } elsif ($$resources{$key}{type} eq "FORM") {
395: %{$$resinfo{$key}} = ();
1.3 raeburn 396: push @{$surveys}, $key;
1.2 raeburn 397: # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
398: } elsif ($$resources{$key}{type} eq "DROPBOX") {
399: %{$$resinfo{$key}} = ();
400: }
401: }
402: } elsif ($cms eq 'bb5') {
403: foreach my $key (sort keys %{$resources}) {
404: if ($$resources{$key}{type} eq "resource/x-bb-document") {
405: unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
1.3 raeburn 406: %{$$resinfo{$key}} = ();
1.7 raeburn 407: &process_content($key,$context,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles);
1.2 raeburn 408: }
409: } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {
410: %{$$resinfo{$key}} = ();
411: &process_staff($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
412: } elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") {
413: %{$$resinfo{$key}} = ();
414: &process_link($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
415: } elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") {
416: %{$$resinfo{$key}} = ();
417: unless ($db_handling eq 'ignore') {
418: push @{$boards}, $key;
419: $$timestamp[$board_count] = $board_id;
420: &process_db($key,$docroot,$destdir,$board_id,$crs,$cdom,$db_handling,$uname,\%{$$resinfo{$key}},$longcrs);
421: $board_id ++;
422: $board_count ++;
423: }
424: } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
425: %{$$resinfo{$key}} = ();
426: &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);
427: } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
428: %{$$resinfo{$key}} = ();
429: &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);
430: push @{$quizzes}, $key;
431: } elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {
432: %{$$resinfo{$key}} = ();
433: &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);
434: push @{$surveys}, $key;
435: } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
436: %{$$resinfo{$key}} = ();
437: push @{$groups}, $key;
438: &process_group($key,$docroot,$destdir,\%{$$resinfo{$key}});
439: } elsif ($$resources{$key}{type} eq "resource/x-bb-user") {
440: %{$$resinfo{$key}} = ();
441: unless ($user_handling eq 'ignore') {
442: &process_user($key,$docroot,$destdir,\%{$$resinfo{$key}},$crs,$cdom,$user_handling);
443: }
444: } elsif ($$resources{$key}{type} eq "resource/x-bb-announcement") {
445: unless ($announce_handling eq 'ignore') {
446: push @{$announcements}, $key;
447: %{$$resinfo{$key}} = ();
1.3 raeburn 448: &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
1.2 raeburn 449: }
450: }
451: }
1.3 raeburn 452: if (@{$announcements}) {
453: $$items{'Top'}{'contentscount'} ++;
454: }
455: if (@{$boards}) {
456: $$items{'Top'}{'contentscount'} ++;
457: }
458: if (@{$quizzes}) {
459: $$items{'Top'}{'contentscount'} ++;
460: }
461: if (@{$surveys}) {
462: $$items{'Top'}{'contentscount'} ++;
463:
464: }
1.2 raeburn 465: }
1.3 raeburn 466:
1.2 raeburn 467: $$total{'board'} = $board_count;
1.3 raeburn 468: $$total{'quiz'} = @{$quizzes};
469: $$total{'surv'} = @{$surveys};
1.2 raeburn 470: }
471:
472: sub build_structure {
1.3 raeburn 473: my ($cms,$context,$destdir,$items,$resinfo,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;
1.2 raeburn 474: my %flag = ();
475: my %count = ();
476: my %pagecontents = ();
477: my %seqtext = ();
478: my $topnum = 0;
479:
480: if (!-e "$destdir") {
481: mkdir("$destdir",0755);
482: }
483: if (!-e "$destdir/sequences") {
484: mkdir("$destdir/sequences",0770);
485: }
486: if (!-e "$destdir/resfiles") {
487: mkdir("$destdir/resfiles",0770);
488: }
489: if (!-e "$destdir/pages") {
490: mkdir("$destdir/pages",0770);
491: }
492: if (!-e "$destdir/problems") {
493: mkdir("$destdir/problems",0770);
494: }
495:
496: $seqtext{'Top'} = qq|<map>\n|;
497: %{$$resinfo{$$items{'Top'}{resnum}}} = (
498: isfolder => 'true',
499: );
500:
501: my $srcstem = "";
502:
503: if ($context eq 'DOCS') {
504: $srcstem = "/uploaded/$cdom/$crs/$timenow";
505: } elsif ($context eq 'CSTR') {
506: $srcstem = "/res/$udom/$uname/$newdir";
507: }
508:
509: foreach my $key (sort keys %{$items}) {
510: %{$flag{$key}} = (
511: page => 0,
512: seq => 0,
513: board => 0,
514: file => 0,
515: );
516:
517: %{$count{$key}} = (
518: page => -1,
519: seq => 0,
520: board => 0,
521: file => 0,
522: );
523:
524: my $src = "";
525:
526: my $next_id = 2;
527: my $curr_id = 1;
528: my $resnum = $$items{$key}{resnum};
529: my $type = $$resources{$resnum}{type};
530: if (($cms eq 'angel' && $type eq "FOLDER") || ($cms eq 'bb5' && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) ) {
531: unless ($cms eq 'bb5' && $key eq 'Top') {
532: $seqtext{$key} = "<map>\n";
533: }
534: if ($$items{$key}{contentscount} == 0) {
535: $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
536: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
537: <resource id="$next_id" src="" type="finish"></resource>\n|;
538: } else {
539: my $contcount = @{$$items{$key}{contents}};
540: my $contitem = $$items{$key}{contents}[0];
541: my $res = $$items{$contitem}{resnum};
542: my $type = $$resources{$res}{type};
543: my $title = $$items{$contitem}{title};
544: $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);
545: unless ($flag{$key}{page} == 1) {
1.5 raeburn 546: $seqtext{$key} .= qq|<resource id="$curr_id" src="$src" title="$title" type="start"|;
1.2 raeburn 547: unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
548: $flag{$key}{page} = 1;
549: }
550: if ($key eq 'Top') {
551: push @{$topurls}, $src;
552: push @{$topnames}, $title;
553: }
554: }
555: if ($contcount == 1) {
556: $seqtext{$key} .= qq|></resource>
557: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
558: <resource id="$next_id" src="" type="finish"></resource>\n|;
559: } else {
560: if ($contcount > 2 ) {
561: for (my $i=1; $i<$contcount-1; $i++) {
562: my $contitem = $$items{$key}{contents}[$i];
563: my $res = $$items{$contitem}{resnum};
564: my $type = $$resources{$res}{type};
565: my $title = $$items{$contitem}{title};
566: $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);
567: unless ($flag{$key}{page} == 1) {
568: $seqtext{$key} .= qq|></resource>
569: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
570: <resource id="$next_id" src="$src" title="$title"|;
571: $curr_id ++;
572: $next_id ++;
573: unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
574: $flag{$key}{page} = 1;
575: }
576: if ($key eq 'Top') {
577: push @{$topurls}, $src;
578: push @{$topnames}, $title;
579: }
580: }
581: }
582: }
583: my $contitem = $$items{$key}{contents}[-1];
584: my $res = $$items{$contitem}{resnum};
585: my $type = $$resources{$res}{type};
586: my $title = $$items{$contitem}{title};
587:
588: $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);
589: if ($flag{$key}{page}) {
590: if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
591: $seqtext{$key} .= qq|></resource>
592: <link from="$curr_id" index="$curr_id" to="$next_id">
593: <resource id ="$next_id" src="" |;
594: }
595: } else {
596: $seqtext{$key} .= qq|></resource>
597: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
598: <resource id="$next_id" src="$src" title="$title" |;
599: if ($key eq 'Top') {
600: push @{$topurls}, $src;
601: push @{$topnames}, $title;
602: }
603: }
604: if ($contcount == $$items{$key}{contentscount}) {
605: $seqtext{$key} .= qq|type="finish"></resource>\n|;
606: } else {
607: $curr_id ++;
608: $next_id ++;
609: $seqtext{$key} .= qq|></resource>
1.8 ! raeburn 610: <link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
1.2 raeburn 611: }
612: }
613: }
614: unless ($cms eq 'bb5' && $key eq 'Top') {
615: $seqtext{$key} .= "</map>\n";
616: open(LOCFILE,">$destdir/sequences/$key.sequence");
617: print LOCFILE $seqtext{$key};
618: close(LOCFILE);
619: push @{$seqfiles}, "$key.sequence";
620: }
621: $count{$key}{page} ++;
622: $$total{page} += $count{$key}{page};
623: }
624: $$total{seq} += $count{$key}{seq};
625: }
626: $topnum += ($count{'Top'}{page} + $count{'Top'}{seq});
627:
628: if ($cms eq 'bb5') {
629: if (@{$announcements} > 0) {
630: &process_specials($context,'announcements',$announcements,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
631: }
632: if (@{$boards} > 0) {
633: &process_specials($context,'boards',$boards,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
634: }
635: if (@{$quizzes} > 0) {
636: &process_specials($context,'quizzes',$quizzes,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
637: }
638: if (@{$surveys} > 0) {
639: &process_specials($context,'surveys',$surveys,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
640: }
641:
642: $seqtext{'Top'} .= "</map>\n";
643: open(TOPFILE,">$destdir/sequences/Top.sequence");
644: print TOPFILE $seqtext{'Top'};
645: close(TOPFILE);
646: push @{$seqfiles}, 'Top.sequence';
647: }
648:
649: my $filestem;
650: if ($context eq 'DOCS') {
1.6 raeburn 651: $filestem = "/uploaded/$cdom/$crs/$timenow";
1.2 raeburn 652: } elsif ($context eq 'CSTR') {
653: $filestem = "/res/$udom/$uname/$newdir";
654: }
655:
656: foreach my $key (sort keys %pagecontents) {
657: for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
658: my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
659: open(PAGEFILE,">$filename");
660: print PAGEFILE qq|<map>
1.3 raeburn 661: <resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>
1.2 raeburn 662: <link to="2" index="1" from="1">\n|;
663: if (@{$pagecontents{$key}[$i]} == 1) {
1.3 raeburn 664: print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|;
1.2 raeburn 665: } elsif (@{$pagecontents{$key}[$i]} == 2) {
1.3 raeburn 666: print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][1]}{resnum}.html" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|;
1.2 raeburn 667: } else {
668: for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
669: my $curr_id = $j+1;
670: my $next_id = $j+2;
671: my $resource = $filestem.'/resfiles/'.$$items{$pagecontents{$key}[$i][$j]}{resnum}.'.html';
672: print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$$items{$pagecontents{$key}[$i][$j]}{title}"></resource>
673: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
674: }
675: my $final_id = @{$pagecontents{$key}[$i]};
1.3 raeburn 676: print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][-1]}{resnum}.html" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;
1.2 raeburn 677: }
678: print PAGEFILE "</map>";
679: close(PAGEFILE);
680: push @{$pagesfiles}, $key.'_'.$i.'.page';
681: }
682: }
683: }
684:
685: sub make_structure {
686: my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom) = @_;
687: my $src ='';
688: if (($cms eq 'angel' && $type eq 'FOLDER') || ($cms eq 'bb5' && ($$resinfo{$res}{'isfolder'} eq 'true') || ($key eq 'Top')) ) {
689: $src = $srcstem.'/sequences/'.$contitem.'.sequence';
690: $$flag{$key}{page} = 0;
691: $$flag{$key}{seq} = 1;
692: $$count{$key}{seq} ++;
693: } elsif ($cms eq 'angel' && $type eq 'BOARD') {
694: $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';
695: $$flag{$key}{page} = 0;
696: $$flag{$key}{board} = 1;
697: $$count{$key}{board} ++;
698: } elsif ($cms eq 'angel' && $type eq "FILE") {
699: foreach my $file (@{$$hrefs{$res}}) {
700: unless ($file eq 'pg'.$res.'.htm') {
701: $src = $srcstem.'/resfiles/'.$res.'/'.$file;
702: }
703: }
704: $$flag{$key}{page} = 0;
705: $$flag{$key}{file} = 1;
706: } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) ) {
707: if ($$flag{$key}{page}) {
1.3 raeburn 708: if ($$count{$key}{page} == -1) {
709: print STDERR "Array index is -1, we shouldnt be here, key is $key, type is $type\n";
1.2 raeburn 710: } else {
711: push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
712: }
713: } else {
714: $$count{$key}{page} ++;
715: $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
716: @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
717: $$flag{$key}{seq} = 0;
718: }
719: } elsif ($cms eq 'bb5') {
720: if ($$flag{$key}{page}) {
721: push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
722: } else {
723: $$count{$key}{page} ++;
724: $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
725: @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
726: $$flag{$key}{seq} = 0;
727: }
728: }
729: return $src;
730: }
731:
732:
733: # ---------------------------------------------------------------- Process Blackboard specials - announcements, bulletin boards, quizzes and surveys
734: sub process_specials {
735: my ($context,$type,$specials,$topnum,$contentscount,$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,$seqtext,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;
736: my $src = '';
737: my $specialsrc = '';
738: my $nextnum = 0;
739: my $seqstem = '';
740: if ($context eq 'CSTR') {
1.3 raeburn 741: $seqstem = "/res/$udom/$uname/$newdir";
1.2 raeburn 742: } elsif ($context eq 'DOCS') {
743: $seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow;
744: }
745: my %seqnames = (
746: boards => 'bulletinboards',
747: quizzes => 'quizzes',
748: surveys => 'surveys',
749: announcements => 'announcements',
750: );
751: my %seqtitles = (
752: boards => 'Course Bulletin Boards',
753: quizzes => 'Course Quizzes',
754: surveys => 'Course Surveys',
755: announcements => 'Course Announcements',
756: );
757: $$topnum ++;
758:
759: if ($type eq 'announcements') {
760: $src = "$seqstem/pages/$seqnames{$type}.page";
761: } else {
762: $src = "$seqstem/sequences/$seqnames{$type}.sequence";
763: }
764:
765: push @{$topurls}, $src;
766: push @{$topnames}, $seqtitles{$type};
767:
768: $$seqtext .= qq|<resource id="$$topnum" src="$src" title="$seqtitles{$type}"|;
769: $nextnum = $$topnum +1;
770: if ($$topnum == 1) {
771: $$seqtext .= qq| type="start"></resource>
772: <link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
773: if ($$topnum == $contentscount) {
774: $$seqtext .= qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
775: }
776: } else {
777: if ($$topnum == $contentscount) {
778: $$seqtext .= qq| type="finish"></resource>\n|;
779: } else {
780: $$seqtext .= qq|></resource>
781: <link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
782: }
783: }
784:
785: if ($type eq "announcements") {
786: push @{$pagesfiles}, "$seqnames{$type}.page";
787: open(ITEM,">$destdir/pages/$seqnames{$type}.page");
788: } else {
789: push @{$seqfiles}, "$seqnames{$type}.sequence";
790: open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence");
791: }
792:
793: if ($type eq 'boards') {
794: $specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";
795: } elsif ($type eq 'announcements') {
796: $specialsrc = "$seqstem/resfiles/$$specials[0].html";
797: } else {
798: $specialsrc = "$seqstem/pages/$$specials[0].page";
799: }
800: print ITEM qq|<map>
801: <resource id="1" src="$specialsrc" title="$$resinfo{$$specials[0]}{title}" type="start"></resource>
802: <link from="1" to="2" index="1"></link>|;
803: if (@{$specials} == 1) {
804: print ITEM qq|
805: <resource id="2" src="" type="finish"></resource>\n|;
806: } else {
807: for (my $i=1; $i<@{$specials}; $i++) {
808: my $curr = $i+1;
809: my $next = $i+2;
810: if ($type eq 'boards') {
811: $specialsrc = "/adm/$udom/$uname/$$timestamp[$i]/bulletinboard";
812: } elsif ($type eq 'announcements') {
813: $specialsrc = "$seqstem/resfiles/$$specials[$i].html";
814: } else {
815: $specialsrc = "$seqstem/pages/$$specials[$i].page";
816: }
817: print ITEM qq|<resource id="$curr" src="$specialsrc" title="$$resinfo{$$specials[$i]}{title}"|;
818: if (@{$specials} == $i+1) {
819: print ITEM qq| type="finish"></resource>\n|;
820: } else {
821: print ITEM qq|></resource>
822: <link from="$curr" to="$next" index="$next">\n|;
823: }
824: }
825: }
826: print ITEM qq|</map>|;
827: close(ITEM);
828: }
829:
830: # ---------------------------------------------------------------- Process Blackboard users
831: sub process_user {
832: my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_;
833: my $xmlfile = $docroot.'/'.$res.".dat";
834: my $filecount = 0;
835: my @state;
836: my $userid = '';
837: my $linknum = 0;
838:
839: my $p = HTML::Parser->new
840: (
841: xml_mode => 1,
842: start_h =>
843: [sub {
844: my ($tagname, $attr) = @_;
845: push @state, $tagname;
1.7 raeburn 846: if ("@state" eq "USERS USER") {
1.2 raeburn 847: $userid = $attr->{value};
848: %{$$settings{$userid}} = ();
849: @{$$settings{$userid}{links}} = ();
1.7 raeburn 850: } elsif ("@state" eq "USERS USER LOGINID") {
1.2 raeburn 851: $$settings{$userid}{loginid} = $attr->{value};
1.7 raeburn 852: } elsif ("@state" eq "USERS USER PASSPHRASE") {
1.2 raeburn 853: $$settings{$userid}{passphrase} = $attr->{value};
854: } elsif ("@state" eq "USERS USER STUDENTID" ) {
855: $$settings{$userid}{studentid} = $attr->{value};
856: } elsif ("@state" eq "USERS USER NAMES FAMILY" ) {
857: $$settings{$userid}{family} = $attr->{value};
858: } elsif ("@state" eq "USERS USER NAMES GIVEN" ) {
859: $$settings{$userid}{given} = $attr->{value};
860: } elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") {
861: $$settings{$userid}{email} = $attr->{value};
862: } elsif ("@state" eq "USERS USER USER_ROLE") {
863: $$settings{$userid}{user_role} = $attr->{value};
864: } elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") {
865: $$settings{$userid}{isavailable} = $attr->{value};
866: } elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") {
867: $$settings{$userid}{image} = $attr->{value};
868: } elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) {
869: %{$$settings{$userid}{links}[$linknum]} = ();
870: $$settings{$userid}{links}[$linknum]{url} = $attr->{value};
871: $linknum ++;
872: }
873: }, "tagname, attr"],
874: text_h =>
875: [sub {
876: my ($text) = @_;
877: if ("@state" eq "USERS USER PERSONALPAGE TITLE") {
878: $$settings{$userid}{title} = $text;
879: } elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") {
880: $$settings{$userid}{description} = $text;
881: } elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) {
882: $$settings{$userid}{links}[$linknum]{title} = $text;
883: } elsif (($state[-3] eq "LINK") && ($state[-2] eq "DESCRIPTION") && ($state[-1] eq "TEXT")) {
884: $$settings{$userid}{links}[$linknum]{text} = $text;
885: }
886: }, "dtext"],
887: end_h =>
888: [sub {
889: my ($tagname) = @_;
1.7 raeburn 890: if ("@state" eq "USERS USER") {
1.2 raeburn 891: $linknum = 0;
892: }
893: pop @state;
894: }, "tagname"],
895: );
896: $p->unbroken_text(1);
897: $p->parse_file($xmlfile);
898: $p->eof;
899:
900: my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
901: my $xmlstem = $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";
902:
903: foreach my $user_id (keys %{$settings}) {
904: if ($$settings{$user_id}{user_role} eq "s") {
905:
906: } elsif ($user_handling eq 'enrollall') {
907:
908: }
909: }
910: }
911:
912: # ---------------------------------------------------------------- Process Blackboard groups
913: sub process_group {
914: my ($res,$docroot,$destdir,$settings) = @_;
915: my $xmlfile = $docroot.'/'.$res.".dat";
916: my $filecount = 0;
917: my @state;
918: my $grp;
919:
920: my $p = HTML::Parser->new
921: (
922: xml_mode => 1,
923: start_h =>
924: [sub {
925: my ($tagname, $attr) = @_;
926: push @state, $tagname;
1.7 raeburn 927: if ("@state" eq "GROUPS GROUP") {
1.2 raeburn 928: $grp = $attr->{id};
929: }
1.7 raeburn 930: if ("@state" eq "GROUPS GROUP TITLE") {
1.2 raeburn 931: $$settings{$grp}{title} = $attr->{value};
1.7 raeburn 932: } elsif ("@state" eq "GROUPS GROUP FLAGS ISAVAILABLE") {
1.2 raeburn 933: $$settings{$grp}{isavailable} = $attr->{value};
1.7 raeburn 934: } elsif ("@state" eq "GROUPS GROUP FLAGS HASCHATROOM") {
1.2 raeburn 935: $$settings{$grp}{chat} = $attr->{value};
936: } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
937: $$settings{$grp}{discussion} = $attr->{value};
938: } elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") {
939: $$settings{$grp}{transfer} = $attr->{value};
940: } elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") {
941: $$settings{$grp}{public} = $attr->{value};
942: }
943: }, "tagname, attr"],
944: text_h =>
945: [sub {
946: my ($text) = @_;
947: if ("@state" eq "GROUPS DESCRIPTION") {
948: $$settings{$grp}{description} = $text;
949: # print "Staff text is $text\n";
950: }
951: }, "dtext"],
952: end_h =>
953: [sub {
954: my ($tagname) = @_;
955: pop @state;
956: }, "tagname"],
957: );
958: $p->unbroken_text(1);
959: $p->parse_file($xmlfile);
960: $p->eof;
961: }
962:
963: # ---------------------------------------------------------------- Process Blackboard Staff
964: sub process_staff {
965: my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;
966: my $xmlfile = $docroot.'/'.$res.".dat";
967: my $filecount = 0;
968: my @state;
969: %{$$settings{name}} = ();
970: %{$$settings{office}} = ();
971:
972: my $p = HTML::Parser->new
973: (
974: xml_mode => 1,
975: start_h =>
976: [sub {
977: my ($tagname, $attr) = @_;
978: push @state, $tagname;
1.7 raeburn 979: if ("@state" eq "STAFFINFO TITLE") {
1.2 raeburn 980: $$settings{title} = $attr->{value};
1.7 raeburn 981: } elsif ("@state" eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
1.2 raeburn 982: $$settings{textcolor} = $attr->{value};
1.7 raeburn 983: } elsif ("@state" eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
1.2 raeburn 984: $$settings{ishtml} = $attr->{value};
985: } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
986: $$settings{isavailable} = $attr->{value};
987: } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) {
988: $$settings{isfolder} = $attr->{value};
989: } elsif ("@state" eq "STAFFINFO POSITION" ) {
990: $$settings{position} = $attr->{value};
991: } elsif ("@state" eq "STAFFINFO HOMEPAGE" ) {
992: $$settings{homepage} = $attr->{value};
993: } elsif ("@state" eq "STAFFINFO IMAGE") {
994: $$settings{image} = $attr->{value};
995: }
996: }, "tagname, attr"],
997: text_h =>
998: [sub {
999: my ($text) = @_;
1000: if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") {
1001: $$settings{text} = $text;
1002: # print "Staff text is $text\n";
1003: } elsif ("@state" eq "STAFFINFO CONTACT PHONE") {
1004: $$settings{phone} = $text;
1005: } elsif ("@state" eq "STAFFINFO CONTACT EMAIL") {
1006: $$settings{email} = $text;
1007: } elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") {
1008: $$settings{name}{formaltitle} = $text;
1009: } elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") {
1010: $$settings{name}{family} = $text;
1011: } elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") {
1012: $$settings{name}{given} = $text;
1013: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") {
1014: $$settings{office}{hours} = $text;
1015: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") {
1016: $$settings{office}{address} = $text;
1017: }
1018: }, "dtext"],
1019: end_h =>
1020: [sub {
1021: my ($tagname) = @_;
1022: pop @state;
1023: }, "tagname"],
1024: );
1025: $p->unbroken_text(1);
1026: $p->parse_file($xmlfile);
1027: $p->eof;
1028:
1029: my $fontcol = '';
1030: if (defined($$settings{textcolor})) {
1031: $fontcol = qq|color="$$settings{textcolor}"|;
1032: }
1033: if (defined($$settings{text})) {
1034: if ($$settings{ishtml} eq "true") {
1035: $$settings{text} = &HTML::Entities::decode($$settings{text});
1036: }
1037: }
1038: my $staffentry = qq|
1039: <table border="0" cellpadding="0" cellspacing="0" width="100%">
1040: <tr>
1041: <td colspan="2"><hr /><font face="arial,helv" size="3"><b>$$settings{name}{formaltitle} $$settings{name}{given} $$settings{name}{family}</b></font>
1042: </td>
1043: </tr>
1044: <tr>
1045: <td valign="top">
1046: <table width="100% border="0" cols="2" cellpadding="0" cellspacing="0">|;
1047: if ( defined($$settings{email}) && $$settings{email} ne '') {
1048: $staffentry .= qq|
1049: <tr>
1050: <td width="100" valign="top">
1051: <font face="arial" size="2"><b>Email:</b></font>
1052: </td>
1053: <td>
1054: <font face="arial" size="2"><a href="mailto:$$settings{email}">$$settings{email}</a></font>
1055: </td>
1056: </tr>
1057: |;
1058: }
1059: if (defined($$settings{phone}) && $$settings{phone} ne '') {
1060: $staffentry .= qq|
1061: <tr>
1062: <td width="100" valign="top">
1063: <font face="arial" size="2"><b>Phone:</b></font>
1064: </td>
1065: <td>
1066: <font face="arial" size="2">$$settings{phone}</font>
1067: </td>
1068: </tr>
1069: |;
1070: }
1071: if (defined($$settings{office}{address}) && $$settings{office}{address} ne '') {
1072: $staffentry .= qq|
1073: <tr>
1074: <td width="100" valign="top">
1075: <font face="arial" size="2"><b>Address:</b></font>
1076: </td>
1077: <td>
1078: <font face="arial" size="2">$$settings{office}{address}</font>
1079: </td>
1080: </tr>
1081: |;
1082: }
1083: if (defined($$settings{office}{hours}) && $$settings{office}{hours} ne '') {
1084: $staffentry .= qq|
1085: <tr>
1086: <td width="100" valign="top">
1087: <font face="arial" size="2"><b>Office Hours:</b></font>
1088: </td>
1089: <td>
1090: <font face=arial size=2>$$settings{office}{hours}</font>
1091: </td>
1092: </tr>
1093: |;
1094: }
1095: if ( defined($$settings{homepage}) && $$settings{homepage} ne '') {
1096: $staffentry .= qq|
1097: <tr>
1098: <td width="100" valign="top">
1099: <font face="arial" size="2"><b>Personal Link:</b></font>
1100: </td>
1101: <td>
1102: <font face="arial" size="2"><a href="$$settings{homepage}">$$settings{homepage}</a></font>
1103: </td>
1104: </tr>
1105: |;
1106: }
1107: if (defined($$settings{text}) && $$settings{text} ne '') {
1108: $staffentry .= qq|
1109: <tr>
1110: <td colspan="2">
1111: <font face="arial" size="2" $fontcol><b>Other Information:</b><br/>$$settings{text}</font>
1112: </td>
1113: </tr>
1114: |;
1115: }
1116: $staffentry .= qq|
1117: </table>
1118: </td>
1119: <td align="right" valign="top">
1120: |;
1121: if ( defined($$settings{image}) ) {
1122: $staffentry .= qq|
1123: <img src="$dirname/resfiles/$res/$$settings{image}">
1124: |;
1125: }
1126: $staffentry .= qq|
1127: </td>
1128: </tr>
1129: </table>
1130: |;
1131: open(FILE,">$destdir/resfiles/$res.html");
1132: push @{$resrcfiles}, "$res.html";
1133: print FILE qq|<html>
1134: <head>
1135: <title>$$settings{title}</title>
1136: </head>
1137: <body bgcolor='#ffffff'>
1138: $staffentry
1139: </body>
1140: </html>|;
1141: close(FILE);
1142: }
1143:
1144: # ---------------------------------------------------------------- Process Blackboard Links
1145: sub process_link {
1146: my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;
1147: my $xmlfile = $docroot.'/'.$res.".dat";
1148: my @state = ();
1149: my $p = HTML::Parser->new
1150: (
1151: xml_mode => 1,
1152: start_h =>
1153: [sub {
1154: my ($tagname, $attr) = @_;
1155: push @state, $tagname;
1.7 raeburn 1156: if ("@state" eq "EXTERNALLINK TITLE") {
1.2 raeburn 1157: $$settings{title} = $attr->{value};
1.7 raeburn 1158: } elsif ("@state" eq "EXTERNALLINK TEXTCOLOR") {
1.2 raeburn 1159: $$settings{textcolor} = $attr->{value};
1.7 raeburn 1160: } elsif ("@state" eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {
1.2 raeburn 1161: $$settings{ishtml} = $attr->{value};
1162: } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {
1163: $$settings{isavailable} = $attr->{value};
1164: } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {
1165: $$settings{newwindow} = $attr->{value};
1166: } elsif ("@state" eq "EXTERNALLINK FLAGS ISFOLDER" ) {
1167: $$settings{isfolder} = $attr->{value};
1168: } elsif ("@state" eq "EXTERNALLINK POSITION" ) {
1169: $$settings{position} = $attr->{value};
1170: } elsif ("@state" eq "EXTERNALLINK URL" ) {
1.7 raeburn 1171: $$settings{url} = $attr->{value};
1.2 raeburn 1172: }
1173: }, "tagname, attr"],
1174: text_h =>
1175: [sub {
1176: my ($text) = @_;
1177: if ("@state" eq "EXTERNALLINK DESCRIPTION TEXT") {
1178: $$settings{text} = $text;
1179: }
1180: }, "dtext"],
1181: end_h =>
1182: [sub {
1183: my ($tagname) = @_;
1184: pop @state;
1185: }, "tagname"],
1186: );
1187: $p->unbroken_text(1);
1188: $p->parse_file($xmlfile);
1189: $p->eof;
1190:
1191: my $linktag = '';
1192: my $fontcol = '';
1193: if (defined($$settings{textcolor})) {
1194: $fontcol = qq|<font color="$$settings{textcolor}">|;
1195: }
1196: if (defined($$settings{text})) {
1197: if ($$settings{ishtml} eq "true") {
1198: $$settings{text} = &HTML::Entities::decode($$settings{text});
1199: }
1200: }
1201:
1202: if (defined($$settings{url}) ) {
1203: $linktag = qq|<a href="$$settings{url}"|;
1204: if ($$settings{newwindow} eq "true") {
1205: $linktag .= qq| target="launch"|;
1206: }
1207: $linktag .= qq|>$$settings{title}</a>|;
1208: }
1209:
1210: open(FILE,">$destdir/resfiles/$res.html");
1211: push @{$resrcfiles}, "$res.html";
1212: print FILE qq|<html>
1213: <head>
1214: <title>$$settings{title}</title>
1215: </head>
1216: <body bgcolor='#ffffff'>
1217: $fontcol
1218: $linktag
1219: $$settings{text}
1220: |;
1221: if (defined($$settings{textcolor})) {
1222: print FILE qq|</font>|;
1223: }
1224: print FILE qq|
1225: </body>
1226: </html>|;
1227: close(FILE);
1228: }
1229:
1230: # ---------------------------------------------------------------- Process Blackboard Discussion Boards
1231: sub process_db {
1232: my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings,$longcrs) = @_;
1233: my $xmlfile = $docroot.'/'.$res.".dat";
1234: my @state = ();
1235: my @allmsgs = ();
1236: my %msgidx = ();
1237: my %threads; # all threads, keyed by message ID
1238: my $msg_id; # the current message ID
1239: my %message; # the current message being accumulated for $msg_id
1240:
1241: my $p = HTML::Parser->new
1242: (
1243: xml_mode => 1,
1244: start_h =>
1245: [sub {
1246: my ($tagname, $attr) = @_;
1247: push @state, $tagname;
1248: my $depth = 0;
1249: my @seq = ();
1250: if ("@state" eq "FORUM TITLE") {
1251: $$settings{title} = $attr->{value};
1252: } elsif ("@state" eq "FORUM DESCRIPTION TEXTCOLOR") {
1253: $$settings{textcolor} = $attr->{value};
1254: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISHTML") {
1255: $$settings{ishtml} = $attr->{value};
1256: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") {
1257: $$settings{newline} = $attr->{value};
1258: } elsif ("@state" eq "FORUM POSITION" ) {
1259: $$settings{position} = $attr->{value};
1260: } elsif ("@state" eq "FORUM FLAGS ISREADONLY") {
1261: $$settings{isreadonly} = $attr->{value};
1262: } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) {
1263: $$settings{isavailable} = $attr->{value};
1264: } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) {
1265: $$settings{allowanon} = $attr->{value};
1266: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1267: if ($state[-1] eq "MSG") {
1268: unless ($msg_id eq '') {
1269: push @{$threads{$msg_id}}, { %message };
1270: $depth = @state - 3;
1271: if ($depth > @seq) {
1272: push @seq, $msg_id;
1273: }
1274: }
1275: if ($depth < @seq) {
1276: pop @seq;
1277: }
1278: $msg_id = $attr->{id};
1279: push @allmsgs, $msg_id;
1280: $msgidx{$msg_id} = @allmsgs;
1281: %message = ();
1282: $message{depth} = $depth;
1283: if ($depth > 0) {
1284: $message{parent} = $seq[-1];
1285: } else {
1286: $message{parent} = "None";
1287: }
1288: } elsif ($state[-1] eq "TITLE") {
1289: $message{title} = $attr->{value};
1290: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISHTML" ) ) {
1291: $message{ishtml} = $attr->{value};
1292: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISNEWLINELITERAL" ) ) {
1293: $message{newline} = $attr->{value};
1294: } elsif ( ( $state[-2] eq "DATES" ) && ( $state[-1] eq "CREATED" ) ) {
1295: $message{created} = $attr->{value};
1296: } elsif ( $state[@state-2] eq "FLAGS") {
1297: if ($state[@state-1] eq "ISANONYMOUS") {
1298: $message{isanonymous} = $attr->{value};
1299: }
1300: } elsif ( $state[-2] eq "USER" ) {
1301: if ($state[-1] eq "USERID") {
1302: $message{userid} = $attr->{value};
1303: } elsif ($state[@state-1] eq "USERNAME") {
1304: $message{username} = $attr->{value};
1305: } elsif ($state[@state-1] eq "EMAIL") {
1306: $message{email} = $attr->{value};
1307: }
1308: } elsif ( ($state[-2] eq "FILELIST") && ($state[-1] eq "IMAGE") ) {
1309: $message{attachment} = $attr->{value};
1310: }
1311: }
1312: }, "tagname, attr"],
1313: text_h =>
1314: [sub {
1315: my ($text) = @_;
1316: if ("@state" eq "FORUM DESCRIPTION TEXT") {
1317: $$settings{text} = $text;
1318: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1319: if ( ($state[-2] eq "MESSAGETEXT") && ($state[-1] eq "TEXT") ){
1320: $message{text} = $text;
1321: }
1322: }
1323: }, "dtext"],
1324: end_h =>
1325: [sub {
1326: my ($tagname) = @_;
1327: if ( $state[-1] eq "MESSAGETHREADS" ) {
1328: push @{$threads{$msg_id}}, { %message };
1329: }
1330: pop @state;
1331: }, "tagname"],
1332: );
1333: $p->unbroken_text(1);
1334: $p->parse_file($xmlfile);
1335: $p->eof;
1336:
1337: if (defined($$settings{text})) {
1338: if ($$settings{ishtml} eq "false") {
1339: if ($$settings{isnewline} eq "true") {
1340: $$settings{text} =~ s#\n#<br/>#g;
1341: }
1342: } else {
1343: $$settings{text} = &HTML::Entities::decode($$settings{text});
1344: }
1345: if (defined($$settings{fontcolor}) ) {
1346: $$settings{text} = "<font color=\"".$$settings{textcolor}."\">".$$settings{text}."</font>";
1347: }
1348: }
1349: my $boardname = 'bulletinpage_'.$timestamp;
1350: my %boardinfo = (
1351: 'aaa_title' => $$settings{title},
1352: 'bbb_content' => $$settings{text},
1353: 'ccc_webreferences' => '',
1354: 'uploaded.lastmodified' => time,
1355: );
1356:
1357: my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
1358: if ($handling eq 'importall') {
1359: foreach my $msg_id (@allmsgs) {
1360: foreach my $message ( @{$threads{$msg_id}} ) {
1361: my %contrib = (
1362: 'sendername' => $$message{userid},
1363: 'senderdomain' => $cdom,
1364: 'screenname' => '',
1365: 'plainname' => $$message{username},
1366: );
1367: unless ($$message{parent} eq 'None') {
1368: $contrib{replyto} = $msgidx{$$message{parent}};
1369: }
1370: if (defined($$message{isanonymous}) ) {
1371: if ($$message{isanonymous} eq 'true') {
1372: $contrib{'anonymous'} = 'true';
1373: }
1374: }
1375: if ( defined($$message{attachment}) ) {
1376: my $url = $$message{attachment};
1377: my $oldurl = $url;
1378: my $newurl = $url;
1379: unless ($url eq '') {
1380: $newurl =~ s/\//_/g;
1381: unless ($longcrs eq '') {
1382: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
1383: mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
1384: }
1385: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
1386: system("cp $destdir/resfiles/$res/$$message{attachment} /home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
1387: }
1388: $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$newurl;
1389: }
1390: }
1391: }
1392: if (defined($$message{title}) ) {
1393: $contrib{'message'} = $$message{title};
1394: }
1395: if (defined($$message{text})) {
1396: if ($$message{ishtml} eq "false") {
1397: if ($$message{isnewline} eq "true") {
1398: $$message{text} =~ s#\n#<br/>#g;
1399: }
1400: } else {
1401: $$message{text} = &HTML::Entities::decode($$message{text});
1402: }
1403: $contrib{'message'} .= '<br /><br />'.$$message{text};
1404: my $symb = 'bulletin___'.$timestamp.'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$timestamp.'/bulletinboard';
1405: my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
1406: }
1407: }
1408: }
1409: }
1410: }
1411:
1412: # ---------------------------------------------------------------- Add Posting to Bulletin Board
1413: sub addposting {
1414: my ($symb,$contrib,$cdom,$crs)=@_;
1415: my $status='';
1416: if (($symb) && ($$contrib{message})) {
1417: my $crsdom = $cdom.'_'.$crs;
1418: &Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs);
1419: my %storenewentry=($symb => time);
1420: &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
1421: }
1422: my %record=&Apache::lonnet::restore('_discussion');
1423: my ($temp)=keys %record;
1424: unless ($temp=~/^error\:/) {
1425: my %newrecord=();
1426: $newrecord{'resource'}=$symb;
1427: $newrecord{'subnumber'}=$record{'subnumber'}+1;
1428: &Apache::lonnet::cstore(\%newrecord,'_discussion');
1429: $status = 'ok';
1430: } else {
1431: $status.='Failed.';
1432: }
1433: return $status;
1434: }
1435: # ---------------------------------------------------------------- Process Blackboard Assessments - pools, quizzes, surveys
1436: sub process_assessment {
1437: my ($res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname) = @_;
1438: my $xmlfile = $docroot.'/'.$res.".dat";
1439: # print "XML file is $xmlfile\n";
1440: my @state = ();
1441: my @allids = ();
1442: my %allanswers = ();
1443: my %allchoices = ();
1444: my $resdir = '';
1445: if ($docroot =~ m|public_html/(.+)$|) {
1446: $resdir = $1;
1447: }
1448: my $id; # the current question ID
1449: my $answer_id; # the current answer ID
1450: my %toptag = ( pool => 'POOL',
1451: quiz => 'ASSESSMENT',
1452: survey => 'ASSESSMENT'
1453: );
1454:
1455: my $p = HTML::Parser->new
1456: (
1457: xml_mode => 1,
1458: start_h =>
1459: [sub {
1460: my ($tagname, $attr) = @_;
1461: push @state, $tagname;
1462: my $depth = 0;
1463: my @seq = ();
1464: my $class;
1465: my $state_str = join(" ",@state);
1466: if ($container eq "pool") {
1467: if ("@state" eq "POOL TITLE") {
1468: $$settings{title} = $attr->{value};
1469: }
1470: } else {
1471: if ("@state" eq "ASSESSMENT TITLE") {
1472: $$settings{title} = $attr->{value};
1473: } elsif ("@state" eq "ASSESSMENT FLAG" ) {
1474: $$settings{isnewline} = $attr->{value};
1475: } elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") {
1476: $$settings{isavailable} = $attr->{value};
1477: } elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) {
1478: $$settings{isanonymous} = $attr->{id};
1479: } elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) {
1480: $$settings{feedback} = $attr->{id};
1481: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) {
1482: $$settings{showcorrect} = $attr->{id};
1483: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) {
1484: $$settings{showresults} = $attr->{id};
1485: } elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) {
1486: $$settings{allowmultiple} = $attr->{id};
1487: } elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) {
1488: $$settings{type} = $attr->{id};
1489: }
1490: }
1491: if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {
1492: $id = $attr->{id};
1493: unless ($container eq 'pool') {
1494: push @allids, $id;
1495: }
1496: %{$$settings{$id}} = ();
1497: @{$allanswers{$id}} = ();
1498: $$settings{$id}{class} = $attr->{class};
1499: unless ($container eq "pool") {
1500: $$settings{$id}{points} = $attr->{points};
1501: }
1502: @{$$settings{$id}{correctanswer}} = ();
1503: } elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) {
1504: $id = $attr->{id};
1505: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
1506: if ($state[4] eq "ISHTML") {
1507: $$settings{$id}{html} = $attr->{value};
1508: } elsif ($state[4] eq "ISNEWLINELITERAL") {
1509: $$settings{$id}{newline} = $attr->{value};
1510: }
1511: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) {
1512: $$settings{$id}{image} = $attr->{value};
1513: $$settings{$id}{style} = $attr->{style};
1514: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) {
1515: $$settings{$id}{url} = $attr->{value};
1516: $$settings{$id}{name} = $attr->{name};
1517: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
1518: $answer_id = $attr->{id};
1519: push @{$allanswers{$id}},$answer_id;
1520: %{$$settings{$id}{$answer_id}} = ();
1521: $$settings{$id}{$answer_id}{position} = $attr->{position};
1522: if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
1523: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1524: $$settings{$id}{$answer_id}{type} = 'answer';
1525: }
1526: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
1527: $answer_id = $attr->{id};
1528: push @{$allchoices{$id}},$answer_id;
1529: %{$$settings{$id}{$answer_id}} = ();
1530: $$settings{$id}{$answer_id}{position} = $attr->{position};
1531: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1532: $$settings{$id}{$answer_id}{type} = 'choice';
1533: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") ) {
1534: if ($state[3] eq "IMAGE") {
1535: $$settings{$id}{$answer_id}{image} = $attr->{value};
1536: $$settings{$id}{$answer_id}{style} = $attr->{style};
1537: } elsif ($state[3] eq "URL") {
1538: $$settings{$id}{$answer_id}{url} = $attr->{value};
1539: }
1540: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") ) {
1541: if ($state[3] eq "IMAGE") {
1542: $$settings{$id}{$answer_id}{image} = $attr->{value};
1543: $$settings{$id}{$answer_id}{style} = $attr->{style};
1544: } elsif ($state[3] eq "URL") {
1545: $$settings{$id}{$answer_id}{url} = $attr->{value};
1546: }
1547: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) {
1548: my $corr_answer = $attr->{answer_id};
1549: push @{$$settings{$id}{correctanswer}}, $corr_answer;
1550: my $type = $1;
1551: if ($type eq 'TRUEFALSE') {
1552: $$settings{$id}{$corr_answer}{answer_position} = $attr->{position};
1553: } elsif ($type eq 'ORDER') {
1554: $$settings{$id}{$corr_answer}{order} = $attr->{order};
1555: } elsif ($type eq 'MATCH') {
1556: $$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id};
1557: }
1558: }
1559: }, "tagname, attr"],
1560: text_h =>
1561: [sub {
1562: my ($text) = @_;
1563: unless ($container eq "pool") {
1564: if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
1565: $$settings{description} = $text;
1566: } elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") {
1567: $$settings{instructions}{text} = $text;
1568: }
1569: }
1570: if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "TEXT") ) {
1571: $$settings{$id}{text} = $text;
1572: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) {
1573: $$settings{$id}{$answer_id}{text} = $text;
1574: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) {
1575: $$settings{$id}{$answer_id}{text} = $text;
1576: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) {
1577: $$settings{$id}{feedback_corr} = $text;
1578: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) {
1579: $$settings{$id}{feedback_incorr} = $text;
1580: }
1581: }, "dtext"],
1582: end_h =>
1583: [sub {
1584: my ($tagname) = @_;
1585: pop @state;
1586: }, "tagname"],
1587: );
1588: $p->unbroken_text(1);
1589: $p->parse_file($xmlfile);
1590: $p->eof;
1591:
1592: my $dirtitle = $$settings{'title'};
1593: $dirtitle =~ s/\W//g;
1594: $dirtitle .= '_'.$res;
1595: if (!-e "$destdir/problems/$dirtitle") {
1596: mkdir("$destdir/problems/$dirtitle",0755);
1597: }
1598: my $newdir = "$destdir/problems/$dirtitle";
1599: my $pagedir = "$destdir/pages";
1600: my $curr_id = 0;
1601: my $next_id = 1;
1602: unless ($container eq 'pool') {
1603: open(PAGEFILE,">$pagedir/$res.page");
1604: print PAGEFILE qq|<map>
1605: |;
1606: $$total{page} ++;
1607: print PAGEFILE qq|<resource id="1" src="/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[0].problem" type="start"></resource>|;
1608: if (@allids == 1) {
1609: print PAGEFILE qq|
1610: <link from="1" to="2" index="1"></link>
1611: <resource id="2" src="" type="finish">\n|;
1612: } else {
1613: for (my $j=1; $j<@allids; $j++) {
1614: $curr_id = $j;
1615: $next_id = $curr_id + 1;
1616: print PAGEFILE qq|
1617: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
1618: <resource id="$next_id" src="/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[$j].problem"|;
1619: if ($next_id == @allids) {
1620: print PAGEFILE qq| type="finish"></resource>\n|;
1621: } else {
1622: print PAGEFILE qq|></resource>|;
1623: }
1624: }
1625: }
1626: print PAGEFILE qq|</map>|;
1627: close(PAGEFILE);
1628: }
1629: foreach my $id (@allids) {
1630: my $output = qq|<problem>
1631: |;
1.3 raeburn 1632: $$total{prob} ++;
1.2 raeburn 1633: if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
1634: $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
1635: <essayresponse>
1636: <textfield></textfield>
1637: </essayresponse>
1638: <postanswerdate>
1639: $$settings{$id}{feedbackcorr}
1640: </postanswerdate>
1641: |;
1642: } else {
1643: $output .= qq|<startouttext />$$settings{$id}{text}\n|;
1644: if ( defined($$settings{$id}{image}) ) {
1645: if ( $$settings{$id}{style} eq 'embed' ) {
1646: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{image}" /><br />|;
1647: } else {
1648: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
1649: }
1650: }
1651: if ( defined($$settings{$id}{url}) ) {
1652: $output .= qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
1653: }
1654: $output .= qq|
1655: <endouttext />|;
1656: if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
1657: my $numfoils = @{$allanswers{$id}};
1658: $output .= qq|
1659: <radiobuttonresponse max="$numfoils" randomize="yes">
1660: <foilgroup>
1661: |;
1662: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1663: $output .= " <foil name=\"foil".$k."\" value=\"";
1664: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1665: $output .= "true\" location=\"";
1666: } else {
1667: $output .= "false\" location=\"";
1668: }
1669: if (lc ($allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
1670: $output .= "bottom\"";
1671: } else {
1672: $output .= "random\"";
1673: }
1674: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};
1675: if ( defined($$settings{$id}{$allanswers{$id}[$k]}{image}) ) {
1676: if ( $$settings{$id}{$allanswers{$id}[$k]}{style} eq 'embed' ) {
1677: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" /><br />|;
1678: } else {
1679: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
1680: }
1681: }
1682: $output .= qq|<endouttext /></foil>\n|;
1683: }
1684: chomp($output);
1685: $output .= qq|
1686: </foilgroup>
1687: </radiobuttonresponse>
1688: |;
1689: } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
1690: my $numfoils = @{$allanswers{$id}};
1691: $output .= qq|
1692: <radiobuttonresponse max="$numfoils" randomize="yes">
1693: <foilgroup>
1694: |;
1695: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1696: $output .= " <foil name=\"foil".$k."\" value=\"";
1697: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1698: $output .= "true\" location=\"random\"";
1699: } else {
1700: $output .= "false\" location=\"random\"";
1701: }
1702: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1703: }
1704: chomp($output);
1705: $output .= qq|
1706: </foilgroup>
1707: </radiobuttonresponse>
1708: |;
1709: } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
1710: my $numfoils = @{$allanswers{$id}};
1711: $output .= qq|
1712: <optionresponse max="$numfoils" randomize="yes">
1713: <foilgroup options="('True','False')">
1714: |;
1715: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1716: $output .= " <foil name=\"foil".$k."\" value=\"";
1717: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
1718: $output .= "True\"";
1719: } else {
1720: $output .= "False\"";
1721: }
1722: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1723: }
1724: chomp($output);
1725: $output .= qq|
1726: </foilgroup>
1727: </optionresponse>
1728: |;
1729: } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
1730: my $numfoils = @{$allanswers{$id}};
1731: $output .= qq|
1732: <rankresponse max="$numfoils" randomize="yes">
1733: <foilgroup>
1734: |;
1735: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1736: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
1737: }
1738: chomp($output);
1739: $output .= qq|
1740: </foilgroup>
1741: </rankresponse>
1742: |;
1743: } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
1744: my $numerical = 1;
1745: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1746: if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
1747: $numerical = 0;
1748: }
1749: }
1750: if ($numerical) {
1751: my $numans;
1752: my $tol;
1753: if (@{$allanswers{$id}} == 1) {
1754: $tol = 5;
1755: $numans = $$settings{$id}{$allanswers{$id}[0]}{text};
1756: } else {
1757: my $min = $$settings{$id}{$allanswers{$id}[0]}{text};
1758: my $max = $$settings{$id}{$allanswers{$id}[0]}{text};
1759: for (my $k=1; $k<@{$allanswers{$id}}; $k++) {
1760: if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {
1761: $min = $$settings{$id}{$allanswers{$id}[$k]}{text};
1762: }
1763: if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {
1764: $max = $$settings{$id}{$allanswers{$id}[$k]}{text};
1765: }
1766: }
1767: $numans = ($max + $min)/2;
1768: $tol = 100*($max - $min)/($numans*2);
1769: }
1770: $output .= qq|
1771: <numericalresponse answer="$numans">
1772: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
1773: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
1774: />
1775: <textline />
1776: </numericalresponse>
1777: |;
1778: } else {
1779: if (@{$allanswers{$id}} == 1) {
1780: $output .= qq|
1781: <stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">
1782: <textline>
1783: </textline>
1784: </stringresponse>
1785: |;
1786: } else {
1787: my @answertext = ();
1788: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1789: $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
1790: push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};
1791: }
1792: my $regexpans = join('|',@answertext);
1793: $regexpans = '/^('.$regexpans.')\b/';
1794: $output .= qq|
1795: <stringresponse answer="$regexpans" type="re">
1796: <textline>
1797: </textline>
1798: </stringresponse>
1799: |;
1800: }
1801: }
1802: } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
1803: $output .= qq|
1804: <matchresponse max="10" randomize="yes">
1805: <foilgroup>
1806: <itemgroup>
1807: |;
1808: for (my $k=0; $k<@{$allchoices{$id}}; $k++) {
1809: $output .= qq|
1810: <item name="$allchoices{$id}[$k]">
1811: <startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />
1812: </item>
1813: |;
1814: }
1815: $output .= qq|
1816: </itemgroup>
1817: |;
1818: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
1819: $output .= qq|
1820: <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">
1821: <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />
1822: </foil>
1823: |;
1824: }
1825: $output .= qq|
1826: </foilgroup>
1827: </matchresponse>
1828: |;
1829: }
1830: }
1831: $output .= qq|</problem>
1832: |;
1833: open(PROB,">$newdir/$id.problem");
1834: print PROB $output;
1835: close PROB;
1836: }
1837: }
1838:
1839: # ---------------------------------------------------------------- Process Blackboard Announcements
1840: sub process_announce {
1.3 raeburn 1841: my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;
1.2 raeburn 1842: my $xmlfile = $docroot.'/'.$res.".dat";
1843: my @state = ();
1844: my @assess = ();
1845: my $id;
1846: my $p = HTML::Parser->new
1847: (
1848: xml_mode => 1,
1849: start_h =>
1850: [sub {
1851: my ($tagname, $attr) = @_;
1852: push @state, $tagname;
1853: if ("@state" eq "ANNOUNCEMENT TITLE") {
1854: $$settings{title} = $attr->{value};
1855: $$settings{startassessment} = ();
1.7 raeburn 1856: } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {
1.2 raeburn 1857: $$settings{ishtml} = $attr->{value};
1858: } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
1859: $$settings{isnewline} = $attr->{value};
1860: } elsif ("@state" eq "ANNOUNCEMENT ISPERMANENT" ) {
1861: $$settings{ispermanent} = $attr->{value};
1862: } elsif ("@state" eq "ANNOUNCEMENT DATES UPDATED") {
1863: $$settings{dates} = $attr->{value};
1864: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) {
1865: $id = $attr->{id};
1866: %{$$settings{startassessment}{$id}} = ();
1867: push @assess,$id;
1868: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) {
1869: my $key = $attr->{key};
1870: $$settings{startassessment}{$id}{$key} = $attr->{value};
1871: }
1872: }, "tagname, attr"],
1873: text_h =>
1874: [sub {
1875: my ($text) = @_;
1876: if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") {
1877: $$settings{text} = $text;
1878: }
1879: }, "dtext"],
1880: end_h =>
1881: [sub {
1882: my ($tagname) = @_;
1883: pop @state;
1884: }, "tagname"],
1885: );
1886: $p->unbroken_text(1);
1887: $p->parse_file($xmlfile);
1888: $p->eof;
1889:
1890: if (defined($$settings{text})) {
1891: if ($$settings{ishtml} eq "false") {
1892: if ($$settings{isnewline} eq "true") {
1893: $$settings{text} =~ s#\n#<br/>#g;
1894: }
1895: } else {
1896: $$settings{text} = &HTML::Entities::decode($$settings{text});
1897: }
1898: }
1899:
1900: if (@assess > 0) {
1901: foreach my $id (@assess) {
1.3 raeburn 1902: $$settings{text} = "A $$settings{startassessment}{$id}{assessment_type}, entitled $$globalresref{$$settings{startassessment}{$id}{assessment_id}}{title} is available. Click <a href='$seqstem/pages/$$settings{startassessment}{$id}{assessment_id}.page' target='quizpage'>here</a> to enter the page that contains the problems in this assessment.";
1.2 raeburn 1903: }
1904: }
1905:
1906: open(FILE,">$destdir/resfiles/$res.html");
1907: push @{$resrcfiles}, "$res.html";
1908: print FILE qq|<html>
1909: <head>
1910: <title>$$settings{title}</title>
1911: </head>
1912: <body bgcolor='#ffffff'>
1913: <table>
1914: <tr>
1.3 raeburn 1915: <td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{dates}</td>
1.2 raeburn 1916: </tr>
1917: </table>
1918: <br/>
1919: $$settings{text}
1920: |;
1921: print FILE qq|
1922: </body>
1923: </html>|;
1924: close(FILE);
1925: }
1926:
1927: # ---------------------------------------------------------------- Process Blackboard Content
1928: sub process_content {
1.7 raeburn 1929: my ($res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles) = @_;
1.2 raeburn 1930: my $xmlfile = $docroot.'/'.$res.".dat";
1931: my $destresdir = $destdir;
1.7 raeburn 1932: if ($context eq 'CSTR') {
1933: $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
1934: } elsif ($context eq 'DOCS') {
1935: $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
1936: }
1.2 raeburn 1937: my $filecount = 0;
1938: my @allrelfiles = ();
1939: my @state;
1940: @{$$settings{files}} = ();
1941: my $p = HTML::Parser->new
1942: (
1943: xml_mode => 1,
1944: start_h =>
1945: [sub {
1946: my ($tagname, $attr) = @_;
1947: push @state, $tagname;
1.7 raeburn 1948: if ("@state" eq "CONTENT MAINDATA") {
1.2 raeburn 1949: %{$$settings{maindata}} = ();
1.7 raeburn 1950: } elsif ("@state" eq "CONTENT MAINDATA TEXTCOLOR") {
1.2 raeburn 1951: $$settings{maindata}{color} = $attr->{value};
1.7 raeburn 1952: } elsif ("@state" eq "CONTENT MAINDATA FLAGS ISHTML") {
1.2 raeburn 1953: $$settings{maindata}{ishtml} = $attr->{value};
1.7 raeburn 1954: } elsif ("@state" eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {
1.2 raeburn 1955: $$settings{maindata}{isnewline} = $attr->{value};
1956: } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
1957: $$settings{isavailable} = $attr->{value};
1958: } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
1959: $$settings{isfolder} = $attr->{value};
1960: } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
1961: $$settings{newwindow} = $attr->{value};
1962: } elsif ("@state" eq "CONTENT FILES FILEREF") {
1963: %{$$settings{files}[$filecount]} = ();
1964: %{$$settings{files}[$filecount]{registry}} = ();
1965: } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
1966: $$settings{files}[$filecount]{'relfile'} = $attr->{value};
1967: push @allrelfiles, $attr->{value};
1968: } elsif ("@state" eq "CONTENT FILES FILEREF MIMETYPE") {
1969: $$settings{files}[$filecount]{mimetype} = $attr->{value};
1970: } elsif ("@state" eq "CONTENT FILES FILEREF CONTENTTYPE") {
1971: $$settings{files}[$filecount]{contenttype} = $attr->{value};
1972: } elsif ("@state" eq "CONTENT FILES FILEREF FILEACTION") {
1973: $$settings{files}[$filecount]{fileaction} = $attr->{value};
1974: } elsif ("@state" eq "CONTENT FILES FILEREF PACKAGEPARENT") {
1975: $$settings{files}[$filecount]{packageparent} = $attr->{value};
1976: } elsif ("@state" eq "CONTENT FILES FILEREF LINKNAME") {
1977: $$settings{files}[$filecount]{linkname} = $attr->{value};
1978: } elsif ("@state" eq "CONTENT FILES FILEREF REGISTRY REGISTRYENTRY") {
1979: my $key = $attr->{key};
1980: $$settings{files}[$filecount]{registry}{$key} = $attr->{value};
1981: }
1982: }, "tagname, attr"],
1983: text_h =>
1984: [sub {
1985: my ($text) = @_;
1986: if ("@state" eq "CONTENT TITLE") {
1987: $$settings{title} = $text;
1988: } elsif ("@state" eq "CONTENT MAINDATA TEXT") {
1989: $$settings{maindata}{text} = $text;
1990: } elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") {
1991: $$settings{files}[$filecount]{reftext} = $text;
1992: }
1993: }, "dtext"],
1994: end_h =>
1995: [sub {
1996: my ($tagname) = @_;
1997: if ("@state" eq "CONTENT FILES FILEREF") {
1998: $filecount ++;
1999: }
2000: pop @state;
2001: }, "tagname"],
2002: );
2003: $p->unbroken_text(1);
2004: $p->parse_file($xmlfile);
2005: $p->eof;
2006: my $linktag = '';
2007: my $fontcol = '';
2008: if (@{$$settings{files}} > 0) {
2009: for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) {
2010: if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') {
2011: if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) {
2012: my $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"/>|;
2013: $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#;
2014: } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) {
2015: my $reftag = $1;
2016: my $newtag;
2017: if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) {
2018: $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
2019: if ( defined($$settings{files}[$filecount]{registry}{alttext}) ) {
2020: $newtag .= qq| alt="$$settings{files}[$filecount]{registry}{alttext}"|;
2021: }
2022: if ( defined($$settings{files}[$filecount]{registry}{alignment}) )
2023: {
2024: $newtag .= qq| align="$$settings{files}[$filecount]{registry}{alignment}"|;
1.1 raeburn 2025: }
1.2 raeburn 2026: if ( defined($$settings{files}[$filecount]{registry}{border}) ) {
2027: $newtag .= qq| border="$$settings{files}[$filecount]{registry}{border}"|;
2028: }
2029: $newtag .= " />";
2030: my $reftext = $$settings{files}[$filecount]{reftext};
2031: my $fname = $$settings{files}[$filecount]{'relfile'};
2032: $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
2033: # $$settings{maindata}{text} =~ s/DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
2034: $$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//;
2035: $$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/;
2036: $$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//;
2037: $$settings{maindata}{text} =~ s/\-\->//;
2038: # $$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/;
2039: # print STDERR $$settings{maindata}{text};
2040: }
2041: } else {
2042: my $filename=$$settings{files}[$filecount]{'relfile'};
2043: # print "File is $filename\n";
2044: my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
2045: # print "New filename is $newfilename\n";
2046: $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g;
2047: }
2048: } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
2049: unless (($$settings{files}[$filecount]{packageparent} ne '') && (grep/^$$settings{files}[$filecount]{packageparent}$/,@{$$settings{files}}) ) {
2050: $linktag .= qq|<a href="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
2051: if ($$settings{newwindow} eq "true") {
2052: $linktag .= qq| target="$res$filecount"|;
1.1 raeburn 2053: }
1.2 raeburn 2054: foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {
2055: $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
1.1 raeburn 2056: }
1.2 raeburn 2057: $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;
1.1 raeburn 2058: }
1.2 raeburn 2059: } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') {
2060: # print "Found a package\n";
1.1 raeburn 2061: }
1.2 raeburn 2062: }
2063: }
2064: if (defined($$settings{maindata}{textcolor})) {
2065: $fontcol = qq|<font color="$$settings{maindata}{textcolor}">|;
2066: }
2067: if (defined($$settings{maindata}{text})) {
2068: if ($$settings{maindata}{ishtml} eq "false") {
2069: if ($$settings{maindata}{isnewline} eq "true") {
2070: $$settings{maindata}{text} =~ s#\n#<br/>#g;
2071: }
2072: } else {
2073: $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
2074: }
2075: }
2076:
2077: open(FILE,">$destdir/resfiles/$res.html");
2078: push @{$resrcfiles}, "$res.html";
2079: print FILE qq|<html>
2080: <head>
2081: <title>$$settings{title}</title>
2082: </head>
2083: <body bgcolor='#ffffff'>
2084: $fontcol
2085: |;
2086: unless ($$settings{title} eq '') {
2087: print FILE qq|$$settings{title}<br/><br/>\n|;
2088: }
2089: print FILE qq|
2090: $$settings{maindata}{text}
2091: $linktag|;
2092: if (defined($$settings{maindata}{textcolor})) {
2093: print FILE qq|</font>|;
2094: }
2095: print FILE qq|
2096: </body>
2097: </html>|;
2098: close(FILE);
2099: }
2100:
2101:
2102: sub process_angelboards {
2103: my ($context,$destdir,$boards,$timestamp,$crs,$cdom,$uname,$db_handling,$messages,$items,$resources,$hrefs,$tempdir,$longcrs) = @_;
2104: for (my $i=0; $i<@{$boards}; $i++) {
2105: my %msgidx = ();
2106: my $forumtext = '';
2107: my $boardname = 'bulletinpage_'.$$timestamp[$i];
2108: my $forumfile = $tempdir.'/_assoc/'.$$boards[$i].'/pg'.$$boards[$i].'.htm';
2109: my @state = ();
2110: my $p = HTML::Parser->new
2111: (
2112: xml_mode => 1,
2113: start_h =>
2114: [sub {
2115: my ($tagname, $attr) = @_;
2116: push @state, $tagname;
2117: }, "tagname, attr"],
2118: text_h =>
2119: [sub {
2120: my ($text) = @_;
2121: if ("@state" eq "html body div div") {
2122: $forumtext = $text;
2123: }
2124: }, "dtext"],
2125: end_h =>
2126: [sub {
2127: my ($tagname) = @_;
2128: pop @state;
2129: }, "tagname"],
2130: );
2131: $p->parse_file($forumfile);
2132: $p->eof;
2133:
2134: my %boardinfo = (
2135: 'aaa_title' => $$items{$$resources{$$boards[$i]}{revitm}}{title},
2136: 'bbb_content' => $forumtext,
2137: 'ccc_webreferences' => '',
2138: 'uploaded.lastmodified' => time,
2139: );
2140: my $msgcount = 0;
2141:
2142: my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
2143: # print STDERR "putresult is $putresult for $boardname $cdom $crs\n";
2144: if ($db_handling eq 'importall') {
2145: foreach my $msg_id (@{$$messages{$$boards[$i]}}) {
2146: $msgcount ++;
2147: $msgidx{$msg_id} = $msgcount;
2148: my %contrib = (
2149: 'sendername' => 'NoName',
2150: 'senderdomain' => $cdom,
2151: 'screenname' => '',
2152: 'message' => $$items{$$resources{$msg_id}{revitm}}{title}
2153: );
2154: unless ( $$items{$$resources{$msg_id}{revitm}}{parentseq} eq $$resources{$$boards[$i]}{revitm} ) {
2155: unless ( $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}} eq ''){
2156: $contrib{replyto} = $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}};
1.1 raeburn 2157: }
1.2 raeburn 2158: }
2159: if ( @{$$hrefs{$msg_id}} > 1 ) {
2160: my $newurl = '';
2161: foreach my $file (@{$$hrefs{$msg_id}}) {
2162: unless ($file eq 'pg'.$msg_id.'.htm') {
2163: $newurl = $msg_id.$file;
2164: unless ($longcrs eq '') {
2165: if ($context eq 'CSTR') {
2166: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
2167: mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
2168: }
2169: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
2170: rename("$destdir/resfiles/$msg_id/$file","/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
2171: }
2172: }
2173: $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$file;
2174: }
1.1 raeburn 2175: }
2176: }
2177: }
1.2 raeburn 2178: my $xmlfile = $tempdir.'/_assoc/'.$msg_id.'/'.$$resources{$msg_id}{file};
2179: &angel_message($msg_id,\%contrib,$xmlfile);
2180: unless ($$resources{$msg_id}{file} eq '') {
2181: unlink($xmlfile);
2182: }
2183: my $symb = 'bulletin___'.$$timestamp[$i].'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$i].'/bulletinboard';
2184: my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
2185: }
2186: }
2187: }
2188: }
2189:
2190: # ---------------------------------------------------------------- Process ANGEL message board messages
2191: sub angel_message {
2192: my ($msg_id,$contrib,$xmlfile) = @_;
2193: my @state = ();
2194: my $p = HTML::Parser->new
2195: (
2196: xml_mode => 1,
2197: start_h =>
2198: [sub {
2199: my ($tagname, $attr) = @_;
2200: push @state, $tagname;
2201: }, "tagname, attr"],
2202: text_h =>
2203: [sub {
2204: my ($text) = @_;
2205: if ("@state" eq "html body table tr td div small span") {
2206: $$contrib{'plainname'} = $text;
2207: } elsif ("@state" eq "html body div div") {
2208: $$contrib{'message'} .= '<br /><br />'.$text;
2209: }
2210: }, "dtext"],
2211: end_h =>
2212: [sub {
2213: my ($tagname) = @_;
2214: pop @state;
2215: }, "tagname"],
2216: );
2217: $p->parse_file($xmlfile);
2218: $p->eof;
2219: }
2220:
2221: # ---------------------------------------------------------------- ANGEL content
2222: sub angel_content {
2223: my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
2224: my $xmlfile = $docroot.'/_assoc/'.$res.'/pg'.$res.'.htm';
2225: my $filecount = 0;
2226: my $firstline;
2227: my $lastline;
2228: my @buffer = ();
2229: my @state;
2230: @{$$settings{links}} = ();
2231: my $p = HTML::Parser->new
2232: (
2233: xml_mode => 1,
2234: start_h =>
2235: [sub {
2236: my ($tagname, $attr) = @_;
2237: push @state, $tagname;
2238: }, "tagname, attr"],
2239: text_h =>
2240: [sub {
2241: my ($text) = @_;
2242: if ("@state" eq "html body table tr td div small span") {
2243: $$settings{'subtitle'} = $text;
2244: } elsif ("@state" eq "html body div div") {
2245: $$settings{'text'} = $text;
2246: } elsif ("@state" eq "html body div div a") {
2247: push @{$$settings{'links'}}, $text;
2248: }
2249: }, "dtext"],
2250: end_h =>
2251: [sub {
2252: my ($tagname) = @_;
2253: pop @state;
2254: }, "tagname"],
2255: );
2256: $p->parse_file($xmlfile);
2257: $p->eof;
2258: if ($type eq "PAGE") {
2259: open(FILE,"<$xmlfile");
2260: @buffer = <FILE>;
2261: close(FILE);
2262: chomp(@buffer);
2263: $firstline = -1;
2264: $lastline = 0;
2265: for (my $i=0; $i<@buffer; $i++) {
2266: if (($firstline == -1) && ($buffer[$i] =~ m/<div\sclass="normalDiv"><div\sclass="normalSpan">/)) {
2267: $firstline = $i;
2268: $buffer[$i] = substr($buffer[$i],index($buffer[$i],'"normalSpan"')+13);
2269: }
2270: if (($firstline > -1) && ($buffer[$i] =~ m-<p></p></div></div>-)) {
2271: $buffer[$i] = substr($buffer[$i],0,index($buffer[$i],'<p></p></div></div>'));
2272: $lastline = $i;
1.1 raeburn 2273: }
2274: }
2275: }
1.2 raeburn 2276: open(FILE,">$destdir/resfiles/$res.html");
2277: push @{$resrcfiles}, "$res.html";
2278: print FILE qq|<html>
2279: <head>
2280: <title>$title</title>
2281: </head>
2282: <body bgcolor='#ffffff'>
2283: |;
2284: unless ($title eq '') {
2285: print FILE qq|<b>$title</b><br/>\n|;
2286: }
2287: unless ($$settings{subtitle} eq '') {
2288: print FILE qq|$$settings{subtitle}<br/>\n|;
2289: }
2290: print FILE "<br/>\n";
2291: if ($type eq "LINK") {
2292: foreach my $link (@{$$settings{links}}) {
2293: print FILE qq|<a href="$link">$link</a><br/>\n|;
2294: }
2295: } elsif ($type eq "PAGE") {
2296: if ($firstline > -1) {
2297: for (my $i=$firstline; $i<=$lastline; $i++) {
2298: print FILE "$buffer[$i]\n";
2299: }
2300: }
2301: }
2302: print FILE qq|
2303: </body>
2304: </html>|;
2305: close(FILE);
1.1 raeburn 2306: }
2307:
2308: 1;
2309: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to imsprocessor.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / imspackages