Annotation of loncom/imspackages/imsprocessor.pm, revision 1.54

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>