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