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

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

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