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

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

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