File:
[LON-CAPA] /
loncom /
imspackages /
imsprocessor.pm
Revision
1.48:
download - view:
text,
annotated -
select for diffs
Mon Aug 17 03:52:09 2009 UTC (14 years, 8 months ago) by
raeburn
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
loncapaMITrelate_1,
bz6209-base,
bz6209,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2
- CMS option "ANGEL" changed to "ANGEL 5.5" to emphasize that existing support is for the IMS packages generated by the 5.5 version.
(More recent releases create IMS content packages with different packaging).
1: # The LearningOnline Network with CAPA
2: # Processor for IMS Packages
3: #
4: # $Id: imsprocessor.pm,v 1.48 2009/08/17 03:52:09 raeburn Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28:
29: package Apache::imsprocessor;
30:
31: use Apache::lonnet;
32: use Apache::loncleanup;
33: use Apache::lonlocal;
34: use LWP::UserAgent;
35: use HTTP::Request::Common;
36: use LONCAPA::Configuration;
37: use strict;
38:
39: sub ims_config {
40: my ($areas,$cmsmap,$areaname) = @_;
41: @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users","question");
42: %{$$cmsmap{bb5}} = (
43: announce => 'resource/x-bb-announcement',
44: board => 'resource/x-bb-discussionboard',
45: doc => 'resource/x-bb-document',
46: extlink => 'resource/x-bb-externallink',
47: pool => 'assessment/x-bb-pool',
48: quiz => 'assessment/x-bb-quiz',
49: staff => 'resource/x-bb-staffinfo',
50: survey => 'assessment/x-bb-survey',
51: users => 'course/x-bb-user',
52: );
53: %{$$cmsmap{bb6}} = (
54: announce => 'resource/x-bb-announcement',
55: board => 'resource/x-bb-discussionboard',
56: doc => 'resource/x-bb-document',
57: extlink => 'resource/x-bb-externallink',
58: pool => 'assessment/x-bb-qti-pool',
59: quiz => 'assessment/x-bb-qti-test',
60: staff => 'resource/x-bb-staffinfo',
61: survey => 'assessment/x-bb-survey',
62: users => 'course/x-bb-user',
63: );
64: $$cmsmap{bb6}{conference} = 'resource/x-bb-conference';
65: %{$$cmsmap{angel5}} = (
66: board => 'BOARD',
67: extlink => 'LINK',
68: msg => 'MESSAGE',
69: quiz => 'QUIZ',
70: survey => 'FORM',
71: );
72: @{$$cmsmap{angel5}{doc}} = ('FILE','PAGE');
73: %{$$cmsmap{webctce4}} = (
74: quiz => 'webctquiz',
75: survey => 'webctsurvey',
76: doc => 'webcontent'
77: );
78: %{$$cmsmap{webctvista4}} = (
79: question => 'webct.question',
80: quiz => 'webct.assessment',
81: survey => 'webctsurvey',
82: doc => 'webcontent'
83: );
84: %{$areaname} = &Apache::lonlocal::texthash (
85: announce => 'Announcements',
86: board => 'Discussion Boards',
87: doc => 'Documents, pages, and folders',
88: extlink => 'Links to external sites',
89: pool => 'Question pools',
90: quiz => 'Quizzes',
91: question => 'Assessment Questions',
92: staff => 'Staff information',
93: survey => 'Surveys',
94: users => 'Enrollment',
95: );
96: }
97:
98: sub create_tempdir {
99: my ($context,$pathinfo,$timenow) = @_;
100: my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
101: my $tempdir;
102: if ($context eq 'DOCS') {
103: $tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
104: if (!-e "$tempdir") {
105: mkdir("$tempdir",0770);
106: }
107: $tempdir .= '/'.$timenow;
108: if (!-e "$tempdir") {
109: mkdir("$tempdir",0770);
110: }
111: } elsif ($context eq "CSTR") {
112: if (!-e "$pathinfo/temp") {
113: mkdir("$pathinfo/temp",0770);
114: }
115: $tempdir = $pathinfo.'/temp';
116: }
117: return $tempdir;
118: }
119:
120: sub uploadzip {
121: my ($context,$tempdir,$source) = @_;
122: my $fname;
123: if ($context eq 'DOCS') {
124: $fname=$env{'form.uploadname.filename'};
125: # Replace Windows backslashes by forward slashes
126: $fname=~s/\\/\//g;
127: # Get rid of everything but the actual filename
128: $fname=~s/^.*\/([^\/]+)$/$1/;
129: # Replace spaces by underscores
130: $fname=~s/\s+/\_/g;
131: # Replace all other weird characters by nothing
132: $fname=~s/[^\w\.\-]//g;
133: # See if there is anything left
134: unless ($fname) { return 'error: no uploaded file'; }
135: # Save the file
136: chomp($env{'form.uploadname'});
137: open(my $fh,'>'.$tempdir.'/'.$fname);
138: print $fh $env{'form.uploadname'};
139: close($fh);
140: } elsif ($context eq 'CSTR') {
141: if ($source =~ m/\/([^\/]+)$/) {
142: $fname = $1;
143: my $destination = $tempdir.'/'.$fname;
144: rename($source,$destination);
145: }
146: }
147: return $fname;
148: }
149:
150: sub expand_zip {
151: my ($tempdir,$filename) = @_;
152: my $zipfile = "$tempdir/$filename";
153: if (!-e "$zipfile") {
154: return 'no zip';
155: }
156: if ($filename =~ m|\.zip$|i) {
157: open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null |");
158: close(OUTPUT);
159: } else {
160: return 'nozip';
161: }
162: if ($filename =~ m|\.zip$|i) {
163: unlink($zipfile);
164: }
165: return 'ok';
166: }
167:
168: sub process_manifest {
169: my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo,$phase,$includedres,$includeditems) = @_;
170: my %toc = (
171: bb6 => 'organization',
172: bb5 => 'tableofcontents',
173: angel5 => 'organization',
174: webctce4 => 'organization',
175: webctvista4 => 'organization'
176: );
177: my @seq = "Top";
178: %{$$items{'Top'}} = (
179: contentscount => 0,
180: resnum => 'toplevel',
181: );
182: %{$$resources{'toplevel'}} = (
183: revitm => 'Top'
184: );
185:
186: if ($cms eq 'angel5') {
187: $$resources{'toplevel'}{type} = "FOLDER";
188: } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
189: $$resources{'toplevel'}{type} = 'resource/x-bb-document';
190: } else {
191: $$resources{'toplevel'}{type} = 'webcontent';
192: }
193:
194: unless (-e "$tempdir/imsmanifest.xml") {
195: return 'nomanifest';
196: }
197:
198: my $xmlfile = $tempdir.'/imsmanifest.xml';
199: &parse_manifest($cms,$phase,$tempdir,$xmlfile,\%toc,$includedres,
200: $includeditems,$items,$resources,$resinfo,$hrefs,\@seq);
201: return 'ok' ;
202: }
203:
204: sub parse_manifest {
205: my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,
206: $resources,$resinfo,$hrefs,$seq) = @_;
207: my @state = ();
208: my $itm = '';
209: my %contents = ();
210: my $identifier = '';
211: my @allidentifiers = ();
212: my $lastitem;
213: my $p = HTML::Parser->new
214: (
215: xml_mode => 1,
216: start_h =>
217: [sub {
218: my ($tagname, $attr) = @_;
219: push @state, $tagname;
220: my $start = @state - 3;
221: if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $$toc{$cms}) ) {
222: if ($state[-1] eq 'item') {
223: $itm = $attr->{identifier};
224: if ($$includeditems{$itm} || $phase ne 'build') {
225: %{$$items{$itm}} = ();
226: $$items{$itm}{contentscount} = 0;
227: @{$$items{$itm}{contents}} = ();
228: if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webctce4' || $cms eq 'webctvista4') {
229: $$items{$itm}{resnum} = $attr->{identifierref};
230: if ($cms eq 'bb5') {
231: $$items{$itm}{title} = $attr->{title};
232: }
233: } elsif ($cms eq 'angel5') {
234: if ($attr->{identifierref} =~ m/^res(.+)$/) {
235: $$items{$itm}{resnum} = $1;
236: }
237: }
238: unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
239: %{$$resources{$$items{$itm}{resnum}}} = ();
240: }
241: $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
242: if ($start > @{$seq}) {
243: unless ($lastitem eq '') {
244: push @{$seq}, $lastitem;
245: unless ( defined($contents{$$seq[-1]}) ) {
246: @{$contents{$$seq[-1]}} = ();
247: }
248: push @{$contents{$$seq[-1]}},$itm;
249: $$items{$itm}{parentseq} = $$seq[-1];
250: }
251: } elsif ($start < @{$seq}) {
252: my $diff = @{$seq} - $start;
253: while ($diff > 0) {
254: pop @{$seq};
255: $diff --;
256: }
257: if (@{$seq}) {
258: push @{$contents{$$seq[-1]}}, $itm;
259: }
260: } else {
261: push @{$contents{$$seq[-1]}}, $itm;
262: }
263: my $path;
264: if (@{$seq} > 1) {
265: $path = join(',',@{$seq});
266: } elsif (@{$seq} > 0) {
267: $path = $$seq[0];
268: }
269: $$items{$itm}{filepath} = $path;
270: if ($cms eq 'bb5' || $cms eq 'bb6') {
271: if ($$items{$itm}{filepath} eq 'Top') {
272: $$items{$itm}{resnum} = $itm;
273: $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
274: $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
275: $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
276: }
277: }
278: $$items{$$seq[-1]}{contentscount} ++;
279: $$resources{$$items{$itm}{resnum}}{seqref} = $seq;
280: $lastitem = $itm;
281: }
282: }
283: if ($cms eq 'webctce4') {
284: if (($state[-1] eq "webct:properties") && (@state > 4)) {
285: $$items{$itm}{properties} = $attr->{identifierref};
286: }
287: }
288: } elsif ("@state" eq "manifest resources resource" ) {
289: $identifier = $attr->{identifier};
290: push(@allidentifiers,$identifier);
291: if ($$includedres{$identifier} || $phase ne 'build') {
292: if ($cms eq 'bb5' || $cms eq 'bb6') {
293: $$resources{$identifier}{file} = $attr->{file};
294: $$resources{$identifier}{type} = $attr->{type};
295: } elsif ($cms eq 'webctce4') {
296: $$resources{$identifier}{type} = $attr->{type};
297: $$resources{$identifier}{file} = $attr->{href};
298: } elsif ($cms eq 'webctvista4') {
299: $$resources{$identifier}{type} = $attr->{type};
300: $$resources{$identifier}{'webct:coType'} = $attr->{'webct:coType'};
301: } elsif ($cms eq 'angel5') {
302: $identifier = substr($identifier,3);
303: if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
304: $$resources{$identifier}{file} = $1;
305: }
306: }
307: @{$$hrefs{$identifier}} = ();
308: }
309: } elsif ("@state" eq "manifest resources resource file") {
310: if ($$includedres{$identifier} || $phase ne 'build') {
311: if ($cms eq 'webctvista4') {
312: $$resources{$identifier}{file} = $attr->{href};
313: }
314: if ($cms eq 'bb5' || $cms eq 'bb6' ||
315: $cms eq 'webctce4' || $cms eq 'webctvista4') {
316: push @{$$hrefs{$identifier}},$attr->{href};
317: if ($$resources{$identifier}{type} eq
318: 'webct.manifest') {
319: my $manifestfile = $tempdir.'/'.$attr->{href};
320: my $currseqref = [];
321: if ($itm) {
322: $currseqref =
323: $$resources{$$items{$itm}{resnum}}{seqref};
324: }
325: &parse_manifest($cms,$phase,$tempdir,$manifestfile,
326: $toc,$includedres,$includeditems,
327: $items,$resources,$resinfo,
328: $hrefs,$currseqref);
329: }
330: } elsif ($cms eq 'angel5') {
331: if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
332: push @{$$hrefs{$identifier}},$1;
333: } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
334: $$resources{$identifier}{type} = $1;
335: }
336: }
337: }
338: } elsif ("@state" eq "manifest webct:ContentObject") {
339: foreach my $ident (@allidentifiers) {
340: if ($$resources{$ident}{type} eq 'ims_qtiasiv1p2') {
341: $$resources{$ident}{type} = $attr->{'webct:coType'};
342: }
343: }
344: }
345: }, "tagname, attr"],
346: text_h =>
347: [sub {
348: my ($text) = @_;
349: if ("@state" eq "manifest metadata lom general title langstring") {
350: $$items{'Top'}{title} = $text;
351: }
352: if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $$toc{$cms} && $state[-1] eq "title") {
353: if ($$includeditems{$itm} || $phase ne 'build') {
354: if ($cms eq 'angel5' || $cms eq 'bb6' || $cms eq 'webctvista4') {
355: $$items{$itm}{title} = $text;
356: }
357: if ($cms eq 'webctce4') {
358: $$items{$itm}{title} = $text;
359: $$items{$itm}{title} =~ s/(<[^>]*>)//g;
360: }
361: }
362: }
363: }, "dtext"],
364: end_h =>
365: [sub {
366: my ($tagname) = @_;
367: pop @state;
368: }, "tagname"],
369: );
370: $p->parse_file($xmlfile);
371: $p->eof;
372: foreach my $itm (keys %contents) {
373: @{$$items{$itm}{contents}} = @{$contents{$itm}};
374: }
375: }
376:
377: sub get_imports {
378: my ($includeditems,$items,$resources,$importareas,$itm) = @_;
379: if (exists($$items{$itm}{resnum})) {
380: if ($$importareas{$$resources{$$items{$itm}{resnum}}{type}}) {
381: unless (exists($$includeditems{$itm})) {
382: $$includeditems{$itm} = 1;
383: }
384: }
385: }
386: if ($$items{$itm}{contentscount} > 0) {
387: foreach my $child (@{$$items{$itm}{contents}}) {
388: &get_imports($includeditems,$items,$resources,$importareas,$child);
389: }
390: }
391: }
392:
393: sub get_parents {
394: my ($includeditems,$items,$itm) = @_;
395: my @pathitems = ();
396: if ($$items{$itm}{filepath} =~ m/,/) {
397: @pathitems = split/,/,$$items{$itm}{filepath};
398: } else {
399: $pathitems[0] = $$items{$itm}{filepath};
400: }
401: foreach (@pathitems) {
402: $$includeditems{$_} = 1;
403: }
404: }
405:
406: sub target_resources {
407: my ($resources,$oktypes,$targets) = @_;
408: foreach my $key (keys %{$resources}) {
409: if ( defined($$oktypes{$$resources{$key}{type}}) ) {
410: push @{$targets}, $key;
411: }
412: }
413: return;
414: }
415:
416: sub copy_resources {
417: my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
418: if ($context eq 'DOCS') {
419: foreach my $key (sort keys %{$hrefs}) {
420: if (grep/^$key$/,@{$targets}) {
421: %{$$url{$key}} = ();
422: foreach my $file (@{$$hrefs{$key}}) {
423: my $source = $tempdir.'/'.$key.'/'.$file;
424: if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
425: $source = $tempdir.'/'.$file;
426: }
427: my $filename = '';
428: my $fpath = $timenow.'/resfiles/'.$key.'/';
429: if ($cms eq 'angel5') {
430: if ($file eq 'pg'.$key.'.htm') {
431: next;
432: }
433: }
434: $file =~ s-\\-/-g;
435: my $copyfile = $file;
436: if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
437: if ($file =~ m-/my_files/(.+)$-) {
438: $copyfile = $1;
439: }
440: }
441: unless ((($cms eq 'webctce4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) || (($cms eq 'webctvista4') && (grep/^$key$/,@{$assessmentfiles}) && $file =~ /\.xml$/)) {
442: $copyfile = $fpath.$copyfile;
443: my $fileresult;
444: if (-e $source) {
445: $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$copyfile,$source);
446: }
447: }
448: }
449: }
450: }
451: } elsif ($context eq 'CSTR') {
452: if (!-e "$destdir/resfiles") {
453: mkdir("$destdir/resfiles",0770);
454: }
455: foreach my $key (sort keys %{$hrefs}) {
456: if (grep/^$key$/,@{$targets}) {
457: foreach my $file (@{$$hrefs{$key}}) {
458: $file =~ s-\\-/-g;
459: if ( ($cms eq 'angel5' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6')) {
460: if (!-e "$destdir/resfiles/$key") {
461: mkdir("$destdir/resfiles/$key",0770);
462: }
463: my $filepath = $file;
464: my $front = '';
465: while ($filepath =~ m-(\w+)/(.+)-) {
466: $front .= $1.'/';
467: $filepath = $2;
468: my $fulldir = "$destdir/resfiles/$key/$front";
469: chop($fulldir);
470: if (!-e "$fulldir") {
471: mkdir("$fulldir",0770);
472: }
473: }
474: my $renameres;
475: if ($cms eq 'angel5') {
476: $renameres = rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
477: } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
478: $renameres = rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
479: }
480: if ($renameres) {
481: if (ref($total) eq 'HASH') {
482: $$total{'file'} ++;
483: }
484: } else {
485: &Apache::lonnet::logthis("IMS import error: $cms - renaming failed for file $file");
486: }
487: } elsif ($cms eq 'webctce4') {
488: if ($file =~ m-/my_files/(.+)$-) {
489: my $copyfile = $1;
490: if ($copyfile =~ m-^[^/]+/[^/]+-) {
491: my @dirs = split/\//,$copyfile;
492: my $path = "$destdir/resfiles";
493: while (@dirs > 1) {
494: $path .= '/'.$dirs[0];
495: if (!-e "$path") {
496: mkdir("$path",0755);
497: }
498: shift @dirs;
499: }
500: }
501: if (-e "$tempdir/$file") {
502: my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
503: if ($renameres) {
504: if (ref($total) eq 'HASH') {
505: $$total{'file'} ++;
506: }
507: } else {
508: &Apache::lonnet::logthis("IMS import error: WebCT4 - renaming failed for file $file");
509: }
510: }
511: } elsif ($file !~ m-/data/(.+)$-) {
512: &Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
513: }
514: }
515: }
516: }
517: }
518: }
519: }
520:
521: sub process_resinfo {
522: my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles,$randompicks) = @_;
523: my $board_id = time;
524: my $board_count = 0;
525: my $dbparse = 0;
526: my $announce_handling = 'include';
527: my $longcrs = '';
528: my %allassessments = ();
529: my %allquestions = ();
530: my %qzdbsettings = ();
531: my %catinfo = ();
532: if ($crs =~ m/^(\d)(\d)(\d)/) {
533: $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
534: }
535: if ($context eq 'CSTR') {
536: if (!-e "$destdir/resfiles") {
537: mkdir("$destdir/resfiles",0770);
538: }
539: }
540: if ($cms eq 'angel5') {
541: my $currboard = '';
542: foreach my $key (sort keys %{$resources}) {
543: if (grep/^$key$/,@{$targets}) {
544: if ($$resources{$key}{type} eq "BOARD") {
545: push @{$boards}, $key;
546: $$boardnum{$$resources{$key}{revitm}} = $board_count;
547: $currboard = $key;
548: @{$$messages{$key}} = ();
549: $$timestamp[$board_count] = $board_id;
550: $board_id ++;
551: $board_count ++;
552: } elsif ($$resources{$key}{type} eq "MESSAGE") {
553: push @{$$messages{$currboard}}, $key;
554: } elsif ($$resources{$key}{type} eq "PAGE" || $$resources{$key}{type} eq "LINK") {
555: %{$$resinfo{$key}} = ();
556: &angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
557: } elsif ($$resources{$key}{type} eq "QUIZ") {
558: %{$$resinfo{$key}} = ();
559: push @{$quizzes}, $key;
560: # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
561: } elsif ($$resources{$key}{type} eq "FORM") {
562: %{$$resinfo{$key}} = ();
563: push @{$surveys}, $key;
564: # &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
565: } elsif ($$resources{$key}{type} eq "DROPBOX") {
566: %{$$resinfo{$key}} = ();
567: }
568: }
569: }
570: } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
571: foreach my $key (sort keys %{$resources}) {
572: if (grep/^$key$/,@{$targets}) {
573: if ($$resources{$key}{type} eq "resource/x-bb-document") {
574: unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
575: %{$$resinfo{$key}} = ();
576: &process_content($cms,$key,$context,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles,$packages,$hrefs);
577: }
578: } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {
579: %{$$resinfo{$key}} = ();
580: &process_staff($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
581: } elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") {
582: %{$$resinfo{$key}} = ();
583: &process_link($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
584: } elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") {
585: %{$$resinfo{$key}} = ();
586: unless ($db_handling eq 'ignore') {
587: push @{$boards}, $key;
588: $$timestamp[$board_count] = $board_id;
589: &process_db($key,$docroot,$destdir,$board_id,$crs,$cdom,$db_handling,$uname,\%{$$resinfo{$key}},$longcrs);
590: $board_id ++;
591: $board_count ++;
592: }
593: } elsif ($$resources{$key}{type} =~/assessment\/x\-bb\-(qti\-)?pool/) {
594: %{$$resinfo{$key}} = ();
595: &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
596: push @{$pools}, $key;
597: } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?quiz/) {
598: %{$$resinfo{$key}} = ();
599: &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
600: push @{$quizzes}, $key;
601: } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?survey/) {
602: %{$$resinfo{$key}} = ();
603: &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
604: push @{$surveys}, $key;
605: } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
606: %{$$resinfo{$key}} = ();
607: push @{$groups}, $key;
608: &process_group($key,$docroot,$destdir,\%{$$resinfo{$key}});
609: } elsif ($$resources{$key}{type} eq "resource/x-bb-user") {
610: %{$$resinfo{$key}} = ();
611: unless ($user_handling eq 'ignore') {
612: &process_user($key,$docroot,$destdir,\%{$$resinfo{$key}},$crs,$cdom,$user_handling);
613: }
614: } elsif ($$resources{$key}{type} eq "resource/x-bb-announcement") {
615: unless ($announce_handling eq 'ignore') {
616: push @{$announcements}, $key;
617: %{$$resinfo{$key}} = ();
618: &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
619: }
620: }
621: }
622: }
623: if (@{$announcements}) {
624: $$items{'Top'}{'contentscount'} ++;
625: }
626: if (@{$boards}) {
627: $$items{'Top'}{'contentscount'} ++;
628: }
629: if (@{$quizzes}) {
630: $$items{'Top'}{'contentscount'} ++;
631: }
632: if (@{$surveys}) {
633: $$items{'Top'}{'contentscount'} ++;
634: }
635: if (@{$pools}) {
636: $$items{'Top'}{'contentscount'} ++;
637: }
638: } elsif ($cms eq 'webctce4') {
639: foreach my $key (sort keys %{$resources}) {
640: if (grep/^$key$/,@{$targets}) {
641: if ($$resources{$key}{type} eq "webcontent") {
642: %{$$resinfo{$key}} = ();
643: if ($$resources{$key}{file} eq 'questiondb.xml') {
644: &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
645: } else {
646: &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
647: }
648: } elsif ($$resources{$key}{type} eq "webctquiz") {
649: &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
650: }
651: }
652: }
653: } elsif ($cms eq 'webctvista4') {
654: foreach my $key (sort keys %{$resources}) {
655: if (grep/^$key$/,@{$targets}) {
656: %{$$resinfo{$key}} = ();
657: if ($$resources{$key}{type} eq 'webct.question') {
658: $allquestions{$key} = 1;
659: } elsif ($$resources{$key}{type} eq 'webct.assessment') {
660: $allassessments{$key} = 1;
661: }
662: }
663: }
664: if (keys(%allassessments) > 0) {
665: foreach my $key (sort(keys(%allassessments))) {
666: &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
667: }
668: } elsif (keys(%allquestions) > 0) {
669: my %catinfo = ();
670: my @allids = ();
671: my @allquestids = ();
672: my %allanswers = ();
673: my %allchoices = ();
674: my $containerdir;
675: my $newdir;
676: my $cid;
677: my $randompickflag = 0;
678: if ($context eq 'DOCS') {
679: $cid = $env{'request.course.id'};
680: }
681: my $destresdir = $destdir;
682: if ($context eq 'CSTR') {
683: $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
684: } elsif ($context eq 'DOCS') {
685: $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
686: }
687: foreach my $res (sort(keys(%allquestions))) {
688: my $parent = $allquestions{$res};
689: &parse_webctvista4_question($res,$docroot,$resources,$hrefs,\%qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,\%catinfo);
690: }
691: &build_category_sequences($destdir,\%catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$crs,\%qzdbsettings);
692: &write_webct4_questions($cms,\@allquestids,$context,\%qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$crs,$destdir,\%catinfo);
693: }
694: }
695:
696: $$total{'board'} = $board_count;
697: $$total{'quiz'} = @{$quizzes};
698: $$total{'surv'} = @{$surveys};
699: $$total{'pool'} = @{$pools};
700: }
701:
702: sub build_structure {
703: my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems,$randompicks) = @_;
704: my %flag = ();
705: my %count = ();
706: my %pagecontents = ();
707: my %seqtext = ();
708: my $topnum = 0;
709: my $topspecials = @$announcements + @$boards + @$quizzes + @$surveys + @$pools;
710:
711: if (!-e "$destdir") {
712: mkdir("$destdir",0755);
713: }
714: if (!-e "$destdir/sequences") {
715: mkdir("$destdir/sequences",0770);
716: }
717: if (!-e "$destdir/resfiles") {
718: mkdir("$destdir/resfiles",0770);
719: }
720: if (!-e "$destdir/pages") {
721: mkdir("$destdir/pages",0770);
722: }
723: if (!-e "$destdir/problems") {
724: mkdir("$destdir/problems",0770);
725: }
726:
727: $seqtext{'Top'} = qq|<map>\n|;
728: %{$$resinfo{$$items{'Top'}{resnum}}} = (
729: isfolder => 'true',
730: );
731:
732: my $srcstem = "";
733:
734: if ($context eq 'DOCS') {
735: $srcstem = "/uploaded/$cdom/$crs/$timenow";
736: } elsif ($context eq 'CSTR') {
737: $srcstem = "/res/$udom/$uname/$newdir";
738: }
739:
740: foreach my $key (sort keys %{$items}) {
741: if ($$includeditems{$key}) {
742: %{$flag{$key}} = (
743: page => 0,
744: seq => 0,
745: board => 0,
746: file => 0,
747: );
748:
749: %{$count{$key}} = (
750: page => -1,
751: seq => 0,
752: board => 0,
753: file => 0,
754: );
755:
756: my $src = "";
757:
758: my $next_id = 2;
759: my $curr_id = 1;
760: my $resnum = $$items{$key}{resnum};
761: my $type = $$resources{$resnum}{type};
762: my $contentscount = $$items{$key}{'contentscount'};
763: my $seqtitle = $$items{$key}{'title'};
764: $seqtitle =~ s|/+|_|g;
765: $seqtitle =~ s/\s+/_/g;
766: $seqtitle .= '_'.$key;
767: if (($cms eq 'angel5' && $type eq "FOLDER") || (($cms eq 'bb5' || $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) || ($cms eq 'webctce4' && $contentscount > 0)) {
768: unless (($cms eq 'bb5') && $key eq 'Top') {
769: $seqtext{$key} = "<map>\n";
770: }
771: if ($contentscount == 0) {
772: if ($key eq 'Top') {
773: unless ($topspecials) {
774: $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
775: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
776: <resource id="$next_id" src="" type="finish"></resource>\n|;
777: }
778: } else {
779: $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
780: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
781: <resource id="$next_id" src="" type="finish"></resource>\n|;
782: }
783: } else {
784: my $contcount = 0;
785: if (defined($$items{$key}{contents})) {
786: $contcount = @{$$items{$key}{contents}};
787: } else {
788: &Apache::lonnet::logthis("IMS Import error for item: $key- contents count = $contentscount, but identity of contents not defined.");
789: }
790: my $contitem = $$items{$key}{contents}[0];
791: my $contitemcount = $$items{$contitem}{contentscount};
792: my ($res,$itm,$type,$file);
793: if (exists($$items{$contitem}{resnum})) {
794: $res = $$items{$contitem}{resnum};
795: $itm = $$resources{$res}{revitm};
796: $type = $$resources{$res}{type};
797: $file = $$resources{$res}{file};
798: }
799: my $title = $$items{$contitem}{title};
800: my $packageflag = 0;
801: if (grep/^$res$/,@{$packages}) {
802: $packageflag = 1;
803: }
804: $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
805: unless ($flag{$key}{page} == 1) {
806: if ($$randompicks{$contitem}) {
807: $seqtext{$key} .= qq|
808: <param to="$curr_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n|;
809: }
810: $seqtext{$key} .= qq|<resource id="$curr_id" src="$src" title="$title" type="start"|;
811: unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
812: $flag{$key}{page} = 1;
813: }
814: if ($key eq 'Top') {
815: push @{$topurls}, $src;
816: push @{$topnames}, $title;
817: }
818: }
819: if ($contcount == 1) {
820: $seqtext{$key} .= qq|></resource>
821: <link from="$curr_id" to="$next_id" index="$curr_id"></link>|;
822: if ($key eq 'Top') {
823: unless ($topspecials) {
824: $seqtext{$key} .= qq|
825: <resource id="$next_id" src="" type="finish"></resource>\n|;
826: }
827: } else {
828: $seqtext{$key} .= qq|
829: <resource id="$next_id" src="" type="finish"></resource>\n|;
830: }
831: } else {
832: if ($contcount > 2 ) {
833: for (my $i=1; $i<$contcount-1; $i++) {
834: my $contitem = $$items{$key}{contents}[$i];
835: my $contitemcount = $$items{$contitem}{contentscount};
836: my $res = $$items{$contitem}{resnum};
837: my $type = $$resources{$res}{type};
838: my $file = $$resources{$res}{file};
839: my $title = $$items{$contitem}{title};
840: my $packageflag = 0;
841: if (grep/^$res$/,@{$packages}) {
842: $packageflag = 1;
843: }
844: $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
845: unless ($flag{$key}{page} == 1) {
846: $seqtext{$key} .= qq|></resource>
847: <link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
848: if ($$randompicks{$contitem}) {
849: $seqtext{$key} .= qq|
850: <param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>|;
851: }
852: $seqtext{$key} .= qq|
853: <resource id="$next_id" src="$src" title="$title"|;
854: $curr_id ++;
855: $next_id ++;
856: unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
857: $flag{$key}{page} = 1;
858: }
859: if ($key eq 'Top') {
860: push @{$topurls}, $src;
861: push @{$topnames}, $title;
862: }
863: }
864: }
865: }
866: my $contitem = $$items{$key}{contents}[-1];
867: my $contitemcount = $$items{$contitem}{contentscount};
868: my $res = $$items{$contitem}{resnum};
869: my $type = $$resources{$res}{type};
870: my $file = $$resources{$res}{file};
871: my $title = $$items{$contitem}{title};
872: my $packageflag = 0;
873: if (grep/^$res$/,@{$packages}) {
874: $packageflag = 1;
875: }
876: $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
877:
878: if ($flag{$key}{page}) {
879: if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
880: $seqtext{$key} .= qq|></resource>
881: <link from="$curr_id" index="$curr_id" to="$next_id">
882: <resource id ="$next_id" src="" |;
883: }
884: } else {
885: $seqtext{$key} .= qq|></resource>
886: <link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
887: if ($$randompicks{$contitem}) {
888: $seqtext{$key} .= qq|
889: <param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n|;
890: }
891: $seqtext{$key} .= qq|
892: <resource id="$next_id" src="$src" title="$title" |;
893: if ($key eq 'Top') {
894: push @{$topurls}, $src;
895: push @{$topnames}, $title;
896: }
897: }
898: if ($contcount == $$items{$key}{contentscount}) {
899: $seqtext{$key} .= qq|type="finish"></resource>\n|;
900: } else {
901: $curr_id ++;
902: $next_id ++;
903: $seqtext{$key} .= qq|></resource>
904: <link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
905: }
906: }
907: }
908: unless (($cms eq 'bb5') && $key eq 'Top') {
909: $seqtext{$key} .= "</map>\n";
910: if ($cms eq 'webctce4' && $key ne 'Top') {
911: push @{$seqfiles}, "$seqtitle.sequence";
912: open(LOCFILE,">$destdir/sequences/$seqtitle.sequence");
913: } else {
914: push @{$seqfiles}, "$key.sequence";
915: open(LOCFILE,">$destdir/sequences/$key.sequence");
916: }
917: print LOCFILE $seqtext{$key};
918: close(LOCFILE);
919: }
920: $count{$key}{page} ++;
921: $$total{page} += $count{$key}{page};
922: }
923: $$total{seq} += $count{$key}{seq};
924: }
925: }
926: $topnum += ($count{'Top'}{page} + $count{'Top'}{seq});
927:
928: if ($cms eq 'bb5' || $cms eq 'bb6') {
929: if (@{$announcements} > 0) {
930: &process_specials($context,'announcements',$announcements,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
931: }
932: if (@{$boards} > 0) {
933: &process_specials($context,'boards',$boards,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
934: }
935: if (@{$quizzes} > 0) {
936: &process_specials($context,'quizzes',$quizzes,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
937: }
938: if (@{$surveys} > 0) {
939: &process_specials($context,'surveys',$surveys,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
940: }
941: if (@{$pools} > 0) {
942: &process_specials($context,'pools',$pools,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
943: }
944: $seqtext{'Top'} .= "</map>\n";
945: open(TOPFILE,">$destdir/sequences/Top.sequence");
946: print TOPFILE $seqtext{'Top'};
947: close(TOPFILE);
948: push @{$seqfiles}, 'Top.sequence';
949: }
950:
951: my $filestem;
952: if ($context eq 'DOCS') {
953: $filestem = "/uploaded/$cdom/$crs/$timenow";
954: } elsif ($context eq 'CSTR') {
955: $filestem = "/res/$udom/$uname/$newdir";
956: }
957:
958: foreach my $key (sort keys %pagecontents) {
959: for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
960: my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
961: my $resource = "$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html";
962: my $res = $$items{$pagecontents{$key}[$i][0]}{resnum};
963: my $resource = $filestem.'/resfiles/'.$res.'.html';
964: if (grep/^$res$/,@{$packages}) {
965: $resource = $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point
966: }
967: open(PAGEFILE,">$filename");
968: print PAGEFILE qq|<map>
969: <resource src="$resource" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>
970: <link to="2" index="1" from="1">\n|;
971: if (@{$pagecontents{$key}[$i]} == 1) {
972: print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|;
973: } elsif (@{$pagecontents{$key}[$i]} == 2) {
974: my $res = $$items{$pagecontents{$key}[$i][1]}{resnum};
975: my $resource = $filestem.'/resfiles/'.$res.'.html';
976: if (grep/^$res$/,@{$packages}) {
977: $resource = $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point
978: }
979: print PAGEFILE qq|<resource src="$resource" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|;
980: } else {
981: for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
982: my $curr_id = $j+1;
983: my $next_id = $j+2;
984: my $res = $$items{$pagecontents{$key}[$i][$j]}{resnum};
985: my $resource = $filestem.'/resfiles/'.$res.'.html';
986: if (grep/^$res$/,@{$packages}) {
987: $resource = $filestem.'/resfiles/'.$res.'./index.html'; # entry_point
988: }
989: print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$$items{$pagecontents{$key}[$i][$j]}{title}"></resource>
990: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
991: }
992: my $final_id = @{$pagecontents{$key}[$i]};
993: my $res = $$items{$pagecontents{$key}[$i][-1]}{resnum};
994: my $resource = $filestem.'/resfiles/'.$res.'.html';
995: if (grep/^$res$/,@{$packages}) {
996: $resource = $filestem.'/resfiles/'.$res.'./index.html'; # entry_point
997: }
998: print PAGEFILE qq|<resource src="$resource" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;
999: }
1000: print PAGEFILE "</map>";
1001: close(PAGEFILE);
1002: push @{$pagesfiles}, $key.'_'.$i.'.page';
1003: }
1004: }
1005: }
1006:
1007: sub make_structure {
1008: my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick,$title) = @_;
1009: my $src ='';
1010: if (($cms eq 'angel5' && $type eq 'FOLDER') || (($cms eq 'bb5' || $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') || $key eq 'Top')) || ($cms eq 'webctce4' && $contitemcount > 0)) {
1011: $src = $srcstem.'/sequences/'.$contitem.'.sequence';
1012: if ($cms eq 'webctce4') {
1013: $title =~ s|/+|_|g;
1014: $title =~ s/\s+/_/g;
1015: $title .= '_'.$contitem;
1016: $src = $srcstem.'/sequences/'.$title.'.sequence';
1017: }
1018: $$flag{$key}{page} = 0;
1019: $$flag{$key}{seq} = 1;
1020: $$count{$key}{seq} ++;
1021: } elsif ($cms eq 'webctce4' && $randompick) {
1022: $src = $srcstem.'/sequences/'.$res.'.sequence';
1023: $$flag{$key}{page} = 0;
1024: $$flag{$key}{seq} = 1;
1025: $$count{$key}{seq} ++;
1026: } elsif ($cms eq 'angel5' && $type eq 'BOARD') {
1027: $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';
1028: $$flag{$key}{page} = 0;
1029: $$flag{$key}{board} = 1;
1030: $$count{$key}{board} ++;
1031: } elsif ($cms eq 'angel5' && $type eq "FILE") {
1032: foreach my $file (@{$$hrefs{$res}}) {
1033: unless ($file eq 'pg'.$res.'.htm') {
1034: $src = $srcstem.'/resfiles/'.$res.'/'.$file;
1035: }
1036: }
1037: $$flag{$key}{page} = 0;
1038: $$flag{$key}{file} = 1;
1039: } elsif ($cms eq 'angel5' && (($type eq "PAGE") || ($type eq "LINK")) ) {
1040: if ($$flag{$key}{page}) {
1041: if ($$count{$key}{page} == -1) {
1042: &Apache::lonnet::logthis("IMS Angel import error in array index for page: value = -1, resource is $key, type is $type.");
1043: } else {
1044: push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
1045: }
1046: } else {
1047: $$count{$key}{page} ++;
1048: $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
1049: @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
1050: $$flag{$key}{seq} = 0;
1051: }
1052: } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
1053: if ($$flag{$key}{page}) {
1054: push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
1055: } else {
1056: if ($contcount == 1) {
1057: if ($packageflag) {
1058: $src = $srcstem.'/resfiles/'.$res.'/index.html'; # Needs to be entry point
1059: } else {
1060: $src = $srcstem.'/resfiles/'.$res.'.html';
1061: }
1062: } else {
1063: $$count{$key}{page} ++;
1064: $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
1065: @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
1066: }
1067: $$flag{$key}{seq} = 0;
1068: }
1069: } elsif ($cms eq 'webctce4') {
1070: if ($type eq 'webctquiz') {
1071: $src = $srcstem.'/pages/'.$res.'.page';
1072: $$count{$key}{page} ++;
1073: $$flag{$key}{seq} = 0;
1074: } else {
1075: if (grep/^$file$/,@{$$hrefs{$res}}) {
1076: my $filename;
1077: if ($file =~ m-/([^/]+)$-) {
1078: $filename = $1;
1079: }
1080: $src = $srcstem.'/resfiles/'.$filename;
1081: } else {
1082: foreach my $file (@{$$hrefs{$res}}) {
1083: my $filename;
1084: if ($file =~ m-/my_files/(.+)$-) {
1085: $filename = $1;
1086: } elsif ($file =~ m-/([^/]+)$-) {
1087: $filename = $1;
1088: }
1089: $src = $srcstem.'/resfiles/'.$filename;
1090: }
1091: }
1092: $$flag{$key}{page} = 0;
1093: $$flag{$key}{file} = 1;
1094: }
1095: }
1096: return $src;
1097: }
1098:
1099:
1100: # ---------------------------------------------------------------- Process Blackboard specials - announcements, bulletin boards, quizzes and surveys
1101: sub process_specials {
1102: my ($context,$type,$specials,$topnum,$contentscount,$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,$seqtext,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;
1103: my $src = '';
1104: my $specialsrc = '';
1105: my $nextnum = 0;
1106: my $seqstem = '';
1107: if ($context eq 'CSTR') {
1108: $seqstem = "/res/$udom/$uname/$newdir";
1109: } elsif ($context eq 'DOCS') {
1110: $seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow;
1111: }
1112: my %seqnames = (
1113: boards => 'bulletinboards',
1114: quizzes => 'quizzes',
1115: surveys => 'surveys',
1116: announcements => 'announcements',
1117: pools => 'pools'
1118: );
1119: my %seqtitles = (
1120: boards => 'Course Discussion Boards',
1121: quizzes => 'Course Quizzes',
1122: surveys => 'Course Surveys',
1123: announcements => 'Course Announcements',
1124: pools => 'Course Question Pools'
1125: );
1126: $$topnum ++;
1127:
1128: if ($type eq 'announcements') {
1129: $src = "$seqstem/pages/$seqnames{$type}.page";
1130: } else {
1131: $src = "$seqstem/sequences/$seqnames{$type}.sequence";
1132: }
1133:
1134: push @{$topurls}, $src;
1135: push @{$topnames}, $seqtitles{$type};
1136:
1137: $$seqtext .= qq|<resource id="$$topnum" src="$src" title="$seqtitles{$type}"|;
1138: $nextnum = $$topnum +1;
1139: if ($$topnum == 1) {
1140: $$seqtext .= qq| type="start"></resource>
1141: <link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
1142: if ($$topnum == $contentscount) {
1143: $$seqtext .= qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
1144: }
1145: } else {
1146: if ($$topnum == $contentscount) {
1147: $$seqtext .= qq| type="finish"></resource>\n|;
1148: } else {
1149: $$seqtext .= qq|></resource>
1150: <link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
1151: }
1152: }
1153:
1154: if ($type eq "announcements") {
1155: push @{$pagesfiles}, "$seqnames{$type}.page";
1156: open(ITEM,">$destdir/pages/$seqnames{$type}.page");
1157: } else {
1158: push @{$seqfiles}, "$seqnames{$type}.sequence";
1159: open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence");
1160: }
1161:
1162: if ($type eq 'boards') {
1163: $specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";
1164: } elsif ($type eq 'announcements') {
1165: $specialsrc = "$seqstem/resfiles/$$specials[0].html";
1166: } elsif ($type eq 'pools') {
1167: $specialsrc = "$seqstem/sequences/$$specials[0].sequence";
1168: } else {
1169: $specialsrc = "$seqstem/pages/$$specials[0].page";
1170: }
1171: print ITEM qq|<map>
1172: <resource id="1" src="$specialsrc" title="$$resinfo{$$specials[0]}{title}" type="start"></resource>
1173: <link from="1" to="2" index="1"></link>|;
1174: if (@{$specials} == 1) {
1175: print ITEM qq|
1176: <resource id="2" src="" type="finish"></resource>\n|;
1177: } else {
1178: for (my $i=1; $i<@{$specials}; $i++) {
1179: my $curr = $i+1;
1180: my $next = $i+2;
1181: if ($type eq 'boards') {
1182: $specialsrc = "/adm/$udom/$uname/$$timestamp[$i]/bulletinboard";
1183: } elsif ($type eq 'announcements') {
1184: $specialsrc = "$seqstem/resfiles/$$specials[$i].html";
1185: } else {
1186: $specialsrc = "$seqstem/pages/$$specials[$i].page";
1187: }
1188: print ITEM qq|<resource id="$curr" src="$specialsrc" title="$$resinfo{$$specials[$i]}{title}"|;
1189: if (@{$specials} == $i+1) {
1190: print ITEM qq| type="finish"></resource>\n|;
1191: } else {
1192: print ITEM qq|></resource>
1193: <link from="$curr" to="$next" index="$next">\n|;
1194: }
1195: }
1196: }
1197: print ITEM qq|</map>|;
1198: close(ITEM);
1199: }
1200:
1201: # ---------------------------------------------------------------- Process Blackboard users
1202: sub process_user {
1203: my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_;
1204: my $xmlfile = $docroot.'/'.$res.".dat";
1205: my $filecount = 0;
1206: my @state;
1207: my $userid = '';
1208: my $linknum = 0;
1209:
1210: my $p = HTML::Parser->new
1211: (
1212: xml_mode => 1,
1213: start_h =>
1214: [sub {
1215: my ($tagname, $attr) = @_;
1216: push @state, $tagname;
1217: if ("@state" eq "USERS USER") {
1218: $userid = $attr->{value};
1219: %{$$settings{$userid}} = ();
1220: @{$$settings{$userid}{links}} = ();
1221: } elsif ("@state" eq "USERS USER LOGINID") {
1222: $$settings{$userid}{loginid} = $attr->{value};
1223: } elsif ("@state" eq "USERS USER PASSPHRASE") {
1224: $$settings{$userid}{passphrase} = $attr->{value};
1225: } elsif ("@state" eq "USERS USER STUDENTID" ) {
1226: $$settings{$userid}{studentid} = $attr->{value};
1227: } elsif ("@state" eq "USERS USER NAMES FAMILY" ) {
1228: $$settings{$userid}{family} = $attr->{value};
1229: } elsif ("@state" eq "USERS USER NAMES GIVEN" ) {
1230: $$settings{$userid}{given} = $attr->{value};
1231: } elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") {
1232: $$settings{$userid}{email} = $attr->{value};
1233: } elsif ("@state" eq "USERS USER USER_ROLE") {
1234: $$settings{$userid}{user_role} = $attr->{value};
1235: } elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") {
1236: $$settings{$userid}{isavailable} = $attr->{value};
1237: } elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") {
1238: $$settings{$userid}{image} = $attr->{value};
1239: } elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) {
1240: %{$$settings{$userid}{links}[$linknum]} = ();
1241: $$settings{$userid}{links}[$linknum]{url} = $attr->{value};
1242: $linknum ++;
1243: }
1244: }, "tagname, attr"],
1245: text_h =>
1246: [sub {
1247: my ($text) = @_;
1248: if ("@state" eq "USERS USER PERSONALPAGE TITLE") {
1249: $$settings{$userid}{title} = $text;
1250: } elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") {
1251: $$settings{$userid}{description} = $text;
1252: } elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) {
1253: $$settings{$userid}{links}[$linknum]{title} = $text;
1254: } elsif (($state[-3] eq "LINK") && ($state[-2] eq "DESCRIPTION") && ($state[-1] eq "TEXT")) {
1255: $$settings{$userid}{links}[$linknum]{text} = $text;
1256: }
1257: }, "dtext"],
1258: end_h =>
1259: [sub {
1260: my ($tagname) = @_;
1261: if ("@state" eq "USERS USER") {
1262: $linknum = 0;
1263: }
1264: pop @state;
1265: }, "tagname"],
1266: );
1267: $p->unbroken_text(1);
1268: $p->parse_file($xmlfile);
1269: $p->eof;
1270:
1271: my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
1272: my $xmlstem = $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";
1273:
1274: foreach my $user_id (keys %{$settings}) {
1275: if ($$settings{$user_id}{user_role} eq "s") {
1276:
1277: } elsif ($user_handling eq 'enrollall') {
1278:
1279: }
1280: }
1281: }
1282:
1283: # ---------------------------------------------------------------- Process Blackboard groups
1284: sub process_group {
1285: my ($res,$docroot,$destdir,$settings) = @_;
1286: my $xmlfile = $docroot.'/'.$res.".dat";
1287: my $filecount = 0;
1288: my @state;
1289: my $grp;
1290:
1291: my $p = HTML::Parser->new
1292: (
1293: xml_mode => 1,
1294: start_h =>
1295: [sub {
1296: my ($tagname, $attr) = @_;
1297: push @state, $tagname;
1298: if ("@state" eq "GROUPS GROUP") {
1299: $grp = $attr->{id};
1300: }
1301: if ("@state" eq "GROUPS GROUP TITLE") {
1302: $$settings{$grp}{title} = $attr->{value};
1303: } elsif ("@state" eq "GROUPS GROUP FLAGS ISAVAILABLE") {
1304: $$settings{$grp}{isavailable} = $attr->{value};
1305: } elsif ("@state" eq "GROUPS GROUP FLAGS HASCHATROOM") {
1306: $$settings{$grp}{chat} = $attr->{value};
1307: } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
1308: $$settings{$grp}{discussion} = $attr->{value};
1309: } elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") {
1310: $$settings{$grp}{transfer} = $attr->{value};
1311: } elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") {
1312: $$settings{$grp}{public} = $attr->{value};
1313: }
1314: }, "tagname, attr"],
1315: text_h =>
1316: [sub {
1317: my ($text) = @_;
1318: if ("@state" eq "GROUPS DESCRIPTION") {
1319: $$settings{$grp}{description} = $text;
1320: # print "Staff text is $text\n";
1321: }
1322: }, "dtext"],
1323: end_h =>
1324: [sub {
1325: my ($tagname) = @_;
1326: pop @state;
1327: }, "tagname"],
1328: );
1329: $p->unbroken_text(1);
1330: $p->parse_file($xmlfile);
1331: $p->eof;
1332: }
1333:
1334: # ---------------------------------------------------------------- Process Blackboard Staff
1335: sub process_staff {
1336: my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
1337: my $xmlfile = $docroot.'/'.$res.".dat";
1338: my $filecount = 0;
1339: my @state;
1340: %{$$settings{name}} = ();
1341: %{$$settings{office}} = ();
1342:
1343: my $p = HTML::Parser->new
1344: (
1345: xml_mode => 1,
1346: start_h =>
1347: [sub {
1348: my ($tagname, $attr) = @_;
1349: push @state, $tagname;
1350: if ("@state" eq "STAFFINFO TITLE") {
1351: $$settings{title} = $attr->{value};
1352: } elsif ("@state" eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
1353: $$settings{textcolor} = $attr->{value};
1354: } elsif ("@state" eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
1355: $$settings{ishtml} = $attr->{value};
1356: } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
1357: $$settings{isavailable} = $attr->{value};
1358: } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) {
1359: $$settings{isfolder} = $attr->{value};
1360: } elsif ("@state" eq "STAFFINFO POSITION" ) {
1361: $$settings{position} = $attr->{value};
1362: } elsif ("@state" eq "STAFFINFO HOMEPAGE" ) {
1363: $$settings{homepage} = $attr->{value};
1364: } elsif ("@state" eq "STAFFINFO IMAGE") {
1365: $$settings{image} = $attr->{value};
1366: }
1367: }, "tagname, attr"],
1368: text_h =>
1369: [sub {
1370: my ($text) = @_;
1371: if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") {
1372: $$settings{text} = $text;
1373: # print "Staff text is $text\n";
1374: } elsif ("@state" eq "STAFFINFO CONTACT PHONE") {
1375: $$settings{phone} = $text;
1376: } elsif ("@state" eq "STAFFINFO CONTACT EMAIL") {
1377: $$settings{email} = $text;
1378: } elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") {
1379: $$settings{name}{formaltitle} = $text;
1380: } elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") {
1381: $$settings{name}{family} = $text;
1382: } elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") {
1383: $$settings{name}{given} = $text;
1384: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") {
1385: $$settings{office}{hours} = $text;
1386: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") {
1387: $$settings{office}{address} = $text;
1388: }
1389: }, "dtext"],
1390: end_h =>
1391: [sub {
1392: my ($tagname) = @_;
1393: pop @state;
1394: }, "tagname"],
1395: );
1396: $p->unbroken_text(1);
1397: $p->parse_file($xmlfile);
1398: $p->eof;
1399:
1400: my $fontcol = '';
1401: if (defined($$settings{textcolor})) {
1402: $fontcol = qq|color="$$settings{textcolor}"|;
1403: }
1404: if (defined($$settings{text})) {
1405: if ($$settings{ishtml} eq "true") {
1406: $$settings{text} = &HTML::Entities::decode($$settings{text});
1407: }
1408: }
1409: my $staffentry = qq|
1410: <table border="0" cellpadding="0" cellspacing="0" width="100%">
1411: <tr>
1412: <td colspan="2"><hr /><font face="arial,helv" size="3"><b>$$settings{name}{formaltitle} $$settings{name}{given} $$settings{name}{family}</b></font>
1413: </td>
1414: </tr>
1415: <tr>
1416: <td valign="top">
1417: <table width="100% border="0" cols="2" cellpadding="0" cellspacing="0">|;
1418: if ( defined($$settings{email}) && $$settings{email} ne '') {
1419: $staffentry .= qq|
1420: <tr>
1421: <td width="100" valign="top">
1422: <font face="arial" size="2"><b>Email:</b></font>
1423: </td>
1424: <td>
1425: <font face="arial" size="2"><a href="mailto:$$settings{email}">$$settings{email}</a></font>
1426: </td>
1427: </tr>
1428: |;
1429: }
1430: if (defined($$settings{phone}) && $$settings{phone} ne '') {
1431: $staffentry .= qq|
1432: <tr>
1433: <td width="100" valign="top">
1434: <font face="arial" size="2"><b>Phone:</b></font>
1435: </td>
1436: <td>
1437: <font face="arial" size="2">$$settings{phone}</font>
1438: </td>
1439: </tr>
1440: |;
1441: }
1442: if (defined($$settings{office}{address}) && $$settings{office}{address} ne '') {
1443: $staffentry .= qq|
1444: <tr>
1445: <td width="100" valign="top">
1446: <font face="arial" size="2"><b>Address:</b></font>
1447: </td>
1448: <td>
1449: <font face="arial" size="2">$$settings{office}{address}</font>
1450: </td>
1451: </tr>
1452: |;
1453: }
1454: if (defined($$settings{office}{hours}) && $$settings{office}{hours} ne '') {
1455: $staffentry .= qq|
1456: <tr>
1457: <td width="100" valign="top">
1458: <font face="arial" size="2"><b>Office Hours:</b></font>
1459: </td>
1460: <td>
1461: <font face="arial" size="2">$$settings{office}{hours}</font>
1462: </td>
1463: </tr>
1464: |;
1465: }
1466: if ( defined($$settings{homepage}) && $$settings{homepage} ne '') {
1467: $staffentry .= qq|
1468: <tr>
1469: <td width="100" valign="top">
1470: <font face="arial" size="2"><b>Personal Link:</b></font>
1471: </td>
1472: <td>
1473: <font face="arial" size="2"><a href="$$settings{homepage}">$$settings{homepage}</a></font>
1474: </td>
1475: </tr>
1476: |;
1477: }
1478: if (defined($$settings{text}) && $$settings{text} ne '') {
1479: $staffentry .= qq|
1480: <tr>
1481: <td colspan="2">
1482: <font face="arial" size="2" $fontcol><b>Other Information:</b><br/>$$settings{text}</font>
1483: </td>
1484: </tr>
1485: |;
1486: }
1487: $staffentry .= qq|
1488: </table>
1489: </td>
1490: <td align="right" valign="top">
1491: |;
1492: if ( defined($$settings{image}) ) {
1493: $staffentry .= qq|
1494: <img src="$res/$$settings{image}">
1495: |;
1496: }
1497: $staffentry .= qq|
1498: </td>
1499: </tr>
1500: </table>
1501: |;
1502: open(FILE,">$destdir/resfiles/$res.html");
1503: push @{$resrcfiles}, "$res.html";
1504: print FILE qq|<html>
1505: <head>
1506: <title>$$settings{title}</title>
1507: </head>
1508: <body bgcolor='#ffffff'>
1509: $staffentry
1510: </body>
1511: </html>|;
1512: close(FILE);
1513: }
1514:
1515: # ---------------------------------------------------------------- Process Blackboard Links
1516: sub process_link {
1517: my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
1518: my $xmlfile = $docroot.'/'.$res.".dat";
1519: my @state = ();
1520: my $p = HTML::Parser->new
1521: (
1522: xml_mode => 1,
1523: start_h =>
1524: [sub {
1525: my ($tagname, $attr) = @_;
1526: push @state, $tagname;
1527: if ("@state" eq "EXTERNALLINK TITLE") {
1528: $$settings{title} = $attr->{value};
1529: } elsif ("@state" eq "EXTERNALLINK TEXTCOLOR") {
1530: $$settings{textcolor} = $attr->{value};
1531: } elsif ("@state" eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {
1532: $$settings{ishtml} = $attr->{value};
1533: } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {
1534: $$settings{isavailable} = $attr->{value};
1535: } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {
1536: $$settings{newwindow} = $attr->{value};
1537: } elsif ("@state" eq "EXTERNALLINK FLAGS ISFOLDER" ) {
1538: $$settings{isfolder} = $attr->{value};
1539: } elsif ("@state" eq "EXTERNALLINK POSITION" ) {
1540: $$settings{position} = $attr->{value};
1541: } elsif ("@state" eq "EXTERNALLINK URL" ) {
1542: $$settings{url} = $attr->{value};
1543: }
1544: }, "tagname, attr"],
1545: text_h =>
1546: [sub {
1547: my ($text) = @_;
1548: if ("@state" eq "EXTERNALLINK DESCRIPTION TEXT") {
1549: $$settings{text} = $text;
1550: }
1551: }, "dtext"],
1552: end_h =>
1553: [sub {
1554: my ($tagname) = @_;
1555: pop @state;
1556: }, "tagname"],
1557: );
1558: $p->unbroken_text(1);
1559: $p->parse_file($xmlfile);
1560: $p->eof;
1561:
1562: my $linktag = '';
1563: my $fontcol = '';
1564: if (defined($$settings{textcolor})) {
1565: $fontcol = qq|<font color="$$settings{textcolor}">|;
1566: }
1567: if (defined($$settings{text})) {
1568: if ($$settings{ishtml} eq "true") {
1569: $$settings{text} = &HTML::Entities::decode($$settings{text});
1570: }
1571: }
1572:
1573: if (defined($$settings{url}) ) {
1574: $linktag = qq|<a href="$$settings{url}"|;
1575: if ($$settings{newwindow} eq "true") {
1576: $linktag .= qq| target="launch"|;
1577: }
1578: $linktag .= qq|>$$settings{title}</a>|;
1579: }
1580:
1581: open(FILE,">$destdir/resfiles/$res.html");
1582: push @{$resrcfiles}, "$res.html";
1583: print FILE qq|<html>
1584: <head>
1585: <title>$$settings{title}</title>
1586: </head>
1587: <body bgcolor='#ffffff'>
1588: $fontcol
1589: $linktag
1590: $$settings{text}
1591: |;
1592: if (defined($$settings{textcolor})) {
1593: print FILE qq|</font>|;
1594: }
1595: print FILE qq|
1596: </body>
1597: </html>|;
1598: close(FILE);
1599: }
1600:
1601: # ---------------------------------------------------------------- Process Blackboard Discussion Boards
1602: sub process_db {
1603: my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings,$longcrs) = @_;
1604: my $xmlfile = $docroot.'/'.$res.".dat";
1605: my @state = ();
1606: my @allmsgs = ();
1607: my %msgidx = ();
1608: my %threads; # all threads, keyed by message ID
1609: my $msg_id; # the current message ID
1610: my %message; # the current message being accumulated for $msg_id
1611:
1612: my $p = HTML::Parser->new
1613: (
1614: xml_mode => 1,
1615: start_h =>
1616: [sub {
1617: my ($tagname, $attr) = @_;
1618: push @state, $tagname;
1619: my $depth = 0;
1620: my @seq = ();
1621: if ("@state" eq "FORUM TITLE") {
1622: $$settings{title} = $attr->{value};
1623: } elsif ("@state" eq "FORUM DESCRIPTION TEXTCOLOR") {
1624: $$settings{textcolor} = $attr->{value};
1625: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISHTML") {
1626: $$settings{ishtml} = $attr->{value};
1627: } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") {
1628: $$settings{newline} = $attr->{value};
1629: } elsif ("@state" eq "FORUM POSITION" ) {
1630: $$settings{position} = $attr->{value};
1631: } elsif ("@state" eq "FORUM FLAGS ISREADONLY") {
1632: $$settings{isreadonly} = $attr->{value};
1633: } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) {
1634: $$settings{isavailable} = $attr->{value};
1635: } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) {
1636: $$settings{allowanon} = $attr->{value};
1637: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1638: if ($state[-1] eq "MSG") {
1639: unless ($msg_id eq '') {
1640: push @{$threads{$msg_id}}, { %message };
1641: $depth = @state - 3;
1642: if ($depth > @seq) {
1643: push @seq, $msg_id;
1644: }
1645: }
1646: if ($depth < @seq) {
1647: pop @seq;
1648: }
1649: $msg_id = $attr->{id};
1650: push @allmsgs, $msg_id;
1651: $msgidx{$msg_id} = @allmsgs;
1652: %message = ();
1653: $message{depth} = $depth;
1654: if ($depth > 0) {
1655: $message{parent} = $seq[-1];
1656: } else {
1657: $message{parent} = "None";
1658: }
1659: } elsif ($state[-1] eq "TITLE") {
1660: $message{title} = $attr->{value};
1661: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISHTML" ) ) {
1662: $message{ishtml} = $attr->{value};
1663: } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISNEWLINELITERAL" ) ) {
1664: $message{newline} = $attr->{value};
1665: } elsif ( ( $state[-2] eq "DATES" ) && ( $state[-1] eq "CREATED" ) ) {
1666: $message{created} = $attr->{value};
1667: } elsif ( $state[@state-2] eq "FLAGS") {
1668: if ($state[@state-1] eq "ISANONYMOUS") {
1669: $message{isanonymous} = $attr->{value};
1670: }
1671: } elsif ( $state[-2] eq "USER" ) {
1672: if ($state[-1] eq "USERID") {
1673: $message{userid} = $attr->{value};
1674: } elsif ($state[@state-1] eq "USERNAME") {
1675: $message{username} = $attr->{value};
1676: } elsif ($state[@state-1] eq "EMAIL") {
1677: $message{email} = $attr->{value};
1678: }
1679: } elsif ( ($state[-2] eq "FILELIST") && ($state[-1] eq "IMAGE") ) {
1680: $message{attachment} = $attr->{value};
1681: }
1682: }
1683: }, "tagname, attr"],
1684: text_h =>
1685: [sub {
1686: my ($text) = @_;
1687: if ("@state" eq "FORUM DESCRIPTION TEXT") {
1688: $$settings{text} = $text;
1689: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
1690: if ( ($state[-2] eq "MESSAGETEXT") && ($state[-1] eq "TEXT") ){
1691: $message{text} = $text;
1692: }
1693: }
1694: }, "dtext"],
1695: end_h =>
1696: [sub {
1697: my ($tagname) = @_;
1698: if ( $state[-1] eq "MESSAGETHREADS" ) {
1699: push @{$threads{$msg_id}}, { %message };
1700: }
1701: pop @state;
1702: }, "tagname"],
1703: );
1704: $p->unbroken_text(1);
1705: $p->parse_file($xmlfile);
1706: $p->eof;
1707:
1708: if (defined($$settings{text})) {
1709: if ($$settings{ishtml} eq "false") {
1710: if ($$settings{isnewline} eq "true") {
1711: $$settings{text} =~ s#\n#<br/>#g;
1712: }
1713: } else {
1714: $$settings{text} = &HTML::Entities::decode($$settings{text});
1715: }
1716: if (defined($$settings{fontcolor}) ) {
1717: $$settings{text} = "<font color=\"".$$settings{textcolor}."\">".$$settings{text}."</font>";
1718: }
1719: }
1720: my $boardname = 'bulletinpage_'.$timestamp;
1721: my %boardinfo = (
1722: 'aaa_title' => $$settings{title},
1723: 'bbb_content' => $$settings{text},
1724: 'ccc_webreferences' => '',
1725: 'uploaded.lastmodified' => time,
1726: );
1727:
1728: my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
1729: if ($handling eq 'importall') {
1730: foreach my $msg_id (@allmsgs) {
1731: foreach my $message ( @{$threads{$msg_id}} ) {
1732: my %contrib = (
1733: 'sendername' => $$message{userid},
1734: 'senderdomain' => $cdom,
1735: 'screenname' => '',
1736: 'plainname' => $$message{username},
1737: );
1738: unless ($$message{parent} eq 'None') {
1739: $contrib{replyto} = $msgidx{$$message{parent}};
1740: }
1741: if (defined($$message{isanonymous}) ) {
1742: if ($$message{isanonymous} eq 'true') {
1743: $contrib{'anonymous'} = 'true';
1744: }
1745: }
1746: if ( defined($$message{attachment}) ) {
1747: my $url = $$message{attachment};
1748: my $oldurl = $url;
1749: my $newurl = $url;
1750: unless ($url eq '') {
1751: $newurl =~ s/\//_/g;
1752: unless ($longcrs eq '') {
1753: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
1754: mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
1755: }
1756: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
1757: system("cp $destdir/resfiles/$res/$$message{attachment} /home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
1758: }
1759: $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$newurl;
1760: }
1761: }
1762: }
1763: if (defined($$message{title}) ) {
1764: $contrib{'message'} = $$message{title};
1765: }
1766: if (defined($$message{text})) {
1767: if ($$message{ishtml} eq "false") {
1768: if ($$message{isnewline} eq "true") {
1769: $$message{text} =~ s#\n#<br/>#g;
1770: }
1771: } else {
1772: $$message{text} = &HTML::Entities::decode($$message{text});
1773: }
1774: $contrib{'message'} .= '<br /><br />'.$$message{text};
1775: my $symb = 'bulletin___'.$timestamp.'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$timestamp.'/bulletinboard';
1776: my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
1777: }
1778: }
1779: }
1780: }
1781: }
1782:
1783: # ---------------------------------------------------------------- Add Posting to Discussion Board
1784: sub addposting {
1785: my ($symb,$contrib,$cdom,$crs)=@_;
1786: my $status='';
1787: if (($symb) && ($$contrib{message})) {
1788: my $crsdom = $cdom.'_'.$crs;
1789: &Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs);
1790: my %storenewentry=($symb => time);
1791: &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
1792: }
1793: my %record=&Apache::lonnet::restore('_discussion');
1794: my ($temp)=keys %record;
1795: unless ($temp=~/^error\:/) {
1796: my %newrecord=();
1797: $newrecord{'resource'}=$symb;
1798: $newrecord{'subnumber'}=$record{'subnumber'}+1;
1799: &Apache::lonnet::cstore(\%newrecord,'_discussion');
1800: $status = 'ok';
1801: } else {
1802: $status.='Failed.';
1803: }
1804: return $status;
1805: }
1806:
1807: sub parse_bb5_assessment {
1808: my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
1809: my $xmlfile = $docroot.'/'.$res.".dat";
1810: my @state = ();
1811: my $id; # the current question ID
1812: my $answer_id; # the current answer ID
1813: my %toptag = ( pool => 'POOL',
1814: quiz => 'ASSESSMENT',
1815: survey => 'ASSESSMENT'
1816: );
1817:
1818: my $p = HTML::Parser->new
1819: (
1820: xml_mode => 1,
1821: start_h =>
1822: [sub {
1823: my ($tagname, $attr) = @_;
1824: push @state, $tagname;
1825: my $depth = 0;
1826: my @seq = ();
1827: my $class;
1828: my $state_str = join(" ",@state);
1829: if ($container eq "pool") {
1830: if ("@state" eq "POOL TITLE") {
1831: $$settings{title} = $attr->{value};
1832: }
1833: } else {
1834: if ("@state" eq "ASSESSMENT TITLE") {
1835: $$settings{title} = $attr->{value};
1836: } elsif ("@state" eq "ASSESSMENT FLAG" ) {
1837: $$settings{isnewline} = $attr->{value};
1838: } elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") {
1839: $$settings{isavailable} = $attr->{value};
1840: } elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) {
1841: $$settings{isanonymous} = $attr->{id};
1842: } elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) {
1843: $$settings{feedback} = $attr->{id};
1844: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) {
1845: $$settings{showcorrect} = $attr->{id};
1846: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) {
1847: $$settings{showresults} = $attr->{id};
1848: } elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) {
1849: $$settings{allowmultiple} = $attr->{id};
1850: } elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) {
1851: $$settings{type} = $attr->{id};
1852: }
1853: }
1854: if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {
1855: $id = $attr->{id};
1856: push @{$allids}, $id;
1857: %{$$settings{$id}} = ();
1858: @{$$allanswers{$id}} = ();
1859: $$settings{$id}{class} = $attr->{class};
1860: unless ($container eq "pool") {
1861: $$settings{$id}{points} = $attr->{points};
1862: }
1863: @{$$settings{$id}{correctanswer}} = ();
1864: } elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) {
1865: $id = $attr->{id};
1866: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
1867: if ($state[4] eq "ISHTML") {
1868: $$settings{$id}{ishtml} = $attr->{value};
1869: } elsif ($state[4] eq "ISNEWLINELITERAL") {
1870: $$settings{$id}{newline} = $attr->{value};
1871: }
1872: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) {
1873: $$settings{$id}{image} = $attr->{value};
1874: $$settings{$id}{style} = $attr->{style};
1875: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) {
1876: $$settings{$id}{url} = $attr->{value};
1877: $$settings{$id}{name} = $attr->{name};
1878: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
1879: $answer_id = $attr->{id};
1880: push @{$$allanswers{$id}},$answer_id;
1881: %{$$settings{$id}{$answer_id}} = ();
1882: $$settings{$id}{$answer_id}{position} = $attr->{position};
1883: if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
1884: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1885: $$settings{$id}{$answer_id}{type} = 'answer';
1886: }
1887: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
1888: $answer_id = $attr->{id};
1889: push @{$$allchoices{$id}},$answer_id;
1890: %{$$settings{$id}{$answer_id}} = ();
1891: $$settings{$id}{$answer_id}{position} = $attr->{position};
1892: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
1893: $$settings{$id}{$answer_id}{type} = 'choice';
1894: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") ) {
1895: if ($state[3] eq "IMAGE") {
1896: $$settings{$id}{$answer_id}{image} = $attr->{value};
1897: $$settings{$id}{$answer_id}{style} = $attr->{style};
1898: } elsif ($state[3] eq "URL") {
1899: $$settings{$id}{$answer_id}{url} = $attr->{value};
1900: }
1901: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") ) {
1902: if ($state[3] eq "IMAGE") {
1903: $$settings{$id}{$answer_id}{image} = $attr->{value};
1904: $$settings{$id}{$answer_id}{style} = $attr->{style};
1905: } elsif ($state[3] eq "URL") {
1906: $$settings{$id}{$answer_id}{url} = $attr->{value};
1907: }
1908: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) {
1909: my $corr_answer = $attr->{answer_id};
1910: push @{$$settings{$id}{correctanswer}}, $corr_answer;
1911: my $type = $1;
1912: if ($type eq 'TRUEFALSE') {
1913: $$settings{$id}{$corr_answer}{answer_position} = $attr->{position};
1914: } elsif ($type eq 'ORDER') {
1915: $$settings{$id}{$corr_answer}{order} = $attr->{order};
1916: } elsif ($type eq 'MATCH') {
1917: $$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id};
1918: }
1919: }
1920: }, "tagname, attr"],
1921: text_h =>
1922: [sub {
1923: my ($text) = @_;
1924: $text =~ s/^\s+//g;
1925: $text =~ s/\s+$//g;
1926: unless ($container eq "pool") {
1927: if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
1928: $$settings{description} = $text;
1929: } elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") {
1930: $$settings{instructions}{text} = $text;
1931: }
1932: }
1933: if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[-1] eq "TEXT") ) {
1934: unless ($text eq '') {
1935: $$settings{$id}{text} = $text;
1936: }
1937: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[-1] eq "TEXT") ) {
1938: unless ($text eq '') {
1939: $$settings{$id}{$answer_id}{text} = $text;
1940: }
1941: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[-1] eq "TEXT") ) {
1942: unless ($text eq '') {
1943: $$settings{$id}{$answer_id}{text} = $text;
1944: }
1945: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[-1] eq "FEEDBACK_WHEN_CORRECT") ) {
1946: unless ($text eq '') {
1947: $$settings{$id}{feedback_corr} = $text;
1948: }
1949: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[-1] eq "FEEDBACK_WHEN_INCORRECT") ) {
1950: unless ($text eq '') {
1951: $$settings{$id}{feedback_incorr} = $text;
1952: }
1953: }
1954: }, "dtext"],
1955: end_h =>
1956: [sub {
1957: my ($tagname) = @_;
1958: pop @state;
1959: }, "tagname"],
1960: );
1961: $p->unbroken_text(1);
1962: $p->marked_sections(1);
1963: $p->parse_file($xmlfile);
1964: $p->eof;
1965: }
1966:
1967: sub parse_bb6_assessment {
1968: my ($res,$docroot,$container,$settings,$allids) = @_;
1969: my $xmlfile = $docroot.'/'.$res.".dat";
1970: my @state = ();
1971: my $id; # the current question ID
1972: my $response; # the current response ID
1973: my $foil; # the current foil ID
1974: my $numchoice; # the current right match choice;
1975: my $labelcount; # the current count of choices for a matching item.
1976: my $curr_shuffle;
1977: my $curr_class; # the current question type
1978: my $curr_matchitem;
1979: my $curr_block_type; # the current block type
1980: my $curr_flow; # the current flow class attribute
1981: my $curr_flow_mat; # the current flow_mat class attribute
1982: my $curr_feedback_type; # the current feedback type
1983: my $numorder; # counter for ordering type questions
1984:
1985: my $itemfrag = "questestinterop assessment section item";
1986: my $presfrag = "$itemfrag presentation flow flow";
1987: my $blockflow = 'flow';
1988: my $responselid;
1989: my $instructionfrag = "questestinterop assessment presentation_material flow_mat material";
1990: my $feedbackfrag = "$itemfrag itemfeedback";
1991: my $feedback_tag = '';
1992: my $responselid;
1993: my $p = HTML::Parser->new
1994: (
1995: xml_mode => 1,
1996: start_h =>
1997: [sub {
1998: my ($tagname, $attr) = @_;
1999: push @state, $tagname;
2000: if ("@state" eq "questestinterop assessment") {
2001: $$settings{title} = $attr->{title};
2002: }
2003: if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
2004: $$settings{description}{texttype} = $attr->{type};
2005: }
2006: if ("@state" eq $presfrag) {
2007: if ($attr->{class} eq 'QUESTION_BLOCK') {
2008: $curr_block_type = 'question';
2009: } elsif ($attr->{class} eq 'RESPONSE_BLOCK') {
2010: $curr_block_type = 'response';
2011: if ($curr_class eq 'Matching') {
2012: $responselid = 'flow response_lid';
2013: } else {
2014: $responselid = 'response_lid';
2015: }
2016: } elsif (($attr->{class} eq 'RIGHT_MATCH_BLOCK')) {
2017: $numchoice = 0;
2018: $curr_block_type = 'rightmatch';
2019: }
2020: }
2021: if ("@state" eq "$presfrag flow") {
2022: if (($curr_block_type =~ /^rightmatch/) && ($attr->{class} eq 'Block')) {
2023: $curr_block_type = 'rightmatch'.$numchoice;
2024: $numchoice ++;
2025: }
2026: }
2027: if ($state[-1] eq 'flow') {
2028: $curr_flow = $attr->{class};
2029: }
2030: if ($state[-1] eq 'flow_mat') {
2031: $curr_flow_mat = $attr->{class};
2032: }
2033: if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
2034: $$settings{$id}{$curr_block_type}{texttype} = $attr->{texttype};
2035: }
2036: if ("@state" eq "$presfrag $blockflow material matapplication") {
2037: $$settings{$id}{$curr_block_type}{image} = $attr->{uri};
2038: $$settings{$id}{$curr_block_type}{style} = $attr->{embedded};
2039: $$settings{$id}{$curr_block_type}{label} = $attr->{label};
2040: }
2041: if ("@state" eq "$presfrag $blockflow material mattext") {
2042: $$settings{$id}{$curr_block_type}{link} = $attr->{uri};
2043: }
2044: if ("@state" eq "$presfrag $responselid") {
2045: $response = $attr->{ident};
2046: $labelcount = 0;
2047: if ($curr_class eq 'Matching') {
2048: push(@{$$settings{$id}{answers}},$response);
2049: %{$$settings{$id}{$response}} = ();
2050: foreach my $key (keys(%{$$settings{$id}{$curr_block_type}})) {
2051: $$settings{$id}{$response}{$key} = $$settings{$id}{$curr_block_type}{$key};
2052: }
2053: %{$$settings{$id}{$curr_block_type}} = ();
2054: }
2055: }
2056: if ("@state" eq "$presfrag $responselid render_choice") {
2057: $curr_shuffle = $attr->{shuffle};
2058: }
2059: if ("@state" eq "$presfrag $responselid render_choice flow_label response_label") {
2060: $foil = $attr->{ident};
2061: %{$$settings{$id}{$foil}} = ();
2062: $$settings{$id}{$foil}{randomize} = $curr_shuffle;
2063: unless ($curr_class eq 'Essay'){
2064: if ($curr_class eq 'Matching') {
2065: push(@{$$settings{$id}{$response}{items}},$foil);
2066: $$settings{$id}{$foil}{order} = $labelcount;
2067: $labelcount ++;
2068: } else {
2069: push(@{$$settings{$id}{answers}},$foil);
2070: @{$$settings{$id}{correctanswer}} = ();
2071: }
2072: }
2073: }
2074: if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material matapplication") {
2075: $$settings{$id}{$foil}{filetype} = $attr->{embedded};
2076: $$settings{$id}{$foil}{label} = $attr->{label};
2077: $$settings{$id}{$foil}{uri} = $attr->{uri};
2078: }
2079: if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
2080: $$settings{$id}{$foil}{link} = $attr->{uri};
2081: }
2082: if ("@state" eq "questestinterop assessment section item resprocessing") {
2083: if ($curr_class eq 'Matching') {
2084: $$settings{$id}{allchoices} = $numchoice;
2085: }
2086: }
2087: if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
2088: if ($curr_class eq 'Matching') {
2089: $curr_matchitem = $attr->{respident};
2090: }
2091: }
2092: if ("@state" eq $feedbackfrag) {
2093: $curr_feedback_type = $attr->{ident};
2094: $feedback_tag = "";
2095: }
2096: if ("@state" eq "$feedbackfrag solution") {
2097: $curr_feedback_type = 'solution';
2098: $feedback_tag = "solution solutionmaterial";
2099: }
2100: if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material matapplication") {
2101: $$settings{$id}{$curr_feedback_type.'feedback'}{filetype} = $attr->{'embedded'};
2102: $$settings{$id}{$curr_feedback_type.'feedback'}{label} = $attr->{label};
2103: $$settings{$id}{$curr_feedback_type.'feedback'}{uri} = $attr->{uri};
2104: }
2105: if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mattext") {
2106: $$settings{$id}{$curr_feedback_type.'feedback'}{link} = $attr->{uri};
2107: }
2108: }, "tagname, attr"],
2109: text_h =>
2110: [sub {
2111: my ($text) = @_;
2112: $text =~ s/^\s+//g;
2113: $text =~ s/\s+$//g;
2114: if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
2115: $$settings{description}{text} = $text;
2116: }
2117: if ("@state" eq "questestinterop assessment rubric flow_mat material mattext") {
2118: $$settings{description}{text} = $text;
2119: }
2120: if ("@state" eq "$instructionfrag mat_extension mat_formattedtext") {
2121: $$settings{instructions}{text} = $text;
2122: }
2123: if ("@state" eq "$instructionfrag mattext") {
2124: $$settings{instructions}{text} = $text;
2125: }
2126: if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_asi_object_id") {
2127: $id = $text;
2128: push @{$allids}, $id;
2129: %{$$settings{$id}} = ();
2130: @{$$settings{$id}{answers}} = ();
2131: %{$$settings{$id}{question}} = ();
2132: %{$$settings{$id}{correctfeedback}} = ();
2133: %{$$settings{$id}{incorrectfeedback}} = ();
2134: %{$$settings{$id}{solutionfeedback}} = ();
2135: }
2136: if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_questiontype") {
2137: $$settings{$id}{class} = $text;
2138: $curr_class = $text;
2139: if ($curr_class eq 'Matching') {
2140: $blockflow = 'flow flow';
2141: } else {
2142: $blockflow = 'flow';
2143: }
2144: }
2145: if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
2146: $$settings{$id}{$curr_block_type}{text} = $text;
2147: }
2148: if ("@state" eq "$presfrag $blockflow material mattext") {
2149: if ($curr_flow eq 'LINK_BLOCK') {
2150: $$settings{$id}{$curr_block_type}{linkname} = $text;
2151: } elsif ($curr_flow eq 'FORMATTED_TEXT_BLOCK') {
2152: $$settings{$id}{$curr_block_type}{text} = $text;
2153: }
2154: }
2155: if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mat_extension mat_formattedtext") {
2156: $$settings{$id}{$foil}{text} = $text;
2157: }
2158: if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
2159: if ($curr_flow_mat eq 'LINK_BLOCK') {
2160: $$settings{$id}{$foil}{linkname} = $text;
2161: } else {
2162: $$settings{$id}{$foil}{text} = $text;
2163: }
2164: }
2165: if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
2166: if ($curr_class eq 'Matching') {
2167: $$settings{$id}{$curr_matchitem}{correctanswer} = $text;
2168: } else {
2169: push(@{$$settings{$id}{correctanswer}},$text);
2170: }
2171: }
2172: if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar") {
2173: $numorder = 0;
2174: }
2175: if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar and varequal") {
2176: push(@{$$settings{$id}{correctanswer}},$text);
2177: if ($curr_class eq 'Ordering') {
2178: $numorder ++;
2179: $$settings{$id}{$text}{order} = $numorder;
2180: }
2181: }
2182: if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mat_extension mat_formattedtext") {
2183: $$settings{$id}{$curr_feedback_type.'feedback'}{text} = $text;
2184: }
2185: if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mattext") {
2186: $$settings{$id}{$curr_feedback_type.'feedback'}{linkname} = $text;
2187: }
2188: }, "dtext"],
2189: end_h =>
2190: [sub {
2191: my ($tagname) = @_;
2192: pop @state;
2193: }, "tagname"],
2194: );
2195: $p->unbroken_text(1);
2196: $p->marked_sections(1);
2197: $p->parse_file($xmlfile);
2198: $p->eof;
2199: return;
2200: }
2201:
2202: sub parse_webctvista4_assessment {
2203: my ($res,$docroot,$href,$allids,$qzparams) = @_;
2204: my $xmlfile = $docroot.'/'.$href; #assessment file
2205: my @state = ();
2206: my $id; # the current question ID
2207: my $fieldlabel; # the current qti metadata field label
2208: my $outcome_id; # the current question ID for outcomes conditions
2209: my $pname; # the current outcomes parameter name
2210: my $numids = 0;
2211: %{$$qzparams{$res}} = ();
2212: %{$$qzparams{$res}{weight}} = ();
2213:
2214: my $p = HTML::Parser->new
2215: (
2216: xml_mode => 1,
2217: start_h =>
2218: [sub {
2219: my ($tagname, $attr) = @_;
2220: push @state, $tagname;
2221: my @seq = ();
2222: if ("@state" eq "questestinterop assessment") {
2223: $$qzparams{$res}{id} = $attr->{'ident'};
2224: $$qzparams{$res}{title} = $attr->{'title'};
2225: }
2226: if ("@state" eq "questestinterop assessment section itemref") {
2227: $id = $attr->{linkrefid};
2228: push(@{$allids},$id);
2229: $numids ++;
2230: }
2231: if ("@state" eq "questestinterop assessment section selection_ordering order") {
2232: $$qzparams{$res}{order_type} = $attr->{order_type};
2233: }
2234: }, "tagname, attr"],
2235: text_h =>
2236: [sub {
2237: my ($text) = @_;
2238: if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldlabel") {
2239: $fieldlabel = $text;
2240: }
2241: if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldentry") {
2242: $$qzparams{$res}{$fieldlabel} = $text;
2243: }
2244: if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition outcomes_metadata") {
2245: $outcome_id = $text;
2246: }
2247: if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition objects_parameter") {
2248: if ($pname eq 'qmd_weighting') {
2249: $$qzparams{$res}{weight}{$outcome_id} = $text;
2250: }
2251: }
2252: if ("@state" eq "questestinterop assessment section selection_ordering selection selection_number") {
2253: $$qzparams{$res}{numpick} = $text;
2254: }
2255: }, "dtext"],
2256: end_h =>
2257: [sub {
2258: my ($tagname) = @_;
2259: pop @state;
2260: }, "tagname"],
2261: );
2262: $p->unbroken_text(1);
2263: $p->parse_file($xmlfile);
2264: $p->eof;
2265: unless(defined($$qzparams{$res}{numpick})) {
2266: $$qzparams{$res}{numpick} = $numids;
2267: }
2268: }
2269:
2270: sub parse_webctvista4_question {
2271: my ($res,$docroot,$resources,$hrefs,$settings,$allquestids,$allanswers,$allchoices,$parent,$catinfo) = @_;
2272: my $xmlfile = $docroot.'/'.$$resources{$res}{file};
2273: my %classtypes = (
2274: WCT_Calculated => 'numerical',
2275: WCT_TrueFalse => 'multiplechoice',
2276: WCT_ShortAnswer => 'shortanswer',
2277: WCT_Paragraph => 'paragraph',
2278: WCT_MultipleChoice => 'multiplechoice',
2279: WCT_Matching => 'match',
2280: WCT_JumbledSentence => 'jumbled',
2281: WCT_FillInTheBlank => 'string',
2282: WCT_Combination => 'combination'
2283: );
2284: my @state = ();
2285: my $fieldlabel;
2286: my %questiondata;
2287: my $id; # the current question ID
2288: my $list; # the current list ID for multiple choice questions
2289: my $numid; # the current answer ID for numerical questions
2290: my $grp; # the current group ID for matching questions
2291: my $label; # the current reponse label for string questions
2292: my $str_id; # the current string ID for string questions
2293: my $unitid; # the current unit ID for numerical questions
2294: my $answer_id; # the current answer ID
2295: my $fdbk; # the current feedback ID
2296: my $currvar; # the current variable for numerical problems
2297: my $fibtype; # the current fill-in-blank type for numerical or string
2298: my $prompt;
2299: my $rows;
2300: my $columns;
2301: my $maxchars;
2302: my %setvar = (
2303: varname => '',
2304: action => '',
2305: );
2306: my $currtexttype;
2307: my $jumble_item;
2308: my $numbox = 0;
2309: my %str_answers = ();
2310: my $textlabel;
2311: my $currindex;
2312: my %varinfo = ();
2313: my $formula;
2314: my $jumbnum = 0;
2315: my $p = HTML::Parser->new
2316: (
2317: xml_mode => 1,
2318: start_h =>
2319: [sub {
2320: my ($tagname, $attr) = @_;
2321: push @state, $tagname;
2322: if ("@state" eq "questestinterop item") {
2323: $id = $attr->{ident};
2324: push(@{$allquestids},$id);
2325: %{$$settings{$id}} = ();
2326: %{$varinfo{$id}} = ();
2327: @{$$allchoices{$id}} = ();
2328: @{$$settings{$id}{grps}} = ();
2329: @{$$settings{$id}{lists}} = ();
2330: @{$$settings{$id}{feedback}} = ();
2331: @{$$settings{$id}{str}} = ();
2332: %{$$settings{$id}{strings}} = ();
2333: @{$$settings{$id}{numids}} = ();
2334: %{$$allanswers{$id}} = ();
2335: $$settings{$id}{title} = $attr->{title};
2336: }
2337: if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {
2338: $currvar = $attr->{'webct:name'};
2339: %{$varinfo{$id}{$currvar}} = ();
2340: $varinfo{$id}{$currvar}{min} = $attr->{'webct:min'};
2341: $varinfo{$id}{$currvar}{max} = $attr->{'webct:max'};
2342: $varinfo{$id}{$currvar}{precision} = $attr->{'webct:precision'};
2343: }
2344: if ("@state" eq "questestinterop item presentation flow response_num") {
2345: $numid = $attr->{ident};
2346: push(@{$$settings{$id}{numids}},$numid);
2347: %{$$settings{$id}{$numid}} = ();
2348: %{$$settings{$id}{$numid}{vars}} = ();
2349: @{$$settings{$id}{$numid}{units}} = ();
2350: $$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
2351: $$settings{$id}{$numid}{formula} = $formula;
2352: foreach my $var (keys(%{$varinfo{$id}})) {
2353: %{$$settings{$id}{$numid}{vars}{$var}} = %{$varinfo{$id}{$var}};
2354: }
2355: }
2356: if ("@state" eq "questestinterop item presentation flow material mat_extension webct:variable") {
2357: $$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';
2358: }
2359: if ("@state" eq "questestinterop item presentation flow material matimage") {
2360: $$settings{$id}{image} = $attr->{uri};
2361: }
2362:
2363: if ("@state" eq "questestinterop item presentation flow material mattext") {
2364: $currtexttype = lc($attr->{texttype});
2365: $$settings{$id}{texttype} = $currtexttype;
2366: if ($$settings{$id}{class} eq 'combination') {
2367: if (exists($attr->{label})) {
2368: $textlabel = $attr->{label};
2369: } else {
2370: $textlabel = '';
2371: }
2372: }
2373: }
2374: if ("@state" eq "questestinterop item presentation flow response_lid") {
2375: $list = $attr->{ident};
2376: push(@{$$settings{$id}{lists}},$list);
2377: %{$$settings{$id}{$list}} = ();
2378: @{$$allanswers{$id}{$list}} = ();
2379: @{$$settings{$id}{$list}{correctanswer}} = ();
2380: @{$$settings{$id}{$list}{jumbledtext}} = ();
2381: @{$$settings{$id}{$list}{jumbledtype}} = ();
2382: @{$$settings{$id}{$list}{jumbled}} = ();
2383: $$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
2384: }
2385: # Jumbled sentence
2386: if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object") {
2387: $$settings{$id}{$list}{orientation} = $attr->{orientation};
2388: }
2389: if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext") {
2390: $currtexttype = lc($attr->{texttype});
2391: $$settings{$id}{$list}{texttype} = $currtexttype;
2392: }
2393: if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label") {
2394: $jumble_item = $attr->{ident};
2395: }
2396: if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext") {
2397: $currtexttype = lc($attr->{texttype});
2398: $$settings{$id}{$list}{$jumble_item}{texttype} = $currtexttype;
2399: }
2400: if ("@state" eq "questestinterop item resprocessing respcondition") { # Jumbled
2401: if ($$settings{$id}{class} eq 'jumbled') {
2402: $jumbnum ++;
2403: @{$$settings{$id}{$list}{jumbled}[$jumbnum]} = ();
2404: }
2405: }
2406:
2407: if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
2408: $currindex = $attr->{index};
2409: }
2410: if ("@state" eq "questestinterop item presentation flow response_lid render_choice") {
2411: $$settings{$id}{$list}{randomize} = $attr->{shuffle};
2412: }
2413: # Multiple Choice, True/False and Combination
2414: if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label") {
2415: $answer_id = $attr->{ident};
2416: push(@{$$allanswers{$id}{$list}},$answer_id);
2417: %{$$settings{$id}{$list}{$answer_id}} = ();
2418: }
2419: # True/False
2420: if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
2421: $currtexttype = lc($attr->{texttype});
2422: $$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
2423: }
2424:
2425: # Multiple Choice and Combination
2426: if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
2427: $currtexttype = lc($attr->{texttype});
2428: $$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
2429: }
2430:
2431: # String, Shortanswer or Paragraph
2432: if (($$settings{$id}{class} eq 'string') ||
2433: ($$settings{$id}{class} eq 'shortanswer') ||
2434: ($$settings{$id}{class} eq 'paragraph')) {
2435: if ("@state" eq "questestinterop item presentation flow response_str") {
2436: $str_id = $attr->{ident};
2437: %{$$settings{$id}{$str_id}} = ();
2438: push(@{$$settings{$id}{str}},$str_id);
2439: $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
2440: @{$$settings{$id}{$str_id}{labels}} = ();
2441: %{$$settings{$id}{$str_id}{comparison}} = ();
2442: }
2443: }
2444: if ("@state" eq "questestinterop item presentation flow response_str material mattext") { # string
2445: $currtexttype = lc($attr->{texttype});
2446: $$settings{$id}{$str_id}{texttype} = $currtexttype;
2447: }
2448: if ("@state" eq "questestinterop item presentation flow response_str render_fib") {
2449: $fibtype = $attr->{fibtype};
2450: $prompt = $attr->{prompt};
2451: $rows = $attr->{rows};
2452: $columns = $attr->{columns};
2453: $maxchars = $attr->{maxchars};
2454: }
2455: if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label") {
2456: push(@{$$settings{$id}{$str_id}{labels}},$label);
2457: @{$$settings{$id}{strings}{$str_id}} = ();
2458: %{$$settings{$id}{$str_id}{$label}} = ();
2459: $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
2460: if ($$settings{$id}{class} eq 'string') {
2461: $$settings{$id}{text} .= '________';
2462: }
2463: }
2464: if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
2465: $textlabel = $attr->{label};
2466: }
2467: # Matching
2468: if ("@state" eq "questestinterop item presentation flow flow response_grp") {
2469: $grp = $attr->{ident};
2470: push(@{$$settings{$id}{grps}},$grp);
2471: %{$$settings{$id}{$grp}} = ();
2472: @{$$allanswers{$id}{$grp}} = ();
2473: @{$$settings{$id}{$grp}{correctanswer}} = ();
2474: $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
2475: }
2476: if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext") {
2477: $currtexttype = lc($attr->{texttype});
2478: $$settings{$id}{$grp}{texttype} = $currtexttype;
2479: }
2480: if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label") {
2481: $answer_id = $attr->{ident};
2482: push(@{$$allanswers{$id}{$grp}},$answer_id);
2483: %{$$settings{$id}{$grp}{$answer_id}} = ();
2484: $currtexttype = lc($attr->{texttype});
2485: $$settings{$id}{$grp}{$answer_id}{texttype} = $currtexttype;
2486: }
2487: # Multiple choice or combination or string or match
2488: if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
2489: if (($$settings{$id}{class} eq 'multiplechoice') ||
2490: ($$settings{$id}{class} eq 'combination')) {
2491: $list = $attr->{respident};
2492: } elsif (($$settings{$id}{class} eq 'string') ||
2493: ($$settings{$id}{class} eq 'shortanswer')) {
2494: $label = $attr->{respident};
2495: $$settings{$id}{$label}{case} = $attr->{'case'};
2496: } elsif ($$settings{$id}{class} eq 'match') {
2497: $grp = $attr->{respident};
2498: }
2499: }
2500: if ("@state" eq "questestinterop item resprocessing") {
2501: if (($$settings{$id}{class} eq 'string') ||
2502: ($$settings{$id}{class} eq 'shortanswer')) {
2503: foreach my $str_id (@{$$settings{$id}{str}}) {
2504: @{$str_answers{$str_id}} = ();
2505: }
2506: }
2507: }
2508: if ("@state" eq "questestinterop item resprocessing respcondition") {
2509: if (($$settings{$id}{class} eq 'string') ||
2510: ($$settings{$id}{class} eq 'shortanswer')) {
2511: $numbox ++;
2512: }
2513: }
2514: if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
2515: foreach my $key (keys(%{$attr})) {
2516: $setvar{$key} = $attr->{$key};
2517: }
2518: }
2519: if (($$settings{$id}{class} eq 'string') ||
2520: ($$settings{$id}{class} eq 'shortanswer')) {
2521: if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) {
2522: $str_id = $attr->{respident};
2523: $$settings{$id}{$str_id}{case} = $attr->{case};
2524: }
2525: }
2526: if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varsubset") {
2527: $list = $attr->{respident};
2528: }
2529: # Numerical
2530: if ("@state" eq "questestinterop item resprocessing itemproc_extension webct:calculated_answer") {
2531: $numid = $attr->{respident};
2532: $$settings{$id}{$numid}{toltype} = $attr->{'webct:toleranceType'};
2533: $$settings{$id}{$numid}{tolerance} = $attr->{'webct:tolerance'};
2534: }
2535: if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
2536: $unitid = $attr->{respident};
2537: %{$$settings{$id}{$numid}{$unitid}} = ();
2538: push(@{$$settings{$id}{$numid}{units}},$unitid);
2539: $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
2540: }
2541: # Feedback
2542: if ("@state" eq "questestinterop item respcondition displayfeedback") {
2543: $fdbk = $attr->{linkrefid};
2544: push(@{$$settings{$id}{feedback}},$fdbk);
2545: $$settings{$id}{$fdbk} = ();
2546: $$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
2547: }
2548: if ("@state" eq "questestinterop item itemfeedback") {
2549: $fdbk = $attr->{ident};
2550: push(@{$$settings{$id}{feedback}},$fdbk);
2551: $$settings{$id}{$fdbk}{view} = $attr->{view};
2552: }
2553: if ("@state" eq "questestinterop item itemfeedback material mattext") {
2554: $currtexttype = lc($attr->{texttype});
2555: $$settings{$id}{$fdbk}{texttype} = $currtexttype;
2556: }
2557: if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
2558: $currtexttype = lc($attr->{texttype});
2559: $$settings{$id}{$fdbk}{texttype} = $currtexttype;
2560: }
2561: }, "tagname, attr"],
2562: text_h =>
2563: [sub {
2564: my ($text) = @_;
2565: if ($currtexttype eq '/text/html') {
2566: $text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;
2567: }
2568: if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
2569: $fieldlabel = $text;
2570: }
2571: if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldentry") {
2572: $questiondata{$fieldlabel} = $text;
2573: if ($fieldlabel eq 'wct_questiontype') {
2574: $$settings{$id}{class} = $classtypes{$text};
2575: } elsif ($fieldlabel eq 'wct_questioncategory') {
2576: $$settings{$id}{category} = $text;
2577: unless(exists($$catinfo{$text})) {
2578: %{$$catinfo{$text}} = ();
2579: $$catinfo{$text}{title} = $text;
2580: }
2581: push(@{$$catinfo{$text}{contents}},$id);
2582: }
2583: }
2584: if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:formula") {
2585: $formula = $text;
2586: }
2587: if ("@state" eq "questestinterop item presentation flow response_str material mattext") {
2588: $$settings{$id}{$str_id}{text} = $text;
2589: }
2590: if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
2591: if ($textlabel eq 'PRE_FILL_ANSWER') {
2592: $$settings{$id}{$str_id}{$label}{$textlabel} = $text;
2593: }
2594: }
2595: # Matching
2596: if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
2597: $$settings{$id}{$list}{$answer_id}{text} .= $text;
2598: }
2599: # Multiple choice, True/False, Combination
2600: if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
2601: $$settings{$id}{$list}{$answer_id}{text} = $text;
2602: }
2603: if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext") {
2604: push(@{$$settings{$id}{$list}{jumbledtext}},$text);
2605: push(@{$$settings{$id}{$list}{jumbledtype}},'No');
2606: }
2607: if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext") {
2608: $$settings{$id}{$list}{$jumble_item}{text} = $text;
2609: push(@{$$settings{$id}{$list}{jumbledtext}},$text);
2610: push(@{$$settings{$id}{$list}{jumbledtype}},'Yes');
2611: }
2612: if ("@state" eq "questestinterop item presentation flow material mattext") {
2613: $$settings{$id}{text} .= $text;
2614: if ($$settings{$id}{class} eq 'combination') {
2615: if ($textlabel =~ /^wct_question_label_\d+$/) {
2616: $$settings{$id}{text} .= '<br />';
2617: }
2618: if ($textlabel =~ /^wct_cmc_single_answer\d+$/) {
2619: $$settings{$id}{text} .= '<br />';
2620: }
2621: }
2622: }
2623: # Matching
2624: if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext") {
2625: $$settings{$id}{$grp}{text} = $text;
2626: unless ($text eq '') {
2627: push(@{$$allchoices{$id}},$grp);
2628: }
2629: }
2630: if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label material mattext") {
2631: $$settings{$id}{$grp}{$answer_id}{text} = $text;
2632: }
2633: # Numerical
2634: if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
2635: $$settings{$id}{$numid}{$unitid}{text} = $text;
2636: }
2637: if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
2638: if (($$settings{$id}{class} eq 'string') ||
2639: ($$settings{$id}{class} eq 'shortanswer')) {
2640: unless (grep/^$text$/,@{$str_answers{$str_id}}) {
2641: push(@{$str_answers{$str_id}},$text);
2642: $$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
2643: }
2644: } else {
2645: $answer_id = $text;
2646: }
2647: }
2648: if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) { # string
2649: if (($$settings{$id}{class} eq 'string') ||
2650: ($$settings{$id}{class} eq 'shortanswer')) {
2651: unless (grep/^$text$/,@{$str_answers{$str_id}}) {
2652: push(@{$str_answers{$str_id}},$text);
2653: $$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
2654: }
2655: }
2656: }
2657:
2658: if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
2659: $$settings{$id}{$list}{jumbled}[$jumbnum][$currindex] = $text;
2660: }
2661: if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
2662: if ($setvar{varname} eq "SCORE") { # Multiple Choice, String or Match
2663: if ($text =~ m/^[\d\.]+$/) {
2664: if ($text > 0) {
2665: if (($$settings{$id}{class} eq 'multiplechoice') ||
2666: ($$settings{$id}{class} eq 'combination')) {
2667: push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
2668: } elsif (($$settings{$id}{class} eq 'string') ||
2669: ($$settings{$id}{class} eq 'shortanswer')) {
2670: foreach my $answer (@{$str_answers{$str_id}}) {
2671: unless (grep/^$answer$/,@{$$settings{$id}{strings}{$str_id}}) {
2672: push(@{$$settings{$id}{strings}{$str_id}},$answer);
2673: }
2674: }
2675: } elsif ($$settings{$id}{class} eq 'match') {
2676: push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
2677: }
2678: }
2679: }
2680: }
2681: }
2682: if ("@state" eq "questestinterop item itemfeedback material mattext") {
2683: $$settings{$id}{$fdbk}{text} = $text;
2684: }
2685: if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
2686: $$settings{$id}{$fdbk}{text} = $text;
2687: }
2688: }, "dtext"],
2689: end_h =>
2690: [sub {
2691: my ($tagname) = @_;
2692: pop @state;
2693: }, "tagname"],
2694: );
2695: $p->unbroken_text(1);
2696: $p->parse_file($xmlfile);
2697: $p->eof;
2698: }
2699:
2700: sub parse_webct4_assessment {
2701: my ($res,$docroot,$href,$container,$allids) = @_;
2702: my $xmlfile = $docroot.'/'.$href; #quiz file
2703: my @state = ();
2704: my $id; # the current question ID
2705: my $p = HTML::Parser->new
2706: (
2707: xml_mode => 1,
2708: start_h =>
2709: [sub {
2710: my ($tagname, $attr) = @_;
2711: push @state, $tagname;
2712: my $depth = 0;
2713: my @seq = ();
2714: if ("@state" eq "questestinterop assessment section itemref") {
2715: $id = $attr->{linkrefid};
2716: push(@{$allids},$id);
2717: }
2718: }, "tagname, attr"],
2719: text_h =>
2720: [sub {
2721: my ($text) = @_;
2722: }, "dtext"],
2723: end_h =>
2724: [sub {
2725: my ($tagname) = @_;
2726: pop @state;
2727: }, "tagname"],
2728: );
2729: $p->unbroken_text(1);
2730: $p->parse_file($xmlfile);
2731: $p->eof;
2732: }
2733:
2734: sub parse_webct4_quizprops {
2735: my ($res,$docroot,$href,$container,$qzparams) = @_;
2736: my $xmlfile = $docroot.'/'.$href; #properties file
2737: my @state = ();
2738: %{$$qzparams{$res}} = ();
2739: my $p = HTML::Parser->new
2740: (
2741: xml_mode => 1,
2742: start_h =>
2743: [sub {
2744: my ($tagname, $attr) = @_;
2745: push @state, $tagname;
2746: }, "tagname, attr"],
2747: text_h =>
2748: [sub {
2749: my ($text) = @_;
2750: if ($state[0] eq 'properties' && $state[1] eq 'delivery') {
2751: if ($state[2] eq 'time_available') {
2752: $$qzparams{$res}{opendate} = $text;
2753: } elsif ($state[2] eq 'time_due') {
2754: $$qzparams{$res}{duedate} = $text;
2755: } elsif ($state[3] eq 'max_attempt') {
2756: $$qzparams{$res}{tries} = $text;
2757: } elsif ($state[3] eq 'post_submission') {
2758: $$qzparams{$res}{posts} = $text;
2759: } elsif ($state[3] eq 'method') {
2760: $$qzparams{$res}{method} = $text;
2761: }
2762: } elsif ($state[0] eq 'properties' && $state[1] eq 'processing') {
2763: if ($state[2] eq 'scores' && $state[3] eq 'score') {
2764: $$qzparams{$res}{weight} = $text;
2765: } elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
2766: $$qzparams{$res}{numpick} = $text;
2767: }
2768: } elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
2769: if ($state[2] eq 'display_answer') {
2770: $$qzparams{$res}{showanswer} = $text;
2771: }
2772: }
2773: }, "dtext"],
2774: end_h =>
2775: [sub {
2776: my ($tagname) = @_;
2777: pop @state;
2778: }, "tagname"],
2779: );
2780: $p->unbroken_text(1);
2781: $p->parse_file($xmlfile);
2782: $p->eof;
2783: }
2784:
2785: sub parse_webct4_questionDB {
2786: my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
2787: my $xmlfile;
2788: if ($href eq 'questiondb.xml') {
2789: $xmlfile = $docroot.'/'.$href;
2790: } else {
2791: $href =~ s#[^/]+$##;
2792: $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file
2793: }
2794: my @state = ();
2795: my $category; # the current category ID
2796: my $id; # the current question ID
2797: my $list; # the current list ID for multiple choice questions
2798: my $numid; # the current answer ID for numerical questions
2799: my $grp; # the current group ID for matching questions
2800: my $label; # the current reponse label for string questions
2801: my $str_id; # the current string ID for string questions
2802: my $unitid; # the current unit ID for numerical questions
2803: my $answer_id; # the current answer ID
2804: my $fdbk; # the current feedback ID
2805: my $currvar; # the current variable for numerical problems
2806: my $fibtype; # the current fill-in-blank type for numerical or string
2807: my $prompt;
2808: my $boxnum;
2809: my %setvar = (
2810: varname => '',
2811: action => '',
2812: );
2813: my $currtexttype;
2814: my $currimagtype;
2815: my $is_objectbank;
2816: my $p = HTML::Parser->new
2817: (
2818: xml_mode => 1,
2819: start_h =>
2820: [sub {
2821: my ($tagname, $attr) = @_;
2822: if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
2823: $is_objectbank = 1;
2824: } else {
2825: push @state, $tagname;
2826: }
2827: if ("@state" eq "questestinterop section") {
2828: $category = $attr->{ident};
2829: %{$$catinfo{$category}} = ();
2830: $$catinfo{$category}{title} = $attr->{title};
2831: }
2832: if ("@state" eq "questestinterop section item") {
2833: $id = $attr->{ident};
2834: push @{$allids}, $id;
2835: push(@{$$catinfo{$category}{contents}},$id);
2836: %{$$settings{$id}} = ();
2837: @{$$allchoices{$id}} = ();
2838: @{$$settings{$id}{grps}} = ();
2839: @{$$settings{$id}{lists}} = ();
2840: @{$$settings{$id}{feedback}} = ();
2841: @{$$settings{$id}{str}} = ();
2842: %{$$settings{$id}{strings}} = ();
2843: @{$$settings{$id}{numids}} = ();
2844: @{$$settings{$id}{boxes}} = ();
2845: %{$$allanswers{$id}} = ();
2846: $$settings{$id}{title} = $attr->{title};
2847: $$settings{$id}{category} = $category;
2848: $boxnum = 0;
2849: }
2850:
2851: if ("@state" eq "questestinterop section item presentation material mattext") {
2852: $$settings{$id}{texttype} = $attr->{texttype};
2853: $currtexttype = $attr->{texttype};
2854: }
2855: if ("@state" eq "questestinterop section item presentation material matimage") {
2856: $$settings{$id}{imagtype} = $attr->{imagtype};
2857: $currimagtype = $attr->{imagtype};
2858: $$settings{$id}{uri} = $attr->{uri};
2859: }
2860:
2861: # Matching
2862: if ("@state" eq "questestinterop section item presentation response_grp") {
2863: $$settings{$id}{class} = 'match';
2864: $grp = $attr->{ident};
2865: push(@{$$settings{$id}{grps}},$grp);
2866: %{$$settings{$id}{$grp}} = ();
2867: @{$$settings{$id}{$grp}{correctanswer}} = ();
2868: $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
2869: }
2870: if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
2871: $$settings{$id}{$grp}{texttype} = $attr->{texttype};
2872: $currtexttype = $attr->{texttype};
2873: }
2874: if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label") {
2875: $answer_id = $attr->{ident};
2876: push(@{$$allanswers{$id}{$grp}},$answer_id);
2877: %{$$settings{$id}{$grp}{$answer_id}} = ();
2878: $$settings{$id}{$grp}{$answer_id}{texttype} = $attr->{texttype};
2879: $currtexttype = $attr->{texttype};
2880: }
2881:
2882: # Multiple choice
2883:
2884: if ("@state" eq "questestinterop section item presentation flow material mattext") {
2885: $$settings{$id}{texttype} = $attr->{texttype};
2886: $currtexttype = $attr->{texttype};
2887: }
2888: if ("@state" eq "questestinterop section item presentation flow material matimage") {
2889: $$settings{$id}{imagtype} = $attr->{imagtype};
2890: $currimagtype = $attr->{imagtype};
2891: $$settings{$id}{uri} = $attr->{uri};
2892:
2893: }
2894: if ("@state" eq "questestinterop section item presentation flow response_lid") {
2895: $$settings{$id}{class} = 'multiplechoice';
2896: $list = $attr->{ident};
2897: push(@{$$settings{$id}{lists}},$list);
2898: %{$$settings{$id}{$list}} = ();
2899: @{$$allanswers{$id}{$list}} = ();
2900: @{$$settings{$id}{$list}{correctanswer}} = ();
2901: $$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
2902: }
2903: if ("@state" eq "questestinterop section item presentation flow response_lid render_choice") {
2904: $$settings{$id}{$list}{randomize} = $attr->{shuffle};
2905: }
2906: if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label") {
2907: $answer_id = $attr->{ident};
2908: push(@{$$allanswers{$id}{$list}},$answer_id);
2909: %{$$settings{$id}{$list}{$answer_id}} = ();
2910: }
2911: if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
2912: $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
2913: $currtexttype = $attr->{texttype};
2914: }
2915: if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") {
2916: $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
2917: $currtexttype = $attr->{texttype};
2918: }
2919:
2920: # Numerical
2921: if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
2922: $$settings{$id}{texttype} = $attr->{texttype};
2923: $currtexttype = $attr->{texttype};
2924: }
2925: if ("@state" eq "questestinterop section item presentation response_num") {
2926: $$settings{$id}{class} = 'numerical';
2927: $numid = $attr->{ident};
2928: push(@{$$settings{$id}{numids}},$numid);
2929: %{$$settings{$id}{$numid}} = ();
2930: %{$$settings{$id}{$numid}{vars}} = ();
2931: @{$$settings{$id}{$numid}{units}} = ();
2932: $$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
2933: }
2934: if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
2935: $currvar = $attr->{name};
2936: %{$$settings{$id}{$numid}{vars}{$currvar}} = ();
2937: }
2938: if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
2939: $currvar = $attr->{name};
2940: }
2941: if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
2942: $currvar = $attr->{name};
2943: }
2944: if ("@state" eq "questestinterop section item presentation response_num render_fib") {
2945: $fibtype = $attr->{fibtype};
2946: $prompt = $attr->{prompt};
2947: }
2948: if ("@state" eq "questestinterop section item presentation response_num render_fib response_label") {
2949: $$settings{$id}{$numid}{label} = $attr->{ident};
2950: }
2951:
2952: # String or Numerical
2953: if ("@state" eq "questestinterop section item presentation response_str") {
2954: $str_id = $attr->{ident};
2955: push(@{$$settings{$id}{str}},$str_id);
2956: @{$$settings{$id}{boxes}[$boxnum]} = ();
2957: $boxnum ++;
2958: %{$$settings{$id}{$str_id}} = ();
2959: @{$$settings{$id}{$str_id}{labels}} = ();
2960: $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
2961: }
2962:
2963: if ("@state" eq "questestinterop section item presentation response_str render_fib") {
2964: $fibtype = $attr->{fibtype};
2965: $prompt = $attr->{prompt};
2966: }
2967: if ("@state" eq "questestinterop section item presentation response_str render_fib response_label") {
2968: $label = $attr->{ident};
2969: push(@{$$settings{$id}{$str_id}{labels}},$label);
2970: @{$$settings{$id}{strings}{$label}} = ();
2971: %{$$settings{$id}{$str_id}{$label}} = ();
2972: $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
2973: }
2974:
2975: # Numerical
2976: if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anspresentation") {
2977: $$settings{$id}{$numid}{digits} = $attr->{digits};
2978: $$settings{$id}{$numid}{format} = $attr->{format};
2979: }
2980: if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
2981: $$settings{$id}{$numid}{toltype} = $attr->{type};
2982: }
2983: if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
2984: $unitid = $attr->{ident};
2985: %{$$settings{$id}{$numid}{$unitid}} = ();
2986: push(@{$$settings{$id}{$numid}{units}},$unitid);
2987: $$settings{$id}{$numid}{$unitid}{value} = $attr->{value};
2988: $$settings{$id}{$numid}{$unitid}{space} = $attr->{space};
2989: $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
2990: }
2991:
2992: # Matching
2993: if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
2994: if ($$settings{$id}{class} eq 'match') {
2995: unless ($attr->{respident} eq 'WebCT_Incorrect') {
2996: $grp = $attr->{respident};
2997: }
2998: # String
2999: } else {
3000: $label = $attr->{respident};
3001: $$settings{$id}{$label}{case} = $attr->{case};
3002: }
3003: }
3004: if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
3005: foreach my $key (keys(%{$attr})) {
3006: $setvar{$key} = $attr->{$key};
3007: }
3008: if ($setvar{varname} eq 'WebCT_Correct') {
3009: push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
3010: }
3011: }
3012:
3013: # String
3014: if ("@state" eq "questestinterop section item resprocessing") {
3015: $boxnum = -1;
3016: }
3017: if ("@state" eq "questestinterop section item resprocessing respcondition") { $boxnum ++;
3018: }
3019: if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") {
3020: $$settings{$id}{class} = 'string';
3021: $label = $attr->{respident};
3022: }
3023: if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar not") {
3024: $$settings{$id}{class} = 'paragraph';
3025: }
3026:
3027:
3028: # Feedback
3029:
3030: if ("@state" eq "questestinterop section item respcondition displayfeedback") {
3031: $fdbk = $attr->{linkrefid};
3032: push(@{$$settings{$id}{feedback}},$fdbk);
3033: $$settings{$id}{$fdbk} = ();
3034: $$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
3035: }
3036: if ("@state" eq "questestinterop section item itemfeedback") {
3037: $fdbk = $attr->{ident};
3038: push(@{$$settings{$id}{feedback}},$fdbk);
3039: $$settings{$id}{$fdbk}{view} = $attr->{view};
3040: }
3041: if ("@state" eq "questestinterop section item itemfeedback material mattext") {
3042: $$settings{$id}{$fdbk}{texttype} = $attr->{texttype};
3043: $currtexttype = $attr->{texttype};
3044: }
3045: }, "tagname, attr"],
3046: text_h =>
3047: [sub {
3048: my ($text) = @_;
3049: if ($currtexttype eq '/text/html') {
3050: $text =~ s#(<img\ssrc=")([^"]+)">#$1../resfiles/$2#g;
3051: }
3052: if ("@state" eq "questestinterop section item itemmetadata qmd_itemtype") {
3053: $$settings{$id}{itemtype} = $text;
3054: if ($text eq 'String') {
3055: $$settings{$id}{class} = 'string';
3056: }
3057: }
3058:
3059: if ("@state" eq "questestinterop section item presentation material mattext") {
3060: $$settings{$id}{text} = $text;
3061: }
3062: # Matching
3063: if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
3064: $$settings{$id}{$grp}{text} = $text;
3065: unless ($text eq '') {
3066: push(@{$$allchoices{$id}},$grp);
3067: }
3068: }
3069: if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label material mattext") {
3070: $$settings{$id}{$grp}{$answer_id}{text} = $text;
3071: }
3072:
3073: # Multiple choice
3074:
3075: if ("@state" eq "questestinterop section item presentation flow material mattext") {
3076: $$settings{$id}{text} = $text;
3077: }
3078:
3079: if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
3080: $$settings{$id}{$list}{$answer_id}{text} = $text;
3081: }
3082: if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") {
3083: $$settings{$id}{$list}{$answer_id}{text} = $text;
3084: }
3085:
3086: # Numerical
3087: if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
3088: $$settings{$id}{text} = $text;
3089: }
3090: if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
3091: $$settings{$id}{$numid}{vars}{$currvar}{min} = $text;
3092: }
3093: if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
3094: $$settings{$id}{$numid}{vars}{$currvar}{max} = $text;
3095: }
3096: if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
3097: $$settings{$id}{$numid}{vars}{$currvar}{dec} = $text;
3098: }
3099: if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_formula") {
3100: $$settings{$id}{$numid}{formula} = $text;
3101: }
3102: if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
3103: if ($$settings{$id}{class} eq 'string') {
3104: unless (grep/^$text$/,@{$$settings{$id}{strings}{$label}}) {
3105: push(@{$$settings{$id}{strings}{$label}},$text);
3106: }
3107: unless (grep/^$text$/,@{$$settings{$id}{boxes}[$boxnum]}) {
3108: push(@{$$settings{$id}{boxes}[$boxnum]},$text);
3109: }
3110: } else {
3111: $answer_id = $text;
3112: }
3113: }
3114: if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") { # String
3115: unless (grep/^$text$/,@{$$settings{$id}{strings}{$label}}) {
3116: push(@{$$settings{$id}{strings}{$label}},$text);
3117: }
3118: unless (grep/^$text$/,@{$$settings{$id}{boxes}[$boxnum]}) {
3119: push(@{$$settings{$id}{boxes}[$boxnum]},$text);
3120: }
3121: }
3122: if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
3123: if ($setvar{varname} eq "answerValue") { # Multiple Choice WebCT4.0
3124: if ($text =~ m/^\d+$/) {
3125: if ($text > 0) {
3126: push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
3127: }
3128: }
3129: } elsif ($setvar{varname} eq "que_score") { # Multiple Choice WebCT4.1
3130: if ($text =~ m/^\d+$/) {
3131: if ($text > 0) {
3132: push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
3133: }
3134: }
3135: } elsif ($is_objectbank) { #Multiple Choice WebCT 4.1 D2L objectbank
3136: if ($setvar{action} eq "Set") {
3137: if ($text =~ /^\d+\.?\d*$/) {
3138: if ($text > 0.000000001) {
3139: push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
3140: }
3141: }
3142: }
3143: }
3144: }
3145: if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
3146: $$settings{$id}{$numid}{tolerance} = $text;
3147: }
3148: if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
3149: $$settings{$id}{$numid}{$unitid}{text} = $text;
3150: }
3151:
3152: if ("@state" eq "questestinterop section item itemfeedback material mattext") {
3153: $$settings{$id}{$fdbk}{text} = $text;
3154: }
3155: }, "dtext"],
3156: end_h =>
3157: [sub {
3158: my ($tagname) = @_;
3159: if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
3160: $is_objectbank = '';
3161: } else {
3162: pop @state;
3163: }
3164: }, "tagname"],
3165: );
3166: $p->unbroken_text(1);
3167: $p->parse_file($xmlfile);
3168: $p->eof;
3169: my $boxcount;
3170: foreach my $id (keys %{$settings}) {
3171: if ($$settings{$id}{class} eq 'string') {
3172: $boxcount = 0;
3173: if (@{$$settings{$id}{boxes}} > 1) {
3174: foreach my $str_id (@{$$settings{$id}{str}}) {
3175: foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
3176: @{$$settings{$id}{strings}{$label}} = @{$$settings{$id}{boxes}[$boxcount]};
3177: $boxcount ++;
3178: }
3179: }
3180: }
3181: } elsif ($$settings{$id}{class} eq 'multiplechoice') {
3182: if (ref($$settings{$id}) eq 'HASH') {
3183: foreach my $list (keys(%{$$settings{$id}})) {
3184: if (ref($$settings{$id}{$list}) eq 'HASH') {
3185: if (defined($$settings{$id}{$list}{rcardinality})) {
3186: if ($$settings{$id}{$list}{rcardinality} eq 'Multiple') {
3187: if (ref($$settings{$id}{$list}{correctanswer}) eq 'ARRAY') {
3188: if (@{$$settings{$id}{$list}{correctanswer}} == 1) {
3189: $$settings{$id}{$list}{rcardinality} = 'Single';
3190: }
3191: }
3192: }
3193: }
3194: }
3195: }
3196: }
3197: }
3198: }
3199: }
3200:
3201: sub process_assessment {
3202: my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs,$allquestions) = @_;
3203: my @allids = ();
3204: my @allquestids = ();
3205: my %allanswers = ();
3206: my %allchoices = ();
3207: my %qzparams = ();
3208: my %alldbanswers = ();
3209: my %alldbchoices = ();
3210: my @alldbquestids = ();
3211: my $containerdir;
3212: my $newdir;
3213: my $randompickflag = 0;
3214: my ($cid,$cdom,$cnum);
3215: if ($context eq 'DOCS') {
3216: $cid = $env{'request.course.id'};
3217: ($cdom,$cnum) = split/_/,$cid;
3218: }
3219: my $destresdir = $destdir;
3220: if ($context eq 'CSTR') {
3221: $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
3222: } elsif ($context eq 'DOCS') {
3223: $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
3224: }
3225: if ($cms eq 'bb5') {
3226: &parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
3227: } elsif ($cms eq 'bb6') {
3228: &parse_bb6_assessment($res,$docroot,$container,$settings,\@allids);
3229: } elsif ($cms eq 'webctce4') {
3230: unless($$dbparse) {
3231: &parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
3232: &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
3233: &write_webct4_questions($cms,\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
3234: $$dbparse = 1;
3235: }
3236: &parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
3237: &parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
3238: if (exists($qzparams{$res}{numpick})) {
3239: if ($qzparams{$res}{numpick} < @allids) {
3240: $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
3241: $randompickflag = 1;
3242: }
3243: }
3244: } elsif ($cms eq 'webctvista4') {
3245: unless($$dbparse) {
3246: foreach my $res (sort keys %{$allquestions}) {
3247: my $parent = $$allquestions{$res};
3248: &parse_webctvista4_question($res,$docroot,$resources,$hrefs,$qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);
3249: }
3250: &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
3251: $$dbparse = 1;
3252: }
3253: &parse_webctvista4_assessment($res,$docroot,$$resources{$res}{file},\@allids,\%qzparams);
3254: if ($qzparams{$res}{numpick} < @allids) {
3255: $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
3256: $randompickflag = 1;
3257: }
3258: }
3259: my $dirtitle;
3260: unless ($cms eq 'webctce4' || $cms eq 'webctvista4') {
3261: $dirtitle = $$settings{'title'};
3262: $dirtitle =~ s/\s+/_/g;
3263: $dirtitle =~ s/:/_/g;
3264: $dirtitle .= '_'.$res;
3265: if (!-e "$destdir/problems") {
3266: mkdir("$destdir/problems",0755);
3267: }
3268: if (!-e "$destdir/problems/$dirtitle") {
3269: mkdir("$destdir/problems/$dirtitle",0755);
3270: }
3271: $newdir = "$destdir/problems/$dirtitle";
3272: }
3273:
3274: if ($cms eq 'webctce4') {
3275: if (@allids > 0 && $allids[0] ne '') {
3276: &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
3277: }
3278: } else {
3279: &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings,\%qzparams);
3280: }
3281: if ($cms eq 'bb5') {
3282: &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
3283: } elsif ($cms eq 'bb6') {
3284: &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);
3285: } elsif ($cms eq 'webctvista4') {
3286: &write_webct4_questions($cms,\@allquestids,$context,$qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle);
3287: }
3288: }
3289:
3290: sub build_category_sequences {
3291: my ($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings) = @_;
3292: if (!-e "$destdir/sequences") {
3293: mkdir("$destdir/sequences",0755);
3294: }
3295: my $numcats = scalar(keys %{$catinfo});
3296: my $curr_id = 0;
3297: my $next_id = 1;
3298: my $fh;
3299: open($fh,">$destdir/sequences/question_database.sequence");
3300: push @{$sequencesfiles},'question_database.sequence';
3301: foreach my $category (sort keys %{$catinfo}) {
3302: my $seqname;
3303: if ($cms eq 'webctce4') {
3304: $seqname = $$catinfo{$category}{title}.'_'.$category;
3305: } else {
3306: $seqname = $$catinfo{$category}{title};
3307: }
3308: $seqname =~ s/\s+/_/g;
3309: $seqname =~ s/:/_/g;
3310: push(@{$sequencesfiles},$seqname.'.sequence');
3311: my $catsrc = "$destresdir/sequences/$seqname.sequence";
3312: if ($curr_id == 0) {
3313: print $fh qq|<resource id="1" src="$catsrc" type="start" title="$$catinfo{$category}{title}"></resource>|;
3314: }
3315: if ($numcats == 1) {
3316: print $fh qq|
3317: <link from="1" to="2" index="1"></link>
3318: <resource id="2" src="" type="finish">\n|;
3319: } else {
3320: $curr_id = $next_id;
3321: $next_id = $curr_id + 1;
3322: $catsrc = "$destresdir/sequences/$seqname.sequence";
3323: print $fh qq|
3324: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
3325: <resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
3326: if ($next_id == $numcats) {
3327: print $fh qq| type="finish"></resource>\n|;
3328: } else {
3329: print $fh qq|></resource>\n|;
3330: }
3331: }
3332: print $fh qq|</map>|;
3333: if (!-e "$destdir/problems") {
3334: mkdir("$destdir/problems",0755);
3335: }
3336: if (!-e "$destdir/problems/$seqname") {
3337: mkdir("$destdir/problems/$seqname",0755);
3338: }
3339: $$newdir = "$destdir/problems/$seqname";
3340: my $dbcontainerdir;
3341: &build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
3342: }
3343: close($fh);
3344: }
3345:
3346: sub build_problem_container {
3347: my ($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,$allids,$udom,$uname,$dirname,$containerdir,$cid,$cdom,$cnum,$catinfo,$settings,$qzparams) = @_;
3348: my $seqdir = "$destdir/sequences";
3349: my $pagedir = "$destdir/pages";
3350: my $curr_id = 0;
3351: my $next_id = 1;
3352: my $fh;
3353: my $mapname = $res;
3354: if ($cms eq 'webctvista4' && ref($$qzparams{$res}) eq 'HASH') {
3355: if ($$qzparams{$res}{title}) {
3356: $mapname = $$qzparams{$res}{title};
3357: $mapname =~ s/\s+/_/g;
3358: }
3359: }
3360: if ($container eq 'pool' || $randompickflag || $container eq 'database') {
3361: $$containerdir = $seqdir.'/'.$mapname.'.sequence';
3362: if (!-e "$seqdir") {
3363: mkdir("$seqdir",0770);
3364: }
3365: open($fh,">$$containerdir");
3366: $$total{seq} ++;
3367: push @{$sequencesfiles},$mapname.'.sequence';
3368: } else {
3369: $$containerdir = $pagedir.'/'.$mapname.'.page';
3370: if (!-e "$destdir/pages") {
3371: mkdir("$destdir/pages",0770);
3372: }
3373: open($fh,">$$containerdir");
3374: $$total{page} ++;
3375: push @{$pagesfiles},$mapname.'.page';
3376: }
3377: print $fh qq|<map>
3378: |;
3379: my %probtitle = ();
3380: my $probsrc = "/res/lib/templates/simpleproblem.problem";
3381: if ($context eq 'CSTR') {
3382: foreach my $id (@{$allids}) {
3383: if (($cms eq 'webctce4') || ($cms eq 'webctvista4')) {
3384: $probtitle{$id} = $$settings{$id}{title};
3385: } else {
3386: $probtitle{$id} = $$settings{title};
3387: }
3388: $probtitle{$id} =~ s/\s+/_/g;
3389: $probtitle{$id} =~ s/:/_/g;
3390: $probtitle{$id} =~ s/\//_/g;
3391: $probtitle{$id} .= '_'.$id;
3392: }
3393: if (($cms eq 'webctce4' && $container ne 'database') ||
3394: ($cms eq 'webctvista4')) {
3395: my $probdir;
3396: my $catid = $$settings{$$allids[0]}{category};
3397: if ($catid) {
3398: if ($cms eq 'webctce4') {
3399: $probdir = $$catinfo{$catid}{title}.'_'.$catid;
3400: } else {
3401: $probdir = $$catinfo{$catid}{title};
3402: }
3403: $probdir =~ s/\s+/_/g;
3404: $probdir =~ s/:/_/g;
3405: $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
3406: } else {
3407: $probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
3408: }
3409: } else {
3410: $probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
3411: }
3412: }
3413: print $fh qq|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>|;
3414: if (@{$allids} == 1) {
3415: print $fh qq|
3416: <link from="1" to="2" index="1"></link>
3417: <resource id="2" src="" type="finish">\n|;
3418: } else {
3419: for (my $j=1; $j<@{$allids}; $j++) {
3420: my $qntitle = $j+1;
3421: while (length($qntitle) <4) {
3422: $qntitle = '0'.$qntitle;
3423: }
3424: $curr_id = $j;
3425: $next_id = $curr_id + 1;
3426: if ($context eq 'CSTR') {
3427: if (($cms eq 'webctce4' && $container ne 'database') ||
3428: ($cms eq 'webctvista4')) {
3429: my $probdir;
3430: my $catid = $$settings{$$allids[$j]}{category};
3431: if ($catid) {
3432: if ($cms eq 'webctce4') {
3433: $probdir = $$catinfo{$catid}{title}.'_'.$catid;
3434: } else {
3435: $probdir = $$catinfo{$catid}{title};
3436: }
3437: $probdir =~ s/\s/_/g;
3438: $probdir =~ s/:/_/g;
3439: $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
3440: } else {
3441: $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
3442: }
3443: } else {
3444: $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
3445: }
3446: }
3447: print $fh qq|
3448: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
3449: <resource id="$next_id" src="$probsrc" title="question_$qntitle"|;
3450: if ($next_id == @{$allids}) {
3451: print $fh qq| type="finish"></resource>\n|;
3452: } else {
3453: print $fh qq|></resource>|;
3454: }
3455: }
3456: }
3457: print $fh qq|</map>|;
3458: close($fh);
3459: }
3460:
3461: sub write_bb5_questions {
3462: my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
3463: my $qnum = 0;
3464: my $pathstart;
3465: if ($context eq 'CSTR') {
3466: $pathstart = '../..';
3467: } else {
3468: $pathstart = $dirname;
3469: }
3470: foreach my $id (@{$allids}) {
3471: if ($$settings{$id}{ishtml} eq 'true') {
3472: $$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
3473: }
3474: if ($$settings{$id}{text} =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
3475: if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
3476: $$settings{$id}{text} =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
3477: }
3478: }
3479: $$settings{$id}{text} =~ s#(<img src=[^>]+)/*>#$1 />#gi;
3480: $$settings{$id}{text} =~ s#<br>#<br />#g;
3481: $qnum ++;
3482: my $output;
3483: my $permcontainer = $containerdir;
3484: $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
3485: my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
3486: my %resourcedata = ();
3487: for (my $i=0; $i<10; $i++) {
3488: my $iter = $i+1;
3489: $resourcedata{$symb.'text'.$iter} = "";
3490: $resourcedata{$symb.'value'.$iter} = "unused";
3491: $resourcedata{$symb.'position'.$iter} = "random";
3492: }
3493: $resourcedata{$symb.'randomize'} = 'yes';
3494: $resourcedata{$symb.'maxfoils'} = 10;
3495: if ($context eq 'CSTR') {
3496: $output = qq|<problem>
3497: |;
3498: }
3499: $$total{prob} ++;
3500: if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
3501: if ($context eq 'CSTR') {
3502: $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
3503: <essayresponse>
3504: <textfield></textfield>
3505: </essayresponse>
3506: <postanswerdate>
3507: $$settings{$id}{feedbackcorr}
3508: </postanswerdate>
3509: |;
3510: } else {
3511: $resourcedata{$symb.'questiontext'} = $$settings{$id}{text};
3512: $resourcedata{$symb.'hiddenparts'} = '!essay';
3513: $resourcedata{$symb.'questiontype'} = 'essay';
3514: }
3515: } else {
3516: if ($context eq 'CSTR') {
3517: $output .= qq|<startouttext />$$settings{$id}{text}\n|;
3518: } else {
3519: $resourcedata{$symb.'questiontext'} = $$settings{$id}{text};
3520: }
3521: my ($image,$imglink,$url);
3522: if ( defined($$settings{$id}{image}) ) {
3523: if ( $$settings{$id}{style} eq 'embed' ) {
3524: $image = qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{image}" /><br />|;
3525: } else {
3526: $imglink = qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
3527: }
3528: }
3529: if ( defined($$settings{$id}{url}) ) {
3530: $url = qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
3531: }
3532: if ($context eq 'CSTR') {
3533: $output .= $image.$imglink.$url.'
3534: <endouttext />';
3535: } else {
3536: $resourcedata{$symb.'questiontext'} .= $image.$imglink.$url;
3537: }
3538: if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
3539: my $numfoils = @{$$allanswers{$id}};
3540: if ($context eq 'CSTR') {
3541: $output .= qq|
3542: <radiobuttonresponse max="$numfoils" randomize="yes">
3543: <foilgroup>
3544: |;
3545: } else {
3546: $resourcedata{$symb.'hiddenparts'} = '!radio';
3547: $resourcedata{$symb.'questiontype'} = 'radio';
3548: $resourcedata{$symb.'maxfoils'} = $numfoils;
3549: }
3550: for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
3551: my $iter = $k+1;
3552: $output .= " <foil name=\"foil".$k."\" value=\"";
3553: if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
3554: $output .= "true\" location=\"";
3555: $resourcedata{$symb.'value'.$iter} = "true";
3556: } else {
3557: $output .= "false\" location=\"";
3558: $resourcedata{$symb.'value'.$iter} = "false";
3559: }
3560: if (lc ($$allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
3561: $output .= "bottom\"";
3562: $resourcedata{$symb.'position'.$iter} = "bottom";
3563: } else {
3564: $output .= "random\"";
3565: }
3566: $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text};
3567: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
3568: my ($ans_image,$ans_link);
3569: if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {
3570: if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {
3571: $ans_image .= qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" /><br />|;
3572: } else {
3573: $ans_link .= qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
3574: }
3575: }
3576: $output .= $ans_image.$ans_link.'<endouttext /></foil>'."\n";
3577: $resourcedata{$symb.'text'.$iter} .= $ans_image.$ans_link;
3578: }
3579: if ($context eq 'CSTR') {
3580: chomp($output);
3581: $output .= qq|
3582: </foilgroup>
3583: </radiobuttonresponse>
3584: |;
3585: }
3586: } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
3587: my $numfoils = @{$$allanswers{$id}};
3588: if ($context eq 'CSTR') {
3589: $output .= qq|
3590: <radiobuttonresponse max="$numfoils" randomize="yes">
3591: <foilgroup>
3592: |;
3593: } else {
3594: $resourcedata{$symb.'maxfoils'} = $numfoils;
3595: $resourcedata{$symb.'hiddenparts'} = '!radio';
3596: $resourcedata{$symb.'questiontype'} = 'radio';
3597: }
3598: for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
3599: my $iter = $k+1;
3600: $output .= " <foil name=\"foil".$k."\" value=\"";
3601: if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
3602: $output .= "true\" location=\"random\"";
3603: $resourcedata{$symb.'value'.$iter} = "true";
3604: } else {
3605: $output .= "false\" location=\"random\"";
3606: $resourcedata{$symb.'value'.$iter} = "false";
3607: }
3608: $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
3609: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
3610: }
3611: if ($context eq 'CSTR') {
3612: chomp($output);
3613: $output .= qq|
3614: </foilgroup>
3615: </radiobuttonresponse>
3616: |;
3617: }
3618: } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
3619: my $numfoils = @{$$allanswers{$id}};
3620: if ($context eq 'CSTR') {
3621: $output .= qq|
3622: <optionresponse max="$numfoils" randomize="yes">
3623: <foilgroup options="('True','False')">
3624: |;
3625: } else {
3626: $resourcedata{$symb.'newopt'} = '';
3627: $resourcedata{$symb.'delopt'} = '';
3628: $resourcedata{$symb.'options'} = "('True','False')";
3629: $resourcedata{$symb.'hiddenparts'} = '!option';
3630: $resourcedata{$symb.'questiontype'} = 'option';
3631: $resourcedata{$symb.'maxfoils'} = $numfoils;
3632: }
3633: for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
3634: my $iter = $k+1;
3635: $output .= " <foil name=\"foil".$k."\" value=\"";
3636: if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
3637: $output .= "True\"";
3638: $resourcedata{$symb.'value'.$iter} = "True";
3639: } else {
3640: $output .= "False\"";
3641: $resourcedata{$symb.'value'.$iter} = "False";
3642: }
3643: $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
3644: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
3645: }
3646: if ($context eq 'CSTR') {
3647: chomp($output);
3648: $output .= qq|
3649: </foilgroup>
3650: </optionresponse>
3651: |;
3652: }
3653: } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
3654: my $numfoils = @{$$allanswers{$id}};
3655: my @allorder = ();
3656: if ($context eq 'CSTR') {
3657: $output .= qq|
3658: <rankresponse max="$numfoils" randomize="yes">
3659: <foilgroup>
3660: |;
3661: } else {
3662: $resourcedata{$symb.'newopt'} = '';
3663: $resourcedata{$symb.'delopt'} = '';
3664: $resourcedata{$symb.'hiddenparts'} = '!option';
3665: $resourcedata{$symb.'questiontype'} = 'option';
3666: $resourcedata{$symb.'maxfoils'} = $numfoils;
3667: }
3668: for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
3669: if ($context eq 'CSTR') {
3670: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
3671: } else {
3672: my $iter = $k+1;
3673: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
3674: if (!grep/^$$settings{$id}{$$allanswers{$id}[$k]}{order}$/,@allorder) {
3675: push @allorder, $$settings{$id}{$$allanswers{$id}[$k]}{order};
3676: }
3677: }
3678: }
3679: if ($context eq 'CSTR') {
3680: chomp($output);
3681: $output .= qq|
3682: </foilgroup>
3683: </rankresponse>
3684: |;
3685: } else {
3686: @allorder = sort {$a <=> $b} @allorder;
3687: $resourcedata{$symb.'options'} = "('".join("','",@allorder)."')";
3688: }
3689: } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
3690: my $numerical = 1;
3691: if ($context eq 'DOCS') {
3692: $numerical = 0;
3693: } else {
3694: for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
3695: if ($$settings{$id}{$$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
3696: $numerical = 0;
3697: }
3698: }
3699: }
3700: if ($numerical) {
3701: my $numans;
3702: my $tol;
3703: if (@{$$allanswers{$id}} == 1) {
3704: $tol = 5;
3705: $numans = $$settings{$id}{$$allanswers{$id}[0]}{text};
3706: } else {
3707: my $min = $$settings{$id}{$$allanswers{$id}[0]}{text};
3708: my $max = $$settings{$id}{$$allanswers{$id}[0]}{text};
3709: for (my $k=1; $k<@{$$allanswers{$id}}; $k++) {
3710: if ($$settings{$id}{$$allanswers{$id}[$k]}{text} <= $min) {
3711: $min = $$settings{$id}{$$allanswers{$id}[$k]}{text};
3712: }
3713: if ($$settings{$id}{$$allanswers{$id}[$k]}{text} >= $max) {
3714: $max = $$settings{$id}{$$allanswers{$id}[$k]}{text};
3715: }
3716: }
3717: $numans = ($max + $min)/2;
3718: $tol = 100*($max - $min)/($numans*2);
3719: }
3720: if ($context eq 'CSTR') {
3721: $output .= qq|
3722: <numericalresponse answer="$numans">
3723: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
3724: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
3725: />
3726: <textline />
3727: </numericalresponse>
3728: |;
3729: }
3730: } else {
3731: if ($context eq 'DOCS') {
3732: $resourcedata{$symb.'hiddenparts'} = '!string';
3733: $resourcedata{$symb.'questiontype'} = 'string';
3734: $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
3735: $resourcedata{$symb.'hiddenparts'} = '!string';
3736: $resourcedata{$symb.'stringtype'} = 'ci';
3737: $resourcedata{$symb.'stringanswer'} = $$settings{$id}{$$allanswers{$id}[0]}{text};
3738: } else {
3739: if (@{$$allanswers{$id}} == 1) {
3740: $output .= qq|
3741: <stringresponse answer="$$settings{$id}{$$allanswers{$id}[0]}{text}" type="ci">
3742: <textline>
3743: </textline>
3744: </stringresponse>
3745: |;
3746: } else {
3747: my @answertext = ();
3748: for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
3749: $$settings{$id}{$$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
3750: push @answertext, $$settings{$id}{$$allanswers{$id}[$k]}{text};
3751: }
3752: my $regexpans = join('|',@answertext);
3753: $regexpans = '/^('.$regexpans.')\b/';
3754: $output .= qq|
3755: <stringresponse answer="$regexpans" type="re">
3756: <textline>
3757: </textline>
3758: </stringresponse>
3759: |;
3760: }
3761: }
3762: }
3763: } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
3764: my @allmatchers = ();
3765: my %matchtext = ();
3766: if ($context eq 'CSTR') {
3767: $output .= qq|
3768: <matchresponse max="10" randomize="yes">
3769: <foilgroup>
3770: <itemgroup>
3771: |;
3772: } else {
3773: $resourcedata{$symb.'newopt'} = '';
3774: $resourcedata{$symb.'delopt'} = '';
3775: $resourcedata{$symb.'hiddenparts'} = '!option';
3776: $resourcedata{$symb.'questiontype'} = 'option';
3777: $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
3778: }
3779: for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
3780: if ($context eq 'CSTR') {
3781: $output .= qq|
3782: <item name="$$allchoices{$id}[$k]">
3783: <startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
3784: </item>
3785: |;
3786: } else {
3787: if (!grep/^$$settings{$id}{$$allchoices{$id}[$k]}{text}$/,@allmatchers) {
3788: push @allmatchers, $$settings{$id}{$$allchoices{$id}[$k]}{text};
3789: $matchtext{$$allchoices{$id}[$k]} = $$settings{$id}{$$allchoices{$id}[$k]}{text};
3790: }
3791: }
3792: }
3793: if ($context eq 'CSTR') {
3794: $output .= qq|
3795: </itemgroup>
3796: |;
3797: }
3798: for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
3799: if ($context eq 'CSTR') {
3800: $output .= qq|
3801: <foil location="random" value="$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}" name="$$allanswers{$id}[$k]">
3802: <startouttext />$$settings{$id}{$$allanswers{$id}[$k]}{text}<endouttext />
3803: </foil>
3804: |;
3805: } else {
3806: my $iter = $k+1;
3807: $resourcedata{$symb.'value'.$iter} = $matchtext{$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}};
3808: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
3809: }
3810: }
3811: if ($context eq 'CSTR') {
3812: $output .= qq|
3813: </foilgroup>
3814: </matchresponse>
3815: |;
3816: } else {
3817: $resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
3818: }
3819: }
3820: }
3821: if ($context eq 'CSTR') {
3822: $output .= qq|</problem>
3823: |;
3824: my $title = $$settings{title};
3825: $title =~ s/\s/_/g;
3826: $title =~ s/\W//g;
3827: $title .= '_'.$id;
3828: open(PROB,">$newdir/$title.problem");
3829: print PROB $output;
3830: close PROB;
3831: } else {
3832: # put %resourcedata;
3833: my $reply=&Apache::lonnet::cput
3834: ('resourcedata',\%resourcedata,$cdom,$cnum);
3835: }
3836: }
3837: }
3838:
3839: sub write_webct4_questions {
3840: my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle) = @_;
3841: my $qnum = 0;
3842: foreach my $id (@{$alldbquestids}) {
3843: $qnum ++;
3844: my $output;
3845: my $permcontainer = $destdir.'/sequences/'.$id.'.sequence';
3846: my $allfeedback;
3847: my $questionimage;
3848: foreach my $fdbk (@{$$settings{$id}{feedback}}) {
3849: my $feedback = $$settings{$id}{$fdbk}{text};
3850: if ($feedback ne '') {
3851: if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {
3852: $feedback = &HTML::Entities::decode($feedback);
3853: }
3854: $allfeedback .= $feedback;
3855: }
3856: }
3857: if ($$settings{$id}{texttype} eq 'text/html') {
3858: if ($$settings{$id}{text}) {
3859: $$settings{$id}{text} = &text_cleanup($$settings{$id}{text});
3860: }
3861: }
3862: if ($$settings{$id}{class} eq 'numerical') {
3863: foreach my $numid (@{$$settings{$id}{numids}}) {
3864: foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
3865: if ($cms eq 'webctce4') {
3866: $$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
3867: } elsif ($cms eq 'webctvista4') {
3868: $$settings{$id}{text} =~ s/\[($var)\]/\$$1 /g;
3869: }
3870: }
3871: }
3872: }
3873: $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
3874: my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
3875: my %resourcedata = ();
3876: for (my $i=0; $i<10; $i++) {
3877: my $iter = $i+1;
3878: $resourcedata{$symb.'text'.$iter} = "";
3879: $resourcedata{$symb.'value'.$iter} = "unused";
3880: $resourcedata{$symb.'position'.$iter} = "random";
3881: }
3882: $resourcedata{$symb.'randomize'} = 'yes';
3883: $resourcedata{$symb.'maxfoils'} = 10;
3884: if ($context eq 'CSTR') {
3885: unless ($$settings{$id}{class} eq 'numerical') {
3886: $output = qq|<problem>
3887: |;
3888: }
3889: }
3890: $$total{prob} ++;
3891:
3892: if (exists($$settings{$id}{uri})) {
3893: if ($cms eq 'webctce4') {
3894: if ($$settings{$id}{imagtype} =~ /^image\//) {
3895: $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
3896: } else {
3897: $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
3898: }
3899: } elsif ($cms eq 'webctvista4') {
3900: if ($$settings{$id}{uri} =~ /(gif|jpg|png)$/i) {
3901: $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
3902: $questionimage =~ s#(//+)#/#g;
3903: } else {
3904: $questionimage = '<a href="'.$$settings{$id}{uri}.'" target="exturi" >'.$$settings{$id}{uri}.'</a>';
3905: }
3906: }
3907: }
3908: if ($$settings{$id}{class} eq "paragraph") {
3909: my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
3910: if ($context eq 'CSTR') {
3911: $output .= qq|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />
3912: <essayresponse>
3913: <textfield>$pre_fill_answer</textfield>
3914: </essayresponse>
3915: |;
3916: } else {
3917: $resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
3918: $resourcedata{$symb.'hiddenparts'} = '!essay';
3919: $resourcedata{$symb.'questiontype'} = 'essay';
3920: }
3921: } elsif ($$settings{$id}{class} eq 'jumbled') {
3922: if ($context eq 'CSTR') {
3923: my %foiloptions = ();
3924: foreach my $list (@{$$settings{$id}{lists}}) {
3925: @{$foiloptions{$list}} = ();
3926: my $numalternates = @{$$settings{$id}{$list}{jumbled}} - 1;
3927: my $loopstop = 2; #Hard coded for now, so only one permutation of answers is correct; <or> functionality is needed to support the case where multiple permutations are correct.
3928: for (my $i=1; $i<$loopstop; $i++) {
3929: $foiloptions{$list}[$i] = '(';
3930: for (my $j=@{$$settings{$id}{$list}{jumbled}[$i]}-1; $j>0; $j--) {
3931: my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$j];
3932: $foiloptions{$list}[$i] .= "'".$$settings{$id}{$list}{$jumble_item}{text}."',";
3933: }
3934: $foiloptions{$list}[$i] =~ s/,$//;
3935: $foiloptions{$list}[$i] .= ')';
3936: my $jnum = 0;
3937: for (my $k=0; $k<@{$$settings{$id}{$list}{jumbledtype}}; $k++) {
3938: if ($$settings{$id}{$list}{jumbledtype}[$k] eq 'No') {
3939: $output .= qq|
3940: <startouttext />
3941: $$settings{$id}{$list}{jumbledtext}[$k]
3942: <endouttext />|;
3943: } elsif ($$settings{$id}{$list}{jumbledtype}[$k] eq 'Yes') {
3944: $jnum ++;
3945: my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$jnum];
3946: $output .= qq|
3947: <optionresponse max="1" randomize="yes" TeXlayout="horizontal">
3948: <foilgroup options="$foiloptions{$list}[$i]">
3949: <foil location="random" value="$$settings{$id}{$list}{$jumble_item}{text}" name="$jumble_item"></foil>
3950: </foilgroup>
3951: </optionresponse>
3952: |;
3953: }
3954: }
3955: }
3956: if ($numalternates > 0) { # for now alternates are stored in an instructorcomment. In the future these alternates could be moved into the main response area once <or> functionality is available.
3957: $output .= '<instructorcomment>(Not shown to students) '."\n".'The following alternates were imported from the corresponding WebCT Vista 4 jumbled sentence question, but are not included in the LON-CAPA version, because this style of question does not currently support multiple correct solutions.'."\n";
3958: for (my $i=2; $i<@{$$settings{$id}{$list}{jumbled}}; $i++) {
3959: my $altid = $i-1;
3960: my $jnum = 0;
3961: $output .= $altid.'. ';
3962: for (my $k=0; $k<@{$$settings{$id}{$list}{jumbledtype}}; $k++) {
3963: if ($$settings{$id}{$list}{jumbledtype}[$k] eq 'No') {
3964: $output .= "$$settings{$id}{$list}{jumbledtext}[$k]" ;
3965: } elsif ($$settings{$id}{$list}{jumbledtype}[$k] eq 'Yes') {
3966: $jnum ++;
3967: my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$jnum];
3968: $output .= '['.$$settings{$id}{$list}{$jumble_item}{text}.']';
3969: }
3970: }
3971: $output .= " \n";
3972: }
3973: $output .= '</instructorcomment>';
3974: }
3975: }
3976: }
3977: } else {
3978: if ($context eq 'CSTR') {
3979: $output .= qq|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />\n|;
3980: } else {
3981: $resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
3982: }
3983: if (($$settings{$id}{class} eq 'multiplechoice') ||
3984: ($$settings{$id}{class} eq 'combination')) {
3985: foreach my $list (@{$$settings{$id}{lists}}) {
3986: my $numfoils = @{$$allanswers{$id}{$list}};
3987: if ($$settings{$id}{$list}{rcardinality} eq 'Single') {
3988: if ($context eq 'CSTR') {
3989: $output .= qq|
3990: <radiobuttonresponse max="$numfoils" randomize="$$settings{$id}{$list}{randomize}">
3991: <foilgroup>
3992: |;
3993: } else {
3994: $resourcedata{$symb.'hiddenparts'} = '!radio';
3995: $resourcedata{$symb.'questiontype'} = 'radio';
3996: $resourcedata{$symb.'maxfoils'} = $numfoils;
3997: }
3998: for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
3999: my $iter = $k+1;
4000: $output .= " <foil name=\"foil".$k."\" value=\"";
4001: if (grep/^$$allanswers{$id}{$list}[$k]$/,@{$$settings{$id}{$list}{correctanswer}}) {
4002: $output .= "true\" location=\"";
4003: $resourcedata{$symb.'value'.$iter} = "true";
4004: } else {
4005: $output .= "false\" location=\"";
4006: $resourcedata{$symb.'value'.$iter} = "false";
4007: }
4008: if (lc ($$allanswers{$id}{$list}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
4009: $output .= "bottom\"";
4010: $resourcedata{$symb.'position'.$iter} = "bottom";
4011: } else {
4012: $output .= "random\"";
4013: }
4014: if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
4015: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
4016: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
4017: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
4018: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#</?p>##g;
4019:
4020: }
4021: $output .= "\><startouttext />".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
4022: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
4023: $output .= '<endouttext /></foil>'."\n";
4024: }
4025: if ($context eq 'CSTR') {
4026: chomp($output);
4027: $output .= qq|
4028: </foilgroup>
4029: </radiobuttonresponse>
4030: |;
4031: }
4032: } else {
4033: if ($context eq 'CSTR') {
4034: $output .= qq|
4035: <optionresponse max="$numfoils" randomize="yes">
4036: <foilgroup options="('True','False')">
4037: |;
4038: } else {
4039: $resourcedata{$symb.'newopt'} = '';
4040: $resourcedata{$symb.'delopt'} = '';
4041: $resourcedata{$symb.'options'} = "('True','False')";
4042: $resourcedata{$symb.'hiddenparts'} = '!option';
4043: $resourcedata{$symb.'questiontype'} = 'option';
4044: $resourcedata{$symb.'maxfoils'} = $numfoils;
4045: }
4046: for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
4047: my $iter = $k+1;
4048: $output .= " <foil name=\"foil".$k."\" value=\"";
4049: if (grep/^$$allanswers{$id}{$list}[$k]$/,@{$$settings{$id}{$list}{correctanswer}}) {
4050: $output .= "True\"";
4051: $resourcedata{$symb.'value'.$iter} = "True";
4052: } else {
4053: $output .= "False\"";
4054: $resourcedata{$symb.'value'.$iter} = "False";
4055: }
4056: if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
4057: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
4058: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
4059: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
4060: $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~ s#</?p>##g;
4061: }
4062: $output .= "\><startouttext />".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text}."<br /><endouttext /></foil>\n";
4063: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
4064: }
4065: if ($context eq 'CSTR') {
4066: chomp($output);
4067: $output .= qq|
4068: </foilgroup>
4069: </optionresponse>
4070: |;
4071: }
4072: }
4073: }
4074: } elsif ($$settings{$id}{class} eq 'match') {
4075: my %allmatchers = ();
4076: my @allmatch = ();
4077: my %matchtext = ();
4078: my $anscount = 0;
4079: my %ansnum = ();
4080: my $maxfoils = 0;
4081: my $test_for_html = 0;
4082: foreach my $grp (@{$$allchoices{$id}}) {
4083: $maxfoils += @{$$settings{$id}{$grp}{correctanswer}};
4084: foreach my $answer_id (@{$$allanswers{$id}{$grp}}) {
4085: if ($$settings{$id}{$grp}{$answer_id}{texttype} eq '/text/html') {
4086:
4087: $$settings{$id}{$grp}{$answer_id}{text} = &HTML::Entities::decode($$settings{$id}{$grp}{$answer_id}{text});
4088: $test_for_html = &test_for_html($$settings{$id}{$grp}{$answer_id}{text});
4089: $$settings{$id}{$grp}{$answer_id}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$grp}{$answer_id}{text});
4090: $$settings{$id}{$grp}{$answer_id}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
4091: $$settings{$id}{$grp}{$answer_id}{text} =~ s#</?p>##g;
4092: }
4093: unless (exists($allmatchers{$$settings{$id}{$grp}{$answer_id}{text}})) {
4094: $allmatchers{$$settings{$id}{$grp}{$answer_id}{text}} = $anscount;
4095: $allmatch[$anscount] = $$settings{$id}{$grp}{$answer_id}{text};
4096: $anscount ++;
4097:
4098: }
4099: if (grep/^$answer_id$/,@{$$settings{$id}{$grp}{correctanswer}}) {
4100: push(@{$ansnum{$grp}},$allmatchers{$$settings{$id}{$grp}{$answer_id}{text}});
4101: }
4102: }
4103: if ($context eq 'DOCS') {
4104: $matchtext{$ansnum{$grp}[0]} = $allmatch[$ansnum{$grp}[0]-1];
4105: }
4106: }
4107: my $allmatchlist = "('".join("','",@allmatch)."')";
4108: if ($context eq 'CSTR') {
4109: if ($test_for_html) {
4110: $output .= qq|
4111: <matchresponse max="$maxfoils" randomize="yes">
4112: <foilgroup>
4113: <itemgroup>
4114: |;
4115: } else {
4116: $output .= qq|
4117: <optionresponse max="10" randomize="yes">
4118: <foilgroup options="$allmatchlist">
4119: |;
4120: }
4121: } else {
4122: $resourcedata{$symb.'newopt'} = '';
4123: $resourcedata{$symb.'delopt'} = '';
4124: $resourcedata{$symb.'hiddenparts'} = '!option';
4125: $resourcedata{$symb.'questiontype'} = 'option';
4126: $resourcedata{$symb.'maxfoils'} = $maxfoils;
4127: }
4128: my $iter = 0;
4129: foreach my $match (@allmatch) {
4130: $iter ++;
4131: if ($context eq 'CSTR') {
4132: if ($test_for_html) {
4133: $output .= qq|
4134: <item name="ans_$iter">
4135: <startouttext />$match<endouttext />
4136: </item>
4137: |;
4138: }
4139: }
4140: }
4141: if ($context eq 'CSTR') {
4142: if ($test_for_html) {
4143: $output .= qq|
4144: </itemgroup>
4145: |;
4146: }
4147: }
4148: $iter = 0;
4149: for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
4150: if ($$settings{$id}{$$allchoices{$id}[$k]}{texttype} eq 'text/html') {
4151: $$settings{$id}{$$allchoices{$id}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$$allchoices{$id}[$k]}{text});
4152: $$settings{$id}{$$allchoices{$id}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$$allchoices{$id}[$k]}{text});
4153: $$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
4154: $$settings{$id}{$$allchoices{$id}[$k]}{text} =~ s#</?p>##g;
4155: }
4156: foreach my $ans (@{$ansnum{$$allchoices{$id}[$k]}}) {
4157: $iter ++;
4158: my $ans_id = $ans + 1;
4159: if ($context eq 'CSTR') {
4160: my $value;
4161: if ($test_for_html) {
4162: $value = 'ans_'.$ans_id;
4163: } else {
4164: $value = $allmatch[$ans];
4165: }
4166: $output .= qq|
4167: <foil location="random" value="$value" name="foil_$iter">
4168: <startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
4169: </foil>
4170:
4171: |;
4172: }
4173: }
4174: if ($context eq 'DOCS') {
4175: $resourcedata{$symb.'value'.$iter} = $matchtext{$ansnum{$$allchoices{$id}[$k]}[0]};
4176: $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allchoices{$id}[0]}{text};
4177: }
4178: }
4179: if ($context eq 'CSTR') {
4180: $output .= qq|
4181: </foilgroup>
4182: |;
4183: if ($test_for_html) {
4184: $output .= qq|
4185: </matchresponse>
4186: |;
4187: } else {
4188: $output .= qq|
4189: </optionresponse>
4190: |;
4191: }
4192: } else {
4193: $resourcedata{$symb.'options'} = "('".join("','",@allmatch)."')";
4194: }
4195: } elsif (($$settings{$id}{class} eq 'string') ||
4196: ($$settings{$id}{class} eq 'shortanswer')) {
4197: my $labelnum = 0;
4198: my @str_labels = ();
4199: if ($cms eq 'webctce4') {
4200: foreach my $str_id (@{$$settings{$id}{str}}) {
4201: foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
4202: push(@str_labels,$label);
4203: }
4204: }
4205: } elsif ($cms eq 'webctvista4') {
4206: @str_labels = @{$$settings{$id}{str}};
4207: }
4208: foreach my $label (@str_labels) {
4209: $labelnum ++;
4210: my $numerical = 1;
4211: if ($context eq 'DOCS') {
4212: $numerical = 0;
4213: } else {
4214: for (my $i=0; $i<@{$$settings{$id}{strings}{$label}}; $i++) {
4215: $$settings{$id}{strings}{$label}[$i] =~ s/^\s+//;
4216: $$settings{$id}{strings}{$label}[$i] =~ s/\s+$//;
4217: if ($$settings{$id}{strings}{$label}[$i] =~ m/([^\-\d\.]|\.\.)/) {
4218: $numerical = 0;
4219: }
4220: }
4221: }
4222: if ($numerical) {
4223: my $numans;
4224: my $tol;
4225: if (@{$$settings{$id}{strings}{$label}} == 1) {
4226: $tol = '5%';
4227: $numans = $$settings{$id}{strings}{$label}[0];
4228: } else {
4229: my $min = $$settings{$id}{strings}{$label}[0];
4230: my $max = $$settings{$id}{strings}{$label}[0];
4231: for (my $k=1; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
4232: if ($$settings{$id}{strings}{$label}[$k] <= $min) {
4233: $min = $$settings{$id}{strings}{$label}[$k];
4234: }
4235: if ($$settings{$id}{strings}{$label}[$k] >= $max) {
4236: $max = $$settings{$id}{strings}{$label}[$k];
4237: }
4238: }
4239: $numans = ($max + $min)/2;
4240: if ($numans == 0) {
4241: my $dev = abs($max - $numans);
4242: if (abs($numans - $min) > $dev) {
4243: $dev = abs($numans - $min);
4244: }
4245: $tol = $dev;
4246: } else {
4247: $tol = 100*($max - $min)/($numans*2);
4248: $tol .= '%';
4249: }
4250: }
4251: if ($context eq 'CSTR') {
4252: if (@{$$settings{$id}{str}} > 1) {
4253: $output .= qq|
4254: <startouttext />$labelnum.<endouttext />
4255: |;
4256: }
4257: $output .= qq|
4258: <numericalresponse answer="$numans">
4259: <responseparam type="tolerance" default="$tol" name="tol" description="Numerical Tolerance" />
4260: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
4261: />
4262: <textline />
4263: </numericalresponse>
4264: <startouttext /><br /><endouttext />
4265: |;
4266: }
4267: } else {
4268: if ($context eq 'DOCS') {
4269: $resourcedata{$symb.'hiddenparts'} = '!string';
4270: $resourcedata{$symb.'questiontype'} = 'string';
4271: $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}{strings}{$label}};
4272: $resourcedata{$symb.'hiddenparts'} = '!string';
4273: if ($$settings{$id}{$label}{case} eq "No") {
4274: $resourcedata{$symb.'stringtype'} = 'ci';
4275: } elsif ($$settings{$id}{$label}{case} eq "Yes") {
4276: $resourcedata{$symb.'stringtype'} = 'cs';
4277: }
4278: $resourcedata{$symb.'stringanswer'} = $$settings{$id}{strings}{$label}[0];
4279: } else {
4280: if (@{$$settings{$id}{str}} > 1) {
4281: $output .= qq|
4282: <startouttext />$labelnum.<endouttext />
4283: |;
4284: }
4285: if (@{$$settings{$id}{strings}{$label}} == 1) {
4286: my $casetype;
4287: if ($$settings{$id}{$label}{case} eq "No") {
4288: $casetype = 'ci';
4289: } elsif ($$settings{$id}{$label}{case} eq "Yes") {
4290: $casetype = 'cs';
4291: }
4292: $output .= qq|
4293: <stringresponse answer="$$settings{$id}{strings}{$label}[0]" type="$casetype">
4294: <textline>
4295: </textline>
4296: </stringresponse>
4297: <startouttext /><br /><endouttext />
4298: |;
4299: } else {
4300: my @answertext = ();
4301: for (my $k=0; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
4302: $$settings{$id}{strings}{$label}[$k] =~ s/\|/\|/g;
4303: push @answertext, $$settings{$id}{strings}{$label}[$k];
4304: }
4305: my $regexpans = join('|',@answertext);
4306: $regexpans = '/^('.$regexpans.')\b/';
4307: $output .= qq|
4308: <stringresponse answer="$regexpans" type="re">
4309: <textline>
4310: </textline>
4311: </stringresponse>
4312: <startouttext /><br /><endouttext />
4313: |;
4314: }
4315: }
4316: }
4317: }
4318: } elsif ($$settings{$id}{class} eq 'numerical') {
4319: my %mathfns = (
4320: 'abs' => 'abs',
4321: 'acos' => 'acos',
4322: 'asin' => 'asin',
4323: 'atan' => 'atan',
4324: 'ceil' => 'ceil',
4325: 'cos' => 'cos',
4326: 'exp' => 'exp',
4327: 'fact' => 'factorial',
4328: 'floor' => 'floor',
4329: 'int' => 'int',
4330: 'ln' => 'log',
4331: 'log' => 'log',
4332: 'max' => 'max',
4333: 'min' => 'min',
4334: 'round' => 'roundto',
4335: 'sin' => 'sin',
4336: 'sqrt' => 'sqrt',
4337: 'tan' => 'tan',
4338: );
4339: my $scriptblock = qq|
4340: <script type="loncapa/perl">
4341: |;
4342: foreach my $numid (@{$$settings{$id}{numids}}) {
4343: my $formula = $$settings{$id}{$numid}{formula};
4344: my $pattern = join('|',(sort (keys (%mathfns))));
4345: $formula =~ s/($pattern)/\&$mathfns{$1}/g;
4346: foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
4347: my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};
4348: my $increment = '0.';
4349: if ($decnum == 0) {
4350: $increment = 1;
4351: } else {
4352: my $deccount = $decnum;
4353: while ($deccount > 1) {
4354: $increment.= '0';
4355: $deccount --;
4356: }
4357: $increment .= '1';
4358: }
4359: if ($cms eq 'webctce4') {
4360: $formula =~ s/{($var)}/(\$$1)/g;
4361: } elsif ($cms eq 'webctvista4') {
4362: $formula =~ s/\[($var)\]/(\$$1)/g;
4363: }
4364: $scriptblock .= qq|
4365: \$$var=&random($$settings{$id}{$numid}{vars}{$var}{min},$$settings{$id}{$numid}{vars}{$var}{max},$increment);
4366: |;
4367: }
4368: $scriptblock .= qq|
4369: \$answervar = $formula;
4370: </script>
4371: |;
4372: if ($context eq 'CSTR') {
4373: $output = "<problem>\n".$scriptblock.$output;
4374: my $ansformat = '';
4375: my $sigfig = '0,15';
4376: if ($$settings{$id}{$numid}{format} eq 'sig') {
4377: $sigfig = $$settings{$id}{$numid}{digits}.','.$$settings{$id}{$numid}{digits};
4378: } elsif ($$settings{$id}{$numid}{format} eq 'dec') {
4379: $ansformat = $$settings{$id}{$numid}{digits}.'f';
4380: }
4381: if ($ansformat) {
4382: $ansformat = 'format="'.$ansformat.'"';
4383: }
4384: my $tolerance = $$settings{$id}{$numid}{tolerance};
4385: if (lc($$settings{$id}{$numid}{toltype}) eq 'percent') {
4386: $tolerance .= '%';
4387: }
4388: my $unit = '';
4389: foreach my $unitid (@{$$settings{$id}{$numid}{units}}) {
4390: $unit .= $$settings{$id}{$numid}{$unitid}{text};
4391: }
4392: my $unitentry = '';
4393: if ($unit ne '') {
4394: $unitentry = 'unit="'.$unit.'"';
4395: }
4396: $output .= qq|
4397: <numericalresponse $unitentry $ansformat answer="\$answervar">
4398: <responseparam type="tolerance" default="$tolerance" name="tol" description="Numerical Tolerance" />
4399: <responseparam name="sig" type="int_range" default="$sigfig" description="Significant Figures"
4400: />
4401: <textline />
4402: </numericalresponse>
4403: |;
4404: }
4405: }
4406: }
4407: }
4408: if ($context eq 'CSTR') {
4409: my $probdir;
4410: my $catid = $$settings{$id}{category};
4411: if ($catid) {
4412: if ($cms eq 'webctce4') {
4413: $probdir = $$catinfo{$catid}{title}.'_'.$catid;
4414: } else {
4415: $probdir = $$catinfo{$catid}{title};
4416: }
4417: $probdir =~ s/\s/_/g;
4418: $probdir =~ s/://g;
4419: } elsif (defined($dirtitle)) {
4420: $probdir = $dirtitle;
4421: }
4422: if (!-e "$destdir/problems/$probdir") {
4423: mkdir("$destdir/problems/$probdir",0755);
4424: }
4425: if ($allfeedback ne '') {
4426: $output .= qq|
4427: <postanswerdate>
4428: $allfeedback
4429: </postanswerdate>
4430: |;
4431: }
4432: $output .= qq|</problem>
4433: |;
4434: my $title = $$settings{$id}{title};
4435: $title =~ s/\s/_/g;
4436: $title =~ s/:/_/g;
4437: $title =~ s/\//_/g;
4438: $title .= '_'.$id;
4439: open(PROB,">$destdir/problems/$probdir/$title.problem");
4440: print PROB $output;
4441: close PROB;
4442: } else {
4443: # put %resourcedata;
4444: my $reply=&Apache::lonnet::cput
4445: ('resourcedata',\%resourcedata,$cdom,$cnum);
4446: }
4447: }
4448: }
4449:
4450: sub text_cleanup {
4451: my ($text) = @_;
4452: $text =~ s/(\&)(nbsp|gt|lt)(?!;)/$1$2;$3/gi;
4453: $text = &Apache::loncleanup::htmlclean($text);
4454: $text =~ s#(<img src=["']?)([^>]+?)(/?>)#$1../../resfiles/$2 />#gi;
4455: $text =~ s#<([bh])r>#<$1r />#g;
4456: $text =~ s#<p>#<br /><br />#g;
4457: $text =~ s#</p>##g;
4458: return $text;
4459: }
4460:
4461: sub test_for_html {
4462: my ($source) = @_;
4463: my @tags = ();
4464: my $p = HTML::Parser->new
4465: (
4466: xml_mode => 1,
4467: start_h =>
4468: [sub {
4469: my ($tagname) = @_;
4470: push @tags, $tagname;
4471: }, "tagname"],
4472: );
4473: $p->parse($source);
4474: $p->eof;
4475: return length(@tags);
4476: }
4477:
4478: sub write_bb6_questions {
4479: my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
4480: my $qnum = 0;
4481: foreach my $id (@{$allids}) {
4482: my $questiontext = $$settings{$id}{question}{text};
4483: my $question_texttype = $$settings{$id}{question}{texttype};
4484: &process_html(\$questiontext,'bb6',$question_texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
4485: $qnum ++;
4486: my $output;
4487: my $permcontainer = $containerdir;
4488: $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
4489: my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
4490: my %resourcedata = ();
4491: for (my $i=0; $i<10; $i++) {
4492: my $iter = $i+1;
4493: $resourcedata{$symb.'text'.$iter} = "";
4494: $resourcedata{$symb.'value'.$iter} = "unused";
4495: $resourcedata{$symb.'position'.$iter} = "random";
4496: }
4497: $resourcedata{$symb.'randomize'} = 'yes';
4498: $resourcedata{$symb.'maxfoils'} = 10;
4499: if ($context eq 'CSTR') {
4500: $output = qq|<problem>
4501: |;
4502: }
4503: $$total{prob} ++;
4504: $questiontext .= &add_images_links('question',$context,$settings,$id,$dirname,$res);
4505: if ($$settings{$id}{class} eq "Essay") {
4506: if ($context eq 'CSTR') {
4507: $output .= qq|<startouttext />$questiontext<endouttext />
4508: <essayresponse>
4509: <textfield></textfield>
4510: </essayresponse>
4511: |;
4512: } else {
4513: $resourcedata{$symb.'questiontext'} = $questiontext;
4514: $resourcedata{$symb.'hiddenparts'} = '!essay';
4515: $resourcedata{$symb.'questiontype'} = 'essay';
4516: }
4517: } else {
4518: if ($context eq 'CSTR') {
4519: $output .= qq|<startouttext />$questiontext\n<endouttext />|;
4520: } else {
4521: $resourcedata{$symb.'questiontext'} = $questiontext;
4522: }
4523: my $numfoils = @{$$settings{$id}{answers}};
4524: if (($$settings{$id}{class} eq 'Multiple Choice') ||
4525: ($$settings{$id}{class} eq 'True/False')) {
4526: if ($context eq 'CSTR') {
4527: $output .= qq|
4528: <radiobuttonresponse max="$numfoils" randomize="yes">
4529: <foilgroup>
4530: |;
4531: } else {
4532: $resourcedata{$symb.'hiddenparts'} = '!radio';
4533: $resourcedata{$symb.'questiontype'} = 'radio';
4534: $resourcedata{$symb.'maxfoils'} = $numfoils;
4535: }
4536: for (my $k=0; $k<$numfoils; $k++) {
4537: my $iter = $k+1;
4538: my $answer_id = $$settings{$id}{answers}[$k];
4539: my $answer_text = $$settings{$id}{$answer_id}{text};
4540: my $texttype = $$settings{$id}{$answer_id}{texttype};
4541: &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
4542: $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
4543: $output .= " <foil name=\"foil".$k."\" value=\"";
4544: if (grep/^$answer_id$/,@{$$settings{$id}{correctanswer}}) {
4545: $output .= "true\" location=\"";
4546: $resourcedata{$symb.'value'.$iter} = "true";
4547: } else {
4548: $output .= "false\" location=\"";
4549: $resourcedata{$symb.'value'.$iter} = "false";
4550: }
4551: if (lc ($$settings{$id}{$answer_id}{text}) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
4552: $output .= "bottom\"";
4553: $resourcedata{$symb.'position'.$iter} = "bottom";
4554: } else {
4555: $output .= "random\"";
4556: }
4557: $output .= '\><startouttext />'.$answer_text.
4558: '<endouttext /></foil>'."\n";
4559: $resourcedata{$symb.'text'.$iter} = $answer_text;
4560: }
4561: if ($context eq 'CSTR') {
4562: chomp($output);
4563: $output .= qq|
4564: </foilgroup>
4565: <hintgroup showoncorrect="no">
4566: <radiobuttonhint>
4567: </radiobuttonhint>
4568: <hintpart on="default">
4569: <startouttext/><endouttext />
4570: </hintpart>
4571: </hintgroup>
4572: </radiobuttonresponse>
4573: |;
4574: }
4575: } elsif ($$settings{$id}{class} eq 'Multiple Answer') {
4576: if ($context eq 'CSTR') {
4577: $output .= qq|
4578: <optionresponse max="$numfoils" randomize="yes">
4579: <foilgroup options="('True','False')">
4580: |;
4581: } else {
4582: $resourcedata{$symb.'newopt'} = '';
4583: $resourcedata{$symb.'delopt'} = '';
4584: $resourcedata{$symb.'options'} = "('True','False')";
4585: $resourcedata{$symb.'hiddenparts'} = '!option';
4586: $resourcedata{$symb.'questiontype'} = 'option';
4587: $resourcedata{$symb.'maxfoils'} = $numfoils;
4588: }
4589: for (my $k=0; $k<$numfoils; $k++) {
4590: my $iter = $k+1;
4591: my $answer_id = $$settings{$id}{answers}[$k];
4592: my $answer_text = $$settings{$id}{$answer_id}{text};
4593: my $texttype = $$settings{$id}{$answer_id}{texttype};
4594: &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
4595: $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
4596:
4597: $output .= " <foil name=\"foil".$k."\" value=\"";
4598: if (grep/^$answer_id$/,@{$$settings{$id}{correctanswer}}) {
4599: $output .= "True\"";
4600: $resourcedata{$symb.'value'.$iter} = "True";
4601: } else {
4602: $output .= "False\"";
4603: $resourcedata{$symb.'value'.$iter} = "False";
4604: }
4605: $output .= "\><startouttext />".$answer_text."<endouttext /></foil>\n";
4606: $resourcedata{$symb.'text'.$iter} = $answer_text;
4607: }
4608: if ($context eq 'CSTR') {
4609: chomp($output);
4610: $output .= qq|
4611: </foilgroup>
4612: <hintgroup showoncorrect="no">
4613: <optionhint>
4614: </optionhint>
4615: <hintpart on="default">
4616: <startouttext/><endouttext />
4617: </hintpart>
4618: </hintgroup>
4619: </optionresponse>
4620: |;
4621: }
4622: } elsif ($$settings{$id}{class} eq 'Ordering') {
4623: my @allorder = ();
4624: if ($context eq 'CSTR') {
4625: $output .= qq|
4626: <rankresponse max="$numfoils" randomize="yes">
4627: <foilgroup>
4628: |;
4629: } else {
4630: $resourcedata{$symb.'newopt'} = '';
4631: $resourcedata{$symb.'delopt'} = '';
4632: $resourcedata{$symb.'hiddenparts'} = '!option';
4633: $resourcedata{$symb.'questiontype'} = 'option';
4634: $resourcedata{$symb.'maxfoils'} = $numfoils;
4635: }
4636: for (my $k=0; $k<$numfoils; $k++) {
4637: my $answer_id = $$settings{$id}{answers}[$k];
4638: my $answer_text = $$settings{$id}{$answer_id}{text};
4639: my $texttype = $$settings{$id}{$answer_id}{texttype};
4640: &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
4641: $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
4642: my $iter = $k+1;
4643: if ($context eq 'CSTR') {
4644: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$answer_id}{order}."\"><startouttext />".$answer_text."<endouttext /></foil>\n";
4645: } else {
4646: $resourcedata{$symb.'text'.$iter} = $answer_text;
4647: $resourcedata{$symb.'value'.$iter} = $$settings{$id}{$answer_id}{order};
4648: if (!grep/^$$settings{$id}{$answer_id}{order}$/,@allorder) {
4649: push(@allorder,$$settings{$id}{$answer_id}{order});
4650: }
4651: }
4652: }
4653: if ($context eq 'CSTR') {
4654: chomp($output);
4655: $output .= qq|
4656: </foilgroup>
4657: </rankresponse>
4658: |;
4659: } else {
4660: @allorder = sort {$a <=> $b} @allorder;
4661: $resourcedata{$symb.'options'} = "('".join("','",@allorder)."')";
4662: }
4663: } elsif ($$settings{$id}{class} eq 'Fill in the Blank') {
4664: my $numerical = 1;
4665: if ($context eq 'DOCS') {
4666: $numerical = 0;
4667: } else {
4668: for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
4669: if ($$settings{$id}{correctanswer}[$k] =~ m/([^\d\.]|\.\.)/) {
4670: $numerical = 0;
4671: }
4672: }
4673: }
4674: if ($numerical) {
4675: my $numans;
4676: my $tol;
4677: if (@{$$settings{$id}{correctanswer}} == 1) {
4678: $tol = 5;
4679: $numans = $$settings{$id}{correctanswer}[0];
4680: } else {
4681: my $min = $$settings{$id}{correctanswer}[0];;
4682: my $max = $min;
4683: for (my $k=1; $k<@{$$settings{$id}{correctanswer}}; $k++) {
4684: if ($$settings{$id}{correctanswer}[$k] <= $min) {
4685: $min = $$settings{$id}{correctanswer}[$k];
4686: }
4687: if ($$settings{$id}{correctanswer}[$k] >= $max) {
4688: $max = $$settings{$id}{correctanswer}[$k];
4689: }
4690: }
4691: $numans = ($max + $min)/2;
4692: $tol = 100*($max - $min)/($numans*2);
4693: $tol = 5;
4694: }
4695: if ($context eq 'CSTR') {
4696: $output .= qq|
4697: <numericalresponse answer="$numans">
4698: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
4699: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
4700: />
4701: <textline />
4702: </numericalresponse>
4703: <hintgroup showoncorrect="no">
4704: <numericalhint>
4705: </numericalhint>
4706: <hintpart on="default">
4707: <startouttext/><endouttext />
4708: </hintpart>
4709: </hintgroup>
4710: |;
4711: }
4712: } else {
4713: if ($context eq 'DOCS') {
4714: $resourcedata{$symb.'hiddenparts'} = '!string';
4715: $resourcedata{$symb.'questiontype'} = 'string';
4716: $resourcedata{$symb.'maxfoils'} = 1;
4717: $resourcedata{$symb.'hiddenparts'} = '!string';
4718: $resourcedata{$symb.'stringtype'} = 'ci';
4719: $resourcedata{$symb.'stringanswer'} = $$settings{$id}{correctanswer}[0];
4720: } else {
4721: if (@{$$settings{$id}{correctanswer}} == 1) {
4722: $output .= qq|
4723: <stringresponse answer="$$settings{$id}{correctanswer}[0];" type="ci">
4724: <textline>
4725: </textline>
4726: </stringresponse>
4727: <hintgroup showoncorrect="no">
4728: <stringhint type="cs">
4729: </stringhint>
4730: <hintpart on="default">
4731: <startouttext/><endouttext />
4732: </hintpart>
4733: </hintgroup>
4734: |;
4735: } else {
4736: my @answertext = ();
4737: for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
4738: my $answer_text = $$settings{$id}{correctanswer}[$k];
4739: $answer_text =~ s/\|/\|/g;
4740: push @answertext, $answer_text;
4741: }
4742: my $regexpans = join('|',@answertext);
4743: $regexpans = '/^('.$regexpans.')\b/';
4744: $output .= qq|
4745: <stringresponse answer="$regexpans" type="re">
4746: <textline>
4747: </textline>
4748: </stringresponse>
4749: <hintgroup showoncorrect="no">
4750: <stringhint type="cs">
4751: </stringhint>
4752: <hintpart on="default">
4753: <startouttext/><endouttext />
4754: </hintpart>
4755: </hintgroup>
4756: |;
4757: }
4758: }
4759: }
4760: } elsif ($$settings{$id}{class} eq "Matching") {
4761: my @allmatchers = ();
4762: my %matchtext = ();
4763: if ($context eq 'CSTR') {
4764: $output .= qq|
4765: <matchresponse max="10" randomize="yes">
4766: <foilgroup>
4767: <itemgroup>
4768: |;
4769: } else {
4770: $resourcedata{$symb.'newopt'} = '';
4771: $resourcedata{$symb.'delopt'} = '';
4772: $resourcedata{$symb.'hiddenparts'} = '!option';
4773: $resourcedata{$symb.'questiontype'} = 'option';
4774: $resourcedata{$symb.'maxfoils'} = $numfoils;
4775: }
4776: for (my $k=0; $k<$$settings{$id}{allchoices}; $k++) {
4777: my $choice_id = 'rightmatch'.$k;
4778: my $choice_text = $$settings{$id}{$choice_id}{text};
4779: my $texttype = $$settings{$id}{$choice_id}{texttype};
4780: my $choice_plaintext = &remove_html($choice_text);
4781: &process_html(\$choice_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
4782: $choice_text .= &add_images_links($choice_id,$context,$settings,$id,$dirname,$res);
4783: push(@allmatchers,$choice_plaintext);
4784: if ($context eq 'CSTR') {
4785: $output .= qq|
4786: <item name="$choice_id">
4787: <startouttext />$choice_text<endouttext />
4788: </item>
4789: |;
4790: }
4791: }
4792: if ($context eq 'CSTR') {
4793: $output .= qq|
4794: </itemgroup>
4795: |;
4796: }
4797: for (my $k=0; $k<$numfoils; $k++) {
4798: my $answer_id = $$settings{$id}{answers}[$k];
4799: my $answer_text = $$settings{$id}{$answer_id}{text};
4800: my $texttype = $$settings{$id}{$answer_id}{texttype};
4801: &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
4802: $answer_text .= &add_images_links($answer_id,$context,$settings,$id,$dirname,$res);
4803: if ($context eq 'CSTR') {
4804: $output .= '
4805: <foil location="random" value="rightmatch'.$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}.'" name="'.$answer_id.'">
4806: <startouttext />'.$answer_text.'<endouttext />
4807: </foil>
4808: ';
4809: } else {
4810: my $iter = $k+1;
4811: $resourcedata{$symb.'value'.$iter} = "$allmatchers[$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}]";
4812: $resourcedata{$symb.'text'.$iter} = $answer_text;
4813: }
4814: }
4815: if ($context eq 'CSTR') {
4816: $output .= qq|
4817: </foilgroup>
4818: </matchresponse>
4819: |;
4820: } else {
4821: $resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
4822: }
4823: }
4824: }
4825: if ($context eq 'CSTR') {
4826:
4827: $output .= qq|
4828: <postanswerdate>
4829: $$settings{$id}{solutionfeedback}{text}
4830: </postanswerdate>
4831: </problem>
4832: |;
4833: my $title = $$settings{title};
4834: $title =~ s/\s/_/g;
4835: $title =~ s/\W//g;
4836: $title .= '_'.$id;
4837: open(PROB,">$newdir/$title.problem");
4838: print PROB $output;
4839: close PROB;
4840: } else {
4841: # put %resourcedata;
4842: my $reply=&Apache::lonnet::cput
4843: ('resourcedata',\%resourcedata,$cdom,$cnum);
4844: }
4845: }
4846: }
4847:
4848: sub retrieve_image {
4849: my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
4850: my $contents;
4851: my $url = $urlpath.$filename;
4852: my $ua=new LWP::UserAgent;
4853: my $request=new HTTP::Request('GET',$url);
4854: my $response=$ua->request($request);
4855: if ($response->is_success) {
4856: $contents = $response->content;
4857: if (!-e "$docroot/$res") {
4858: mkdir("$docroot/$res",0755);
4859: }
4860: if (!-e "$docroot/$res/webimages") {
4861: mkdir("$docroot/$res/webimages",0755);
4862: }
4863: open(my $fh,">$docroot/$res/webimages/$filename");
4864: print $fh $contents;
4865: close($fh);
4866: if ($context eq 'DOCS') {
4867: my $copyfile = $dirname.'/'.$filename;
4868: my $source = "$docroot/$res/webimages/$filename";
4869: my $fileresult;
4870: if (-e $source) {
4871: $fileresult = &Apache::lonnet::process_coursefile('copy',$cname,$cdom,$copyfile,$source);
4872: }
4873: return $fileresult;
4874: } elsif ($context eq 'CSTR') {
4875: if (!-e "$destdir/resfiles/$res") {
4876: mkdir("$destdir/resfiles/$res",0755);
4877: }
4878: if (!-e "$destdir/resfiles/$res/webimages") {
4879: mkdir("$destdir/resfiles/$res/webimages",0755);
4880: }
4881: rename("$docroot/$res/webimages/$filename","$destdir/resfiles/$res/webimages/$filename");
4882: return 'ok';
4883: }
4884: } else {
4885: return -1;
4886: }
4887: }
4888:
4889: # ---------------------------------------------------------------- Process Blackboard Announcements
4890: sub process_announce {
4891: my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;
4892: my $xmlfile = $docroot.'/'.$res.".dat";
4893: my @state = ();
4894: my @assess = ();
4895: my $id;
4896: my $p = HTML::Parser->new
4897: (
4898: xml_mode => 1,
4899: start_h =>
4900: [sub {
4901: my ($tagname, $attr) = @_;
4902: push @state, $tagname;
4903: if ("@state" eq "ANNOUNCEMENT TITLE") {
4904: $$settings{title} = $attr->{value};
4905: $$settings{startassessment} = ();
4906: } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {
4907: $$settings{ishtml} = $attr->{value};
4908: } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
4909: $$settings{isnewline} = $attr->{value};
4910: } elsif ("@state" eq "ANNOUNCEMENT ISPERMANENT" ) {
4911: $$settings{ispermanent} = $attr->{value};
4912: } elsif ("@state" eq "ANNOUNCEMENT DATES UPDATED") {
4913: $$settings{dates} = $attr->{value};
4914: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) {
4915: $id = $attr->{id};
4916: %{$$settings{startassessment}{$id}} = ();
4917: push @assess,$id;
4918: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) {
4919: my $key = $attr->{key};
4920: $$settings{startassessment}{$id}{$key} = $attr->{value};
4921: }
4922: }, "tagname, attr"],
4923: text_h =>
4924: [sub {
4925: my ($text) = @_;
4926: if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") {
4927: $$settings{text} = $text;
4928: }
4929: }, "dtext"],
4930: end_h =>
4931: [sub {
4932: my ($tagname) = @_;
4933: pop @state;
4934: }, "tagname"],
4935: );
4936: $p->unbroken_text(1);
4937: $p->parse_file($xmlfile);
4938: $p->eof;
4939:
4940: if (defined($$settings{text})) {
4941: if ($$settings{ishtml} eq "false") {
4942: if ($$settings{isnewline} eq "true") {
4943: $$settings{text} =~ s#\n#<br/>#g;
4944: }
4945: } else {
4946: $$settings{text} = &HTML::Entities::decode($$settings{text});
4947: }
4948: }
4949:
4950: if (@assess > 0) {
4951: foreach my $id (@assess) {
4952: $$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.";
4953: }
4954: }
4955:
4956: open(FILE,">$destdir/resfiles/$res.html");
4957: push @{$resrcfiles}, "$res.html";
4958: print FILE qq|<html>
4959: <head>
4960: <title>$$settings{title}</title>
4961: </head>
4962: <body bgcolor='#ffffff'>
4963: <table>
4964: <tr>
4965: <td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{dates}</td>
4966: </tr>
4967: </table>
4968: <br/>
4969: $$settings{text}
4970: |;
4971: print FILE qq|
4972: </body>
4973: </html>|;
4974: close(FILE);
4975: }
4976:
4977: # ---------------------------------------------------------------- Process Blackboard Content
4978: sub process_content {
4979: my ($cms,$res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles,$packages,$hrefs) = @_;
4980: my $xmlfile = $docroot.'/'.$res.".dat";
4981: my $destresdir = $destdir;
4982: if ($context eq 'CSTR') {
4983: $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
4984: } elsif ($context eq 'DOCS') {
4985: $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
4986: }
4987: my $filetag = '';
4988: if ($cms eq 'bb5') {
4989: $filetag = 'FILEREF';
4990: } elsif ($cms eq 'bb6') {
4991: $filetag = 'FILE';
4992: }
4993: my $filecount = 0;
4994: my @allrelfiles = ();
4995: my @state;
4996: @{$$settings{files}} = ();
4997: my $p = HTML::Parser->new
4998: (
4999: xml_mode => 1,
5000: start_h =>
5001: [sub {
5002: my ($tagname, $attr) = @_;
5003: push @state, $tagname;
5004: if ("@state" eq "CONTENT ") {
5005: %{$$settings{maindata}} = ();
5006: } elsif ("@state" eq "CONTENT TITLECOLOR") {
5007: $$settings{titlecolor} = $attr->{value};
5008: } elsif ("@state" eq "CONTENT MAINDATA TEXTCOLOR") {
5009: $$settings{maindata}{color} = $attr->{value};
5010: } elsif ("@state" eq "CONTENT MAINDATA FLAGS ISHTML") {
5011: $$settings{maindata}{ishtml} = $attr->{value};
5012: } elsif ("@state" eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {
5013: $$settings{maindata}{isnewline} = $attr->{value};
5014: } elsif ("@state" eq "CONTENT BODY TYPE") {
5015: $$settings{maindata}{bodytype} = $attr->{value};
5016: } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
5017: $$settings{isavailable} = $attr->{value};
5018: } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
5019: $$settings{isfolder} = $attr->{value};
5020: } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
5021: $$settings{newwindow} = $attr->{value};
5022: } elsif ("@state" eq "CONTENT FILES $filetag") {
5023: %{$$settings{files}[$filecount]} = ();
5024: %{$$settings{files}[$filecount]{registry}} = ();
5025: } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
5026: $$settings{files}[$filecount]{'relfile'} = $attr->{value};
5027: push @allrelfiles, $attr->{value};
5028: } elsif ("@state" eq "CONTENT FILES $filetag MIMETYPE") {
5029: $$settings{files}[$filecount]{mimetype} = $attr->{value};
5030: } elsif ("@state" eq "CONTENT FILES $filetag CONTENTTYPE") {
5031: $$settings{files}[$filecount]{contenttype} = $attr->{value};
5032: } elsif ("@state" eq "CONTENT FILES $filetag FILEACTION") {
5033: $$settings{files}[$filecount]{fileaction} = $attr->{value};
5034: } elsif ("@state" eq "CONTENT FILES $filetag PACKAGEPARENT") {
5035: $$settings{files}[$filecount]{packageparent} = $attr->{value};
5036: } elsif ("@state" eq "CONTENT FILES $filetag LINKNAME") {
5037: $$settings{files}[$filecount]{linkname} = $attr->{value};
5038: } elsif ("@state" eq "CONTENT FILES $filetag REGISTRY REGISTRYENTRY") {
5039: my $key = $attr->{key};
5040: $$settings{files}[$filecount]{registry}{$key} = $attr->{value};
5041: }
5042: }, "tagname, attr"],
5043: text_h =>
5044: [sub {
5045: my ($text) = @_;
5046: if ("@state" eq "CONTENT TITLE") {
5047: $$settings{title} = $text;
5048: } elsif ( ("@state" eq "CONTENT MAINDATA TEXT") || ("@state" eq "CONTENT BODY TEXT") ) {
5049: $$settings{maindata}{text} = $text;
5050: } elsif ("@state" eq "CONTENT FILES $filetag REFTEXT") {
5051: $$settings{files}[$filecount]{reftext} = $text;
5052: } elsif ("@state" eq "CONTENT FILES FILE NAME" ) {
5053: $$settings{files}[$filecount]{'relfile'} = $text;
5054: push @allrelfiles, $text;
5055: }
5056: }, "dtext"],
5057: end_h =>
5058: [sub {
5059: my ($tagname) = @_;
5060: if ("@state" eq "CONTENT FILES $filetag") {
5061: $filecount ++;
5062: }
5063: pop @state;
5064: }, "tagname"],
5065: );
5066: $p->unbroken_text(1);
5067: $p->parse_file($xmlfile);
5068: $p->eof;
5069: my $linktag = '';
5070: my $fontcol = '';
5071: if (@{$$settings{files}} > 0) {
5072: for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) {
5073: if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') {
5074: if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) {
5075: my $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"/>|;
5076: $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#;
5077: } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) {
5078: my $reftag = $1;
5079: my $newtag;
5080: if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) {
5081: $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
5082: if ( defined($$settings{files}[$filecount]{registry}{alttext}) ) {
5083: $newtag .= qq| alt="$$settings{files}[$filecount]{registry}{alttext}"|;
5084: }
5085: if ( defined($$settings{files}[$filecount]{registry}{alignment}) )
5086: {
5087: $newtag .= qq| align="$$settings{files}[$filecount]{registry}{alignment}"|;
5088: }
5089: if ( defined($$settings{files}[$filecount]{registry}{border}) ) {
5090: $newtag .= qq| border="$$settings{files}[$filecount]{registry}{border}"|;
5091: }
5092: $newtag .= " />";
5093: my $reftext = $$settings{files}[$filecount]{reftext};
5094: my $fname = $$settings{files}[$filecount]{'relfile'};
5095: $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
5096: # $$settings{maindata}{text} =~ s/DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
5097: $$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//;
5098: $$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/;
5099: $$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//;
5100: $$settings{maindata}{text} =~ s/\-\->//;
5101: # $$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/;
5102: # print STDERR $$settings{maindata}{text};
5103: }
5104: } else {
5105: my $filename=$$settings{files}[$filecount]{'relfile'};
5106: my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
5107: $$settings{maindata}{text} =~ s#(src|SRC|value)=("|")$filename("|")#$1="$newfilename"#g;
5108: }
5109: } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
5110: unless (($$settings{files}[$filecount]{packageparent} ne '') && (grep/^$$settings{files}[$filecount]{packageparent}$/,@{$$settings{files}}) ) {
5111: $linktag .= qq|<a href="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
5112: if ($$settings{newwindow} eq "true") {
5113: $linktag .= qq| target="$res$filecount"|;
5114: }
5115: foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {
5116: $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
5117: }
5118: $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;
5119: }
5120: } elsif ( ($$settings{files}[$filecount]{fileaction} eq 'PACKAGE') || ($$settings{files}[$filecount]{fileaction} eq 'package') ) {
5121: my $open_package = '';
5122: if ($$settings{files}[$filecount]{'relfile'} =~ m|\.zip$|i) {
5123: $open_package = &expand_zip("$docroot/$res",$$settings{files}[$filecount]{'relfile'});
5124: }
5125: if ($open_package eq 'ok') {
5126: opendir(DIR,"$docroot/$res");
5127: my @dircontents = grep(!/^\./,readdir(DIR));
5128: closedir(DIR);
5129: push @{$resrcfiles}, @dircontents;
5130: @{$$hrefs{$res}} = @dircontents;
5131: push @{$packages}, $res;
5132: }
5133: } elsif ( ($$settings{files}[$filecount]{fileaction} eq 'BROKEN_IMAGE') && ($cms eq 'bb6') ) {
5134: my $filename=$$settings{files}[$filecount]{'relfile'};
5135: my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
5136: $$settings{maindata}{text} =~ s#(src|SRC|value)=("|")$filename("|")#$1="$newfilename"#g;
5137: } elsif ( ($$settings{files}[$filecount]{fileaction} eq 'LINK') && ($cms eq 'bb6') ) {
5138: my $filename=$$settings{files}[$filecount]{'relfile'};
5139: my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
5140: my $filetitle = $$settings{files}[$filecount]{'linkname'};
5141: $$settings{maindata}{text} = '<a href="'.$newfilename.'">'.$filetitle.'</a><br /><br />'. $$settings{maindata}{text};
5142: }
5143: }
5144: }
5145: if (defined($$settings{maindata}{textcolor})) {
5146: $fontcol = qq|<font color="$$settings{maindata}{textcolor}">|;
5147: }
5148: if (defined($$settings{maindata}{text})) {
5149: if ($$settings{maindata}{bodytype} eq "S") {
5150: $$settings{maindata}{text} =~ s#\n#<br/>#g;
5151: }
5152: if ($$settings{maindata}{ishtml} eq "false") {
5153: if ($$settings{maindata}{isnewline} eq "true") {
5154: $$settings{maindata}{text} =~ s#\n#<br/>#g;
5155: }
5156: } else {
5157: # $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
5158: }
5159: }
5160:
5161: if (!open(FILE,">$destdir/resfiles/$res.html")) {
5162: &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
5163: } else {
5164: push @{$resrcfiles}, "$res.html";
5165: my $htmldoc = 0;
5166: # if ($$settings{maindata}{text} =~ m-<(html|HTML)>.+<\\(html|HTML)-) {
5167: if ($$settings{maindata}{text} =~ m-<(html|HTML)>-) {
5168: $htmldoc = 1;
5169: }
5170: unless ($htmldoc) {
5171: print FILE qq|<html>
5172: <head>
5173: <title>$$settings{title}</title>
5174: </head>
5175: <body bgcolor='#ffffff'>
5176: $fontcol
5177: |;
5178: }
5179: unless ($$settings{title} eq '') {
5180: print FILE qq|$$settings{title}<br/><br/>\n|;
5181: }
5182: print FILE qq|
5183: $$settings{maindata}{text}
5184: $linktag|;
5185: unless ($htmldoc) {
5186: if (defined($$settings{maindata}{textcolor})) {
5187: print FILE qq|</font>|;
5188: }
5189: print FILE qq|
5190: </body>
5191: </html>|;
5192: }
5193: close(FILE);
5194: }
5195: }
5196:
5197:
5198: sub process_angelboards {
5199: my ($context,$destdir,$boards,$timestamp,$crs,$cdom,$uname,$db_handling,$messages,$items,$resources,$hrefs,$tempdir,$longcrs) = @_;
5200: for (my $i=0; $i<@{$boards}; $i++) {
5201: my %msgidx = ();
5202: my $forumtext = '';
5203: my $boardname = 'bulletinpage_'.$$timestamp[$i];
5204: my $forumfile = $tempdir.'/_assoc/'.$$boards[$i].'/pg'.$$boards[$i].'.htm';
5205: my @state = ();
5206: my $p = HTML::Parser->new
5207: (
5208: xml_mode => 1,
5209: start_h =>
5210: [sub {
5211: my ($tagname, $attr) = @_;
5212: push @state, $tagname;
5213: }, "tagname, attr"],
5214: text_h =>
5215: [sub {
5216: my ($text) = @_;
5217: if ("@state" eq "html body div div") {
5218: $forumtext = $text;
5219: }
5220: }, "dtext"],
5221: end_h =>
5222: [sub {
5223: my ($tagname) = @_;
5224: pop @state;
5225: }, "tagname"],
5226: );
5227: $p->parse_file($forumfile);
5228: $p->eof;
5229:
5230: my %boardinfo = (
5231: 'aaa_title' => $$items{$$resources{$$boards[$i]}{revitm}}{title},
5232: 'bbb_content' => $forumtext,
5233: 'ccc_webreferences' => '',
5234: 'uploaded.lastmodified' => time,
5235: );
5236: my $msgcount = 0;
5237:
5238: my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
5239: if ($db_handling eq 'importall') {
5240: foreach my $msg_id (@{$$messages{$$boards[$i]}}) {
5241: $msgcount ++;
5242: $msgidx{$msg_id} = $msgcount;
5243: my %contrib = (
5244: 'sendername' => 'NoName',
5245: 'senderdomain' => $cdom,
5246: 'screenname' => '',
5247: 'message' => $$items{$$resources{$msg_id}{revitm}}{title}
5248: );
5249: unless ( $$items{$$resources{$msg_id}{revitm}}{parentseq} eq $$resources{$$boards[$i]}{revitm} ) {
5250: unless ( $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}} eq ''){
5251: $contrib{replyto} = $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}};
5252: }
5253: }
5254: if ( @{$$hrefs{$msg_id}} > 1 ) {
5255: my $newurl = '';
5256: foreach my $file (@{$$hrefs{$msg_id}}) {
5257: unless ($file eq 'pg'.$msg_id.'.htm') {
5258: $newurl = $msg_id.$file;
5259: unless ($longcrs eq '') {
5260: if ($context eq 'CSTR') {
5261: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
5262: mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
5263: }
5264: if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
5265: rename("$destdir/resfiles/$msg_id/$file","/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
5266: }
5267: }
5268: $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$file;
5269: }
5270: }
5271: }
5272: }
5273: my $xmlfile = $tempdir.'/_assoc/'.$msg_id.'/'.$$resources{$msg_id}{file};
5274: &angel_message($msg_id,\%contrib,$xmlfile);
5275: unless ($$resources{$msg_id}{file} eq '') {
5276: unlink($xmlfile);
5277: }
5278: my $symb = 'bulletin___'.$$timestamp[$i].'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$i].'/bulletinboard';
5279: my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
5280: }
5281: }
5282: }
5283: }
5284:
5285: # ---------------------------------------------------------------- Process ANGEL message board messages
5286: sub angel_message {
5287: my ($msg_id,$contrib,$xmlfile) = @_;
5288: my @state = ();
5289: my $p = HTML::Parser->new
5290: (
5291: xml_mode => 1,
5292: start_h =>
5293: [sub {
5294: my ($tagname, $attr) = @_;
5295: push @state, $tagname;
5296: }, "tagname, attr"],
5297: text_h =>
5298: [sub {
5299: my ($text) = @_;
5300: if ("@state" eq "html body table tr td div small span") {
5301: $$contrib{'plainname'} = $text;
5302: } elsif ("@state" eq "html body div div") {
5303: $$contrib{'message'} .= '<br /><br />'.$text;
5304: }
5305: }, "dtext"],
5306: end_h =>
5307: [sub {
5308: my ($tagname) = @_;
5309: pop @state;
5310: }, "tagname"],
5311: );
5312: $p->parse_file($xmlfile);
5313: $p->eof;
5314: }
5315:
5316: # ---------------------------------------------------------------- ANGEL content
5317: sub angel_content {
5318: my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
5319: my $xmlfile = $docroot.'/_assoc/'.$res.'/pg'.$res.'.htm';
5320: my $filecount = 0;
5321: my $firstline;
5322: my $lastline;
5323: my @buffer = ();
5324: my @state;
5325: @{$$settings{links}} = ();
5326: my $p = HTML::Parser->new
5327: (
5328: xml_mode => 1,
5329: start_h =>
5330: [sub {
5331: my ($tagname, $attr) = @_;
5332: push @state, $tagname;
5333: }, "tagname, attr"],
5334: text_h =>
5335: [sub {
5336: my ($text) = @_;
5337: if ("@state" eq "html body table tr td div small span") {
5338: $$settings{'subtitle'} = $text;
5339: } elsif ("@state" eq "html body div div") {
5340: $$settings{'text'} = $text;
5341: } elsif ("@state" eq "html body div div a") {
5342: push @{$$settings{'links'}}, $text;
5343: }
5344: }, "dtext"],
5345: end_h =>
5346: [sub {
5347: my ($tagname) = @_;
5348: pop @state;
5349: }, "tagname"],
5350: );
5351: $p->parse_file($xmlfile);
5352: $p->eof;
5353: if ($type eq "PAGE") {
5354: open(FILE,"<$xmlfile");
5355: @buffer = <FILE>;
5356: close(FILE);
5357: chomp(@buffer);
5358: $firstline = -1;
5359: $lastline = 0;
5360: for (my $i=0; $i<@buffer; $i++) {
5361: if (($firstline == -1) && ($buffer[$i] =~ m/<div\sclass="normalDiv"><div\sclass="normalSpan">/)) {
5362: $firstline = $i;
5363: $buffer[$i] = substr($buffer[$i],index($buffer[$i],'"normalSpan"')+13);
5364: }
5365: if (($firstline > -1) && ($buffer[$i] =~ m-<p></p></div></div>-)) {
5366: $buffer[$i] = substr($buffer[$i],0,index($buffer[$i],'<p></p></div></div>'));
5367: $lastline = $i;
5368: }
5369: }
5370: }
5371: open(FILE,">$destdir/resfiles/$res.html");
5372: push @{$resrcfiles}, "$res.html";
5373: print FILE qq|<html>
5374: <head>
5375: <title>$title</title>
5376: </head>
5377: <body bgcolor='#ffffff'>
5378: |;
5379: unless ($title eq '') {
5380: print FILE qq|<b>$title</b><br/>\n|;
5381: }
5382: unless ($$settings{subtitle} eq '') {
5383: print FILE qq|$$settings{subtitle}<br/>\n|;
5384: }
5385: print FILE "<br/>\n";
5386: if ($type eq "LINK") {
5387: foreach my $link (@{$$settings{links}}) {
5388: print FILE qq|<a href="$link">$link</a><br/>\n|;
5389: }
5390: } elsif ($type eq "PAGE") {
5391: if ($firstline > -1) {
5392: for (my $i=$firstline; $i<=$lastline; $i++) {
5393: print FILE "$buffer[$i]\n";
5394: }
5395: }
5396: }
5397: print FILE qq|
5398: </body>
5399: </html>|;
5400: close(FILE);
5401: }
5402:
5403: # ---------------------------------------------------------------- WebCT content
5404: sub webct4_content {
5405: my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
5406: if (defined($$settings{url})) {
5407: if (!open(FILE,">$destdir/resfiles/$res.html")) {
5408: &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
5409: } else {
5410: push(@{$resrcfiles}, "$res.html");
5411: my $linktag = qq|<a href="$$settings{url}"|;
5412: if ($title ne '') {
5413: $linktag .= qq|>$title</a>|;
5414: } else {
5415: $linktag .= qq|>$$settings{url}|;
5416: }
5417: print FILE qq|<html>
5418: <head>
5419: <title>$title</title>
5420: </head>
5421: <body bgcolor='#ffffff'>
5422: $linktag
5423: </body>
5424: </html>|;
5425: close(FILE);
5426: }
5427: }
5428: }
5429:
5430: sub process_html {
5431: my ($text,$caller,$html_cond,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir) = @_;
5432: my $pathstart;
5433: if ($context eq 'CSTR') {
5434: $pathstart = '../..';
5435: } else {
5436: $pathstart = $dirname;
5437: }
5438: if ($caller eq 'bb5') {
5439: if ($html_cond eq 'true') {
5440: $$text = &HTML::Entities::decode($$text);
5441: }
5442: } elsif ($caller eq 'bb6') {
5443: if ($html_cond eq 'HTML') {
5444: $$text = &HTML::Entities::decode($$text);
5445: }
5446: }
5447: if ($$text =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
5448: if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
5449: $$text =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
5450: }
5451: }
5452: $$text =~ s#(<img src=[^>]+)/*>#$1 />#gi;
5453: $$text =~ s#<br>#<br />#g;
5454: return;
5455: }
5456:
5457: sub add_images_links {
5458: my ($type,$context,$settings,$id,$dirname,$res) = @_;
5459: my ($image,$imglink,$url,$pathstart);
5460: if ($context eq 'CSTR') {
5461: $pathstart = '../..';
5462: } else {
5463: $pathstart = $dirname;
5464: }
5465: if ((defined($$settings{$id}{$type}{image})) && ($$settings{$id}{$type}{image} ne '')) {
5466: if ( $$settings{$id}{$type}{style} eq 'Inline' ) {
5467: $image = qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{$type}{image}" alt="$$settings{$id}{$type}{label}"/><br />|;
5468: } else {
5469: $imglink = qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{$type}{image}">$$settings{$id}{$type}{label}</a><br />|;
5470: }
5471: }
5472: if ((defined($$settings{$id}{$type}{link})) && ($$settings{$id}{$type}{link} ne '' )) {
5473: $url = qq|<br /><a href="$$settings{$id}{$type}{link}">$$settings{$id}{$type}{linkname}</a><br />|;
5474: }
5475: return $image.$imglink.$url;
5476: }
5477:
5478: sub remove_html {
5479: my ($choice_text) = @_;
5480: return $choice_text;
5481: }
5482:
5483:
5484: 1;
5485: __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