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

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

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