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

1.1       raeburn     1: package Apache::imsprocessor;
                      2: 
                      3: use Apache::lonnet;
                      4: use LONCAPA::Configuration;
1.2       raeburn     5: use strict;
1.3     ! raeburn     6: 
        !             7: sub ims_config {
        !             8:     my ($areas,$cmsmap,$areaname) = @_;
        !             9:     @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users");
        !            10:     %{$$cmsmap{bb5}} = (
        !            11:                 announce => 'resource/x-bb-announcement',
        !            12:                 board => 'resource/x-bb-discussionboard',
        !            13:                 doc => 'resource/x-bb-document',
        !            14:                 extlink => 'resource/x-bb-externallink',
        !            15:                 pool => 'assessment/x-bb-pool',
        !            16:                 quiz => 'assessment/x-bb-quiz',
        !            17:                 staff => 'resource/x-bb-staffinfo',
        !            18:                 survey => 'assessment/x-bb-survey',
        !            19:                 users => 'course/x-bb-user',
        !            20:                 );
        !            21:  
        !            22:     %{$$cmsmap{angel}} =  (
        !            23:                 board => 'BOARD',
        !            24:                 extlink => 'LINK',
        !            25:                 msg => 'MESSAGE',
        !            26:                 quiz => 'QUIZ',
        !            27:                 survey => 'FORM',
        !            28:                 );
        !            29: 
        !            30:     @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
        !            31: 
        !            32: 
        !            33:     %{$areaname} = (
        !            34:                 announce => 'Announcements',
        !            35:                 board => 'Discussion Boards',
        !            36:                 doc => 'Documents, pages, and folders',
        !            37:                 extlink => 'Links to external sites',
        !            38:                 pool => 'Question pools',
        !            39:                 quiz => 'Quizzes',
        !            40:                 staff => 'Staff information',
        !            41:                 survey => 'Surveys',
        !            42:                 users => 'Enrollment',
        !            43:                 );
        !            44:          
        !            45: }
1.1       raeburn    46:  
                     47: sub create_tempdir {
1.3     ! raeburn    48:     my ($context,$pathinfo,$timenow) = @_;   
1.1       raeburn    49:     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
                     50:     my $tempdir;
1.3     ! raeburn    51:     if ($context eq 'DOCS') {
1.1       raeburn    52:         $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
                     53:         if (!-e "$tempdir") {
1.2       raeburn    54:             mkdir("$tempdir",0770);
                     55:         } 
                     56:         $tempdir .= '/'.$timenow;
                     57:         if (!-e "$tempdir") {
                     58:             mkdir("$tempdir",0770);
                     59:         } 
1.3     ! raeburn    60:     } elsif ($context eq "CSTR") {
1.1       raeburn    61:         if (!-e "$pathinfo/temp") {
1.2       raeburn    62:             mkdir("$pathinfo/temp",0770);
1.1       raeburn    63:         }
                     64:         $tempdir =  $pathinfo.'/temp';
                     65:     }
                     66:     return $tempdir;
                     67: }
                     68: 
1.3     ! raeburn    69: sub uploadzip {
        !            70:     my ($context,$tempdir,$source) = @_;
        !            71:     my $fname;
        !            72:     if ($context eq 'DOCS') {
        !            73:         $fname=$ENV{'form.uploadname.filename'};
        !            74: # Replace Windows backslashes by forward slashes
        !            75:         $fname=~s/\\/\//g;
        !            76: # Get rid of everything but the actual filename
        !            77:         $fname=~s/^.*\/([^\/]+)$/$1/;
        !            78: # Replace spaces by underscores
        !            79:         $fname=~s/\s+/\_/g;
        !            80: # Replace all other weird characters by nothing
        !            81:         $fname=~s/[^\w\.\-]//g;
        !            82: # See if there is anything left
        !            83:         unless ($fname) { return 'error: no uploaded file'; }
        !            84: # Save the file
        !            85:         chomp($ENV{'form.uploadname'});
        !            86:         open(my $fh,'>'.$tempdir.'/'.$fname);
        !            87:         print $fh $ENV{'form.uploadname'};
        !            88:         close($fh);
        !            89:     } elsif ($context eq 'CSTR') {
        !            90:         if ($source =~ m/\/([^\/]+)$/) {
        !            91:             $fname = $1;
        !            92:             my $destination = $tempdir.'/'.$fname;
        !            93:             rename($source,$destination);
        !            94:         }
        !            95:     }
        !            96:     return $fname;   
        !            97: }
        !            98: 
1.1       raeburn    99: sub expand_zip {
                    100:     my ($tempdir,$filename) = @_;
                    101:     my $zipfile = "$tempdir/$filename";
                    102:     if ($filename =~ m|\.zip$|i) {
                    103:         open(OUTPUT, "unzip -o $zipfile -d $tempdir  2> /dev/null |");
                    104:         while (<OUTPUT>) {
                    105:             print "$_<br />";
                    106:         }
                    107:         close(OUTPUT);
                    108:     } else {
                    109:         return 'nozip';
                    110:     }
                    111:     if ($filename =~ m|\.zip$|i) {
                    112:         unlink($zipfile);
                    113:     }
                    114:     return 'ok';
                    115: }
                    116: 
                    117: sub process_manifest {
1.2       raeburn   118:     my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo) = @_;
1.1       raeburn   119:     my %toc = (
                    120:               bb5 => 'tableofcontents',
                    121:               angel => 'organization',
                    122:               );
1.2       raeburn   123:     my %contents = ();
1.1       raeburn   124:     my @state = ();
                    125:     my $itm = '';
                    126:     my $identifier = '';
                    127:     my @seq = "Top";
                    128:     my $lastitem;
1.2       raeburn   129:     %{$$items{'Top'}} = (
                    130:                       contentscount => 0,
                    131:                       resnum => 'toplevel',
                    132:                       );
1.3     ! raeburn   133:     %{$$resources{'toplevel'}} = (
        !           134:                                   revitm => 'Top'
        !           135:                                  );
1.2       raeburn   136:  
                    137:     if ($cms eq 'angel') {
                    138:         $$resources{'toplevel'}{type} = "FOLDER";
                    139:     } elsif ($cms eq 'bb5') {
                    140:         $$resources{'toplevel'}{type} = 'resource/x-bb-document';
                    141:     }
                    142: 
1.1       raeburn   143: 
                    144:     unless (-e "$tempdir/imsmanifest.xml") {
                    145:         return 'nomanifest';
                    146:     } 
                    147: 
                    148:     my $xmlfile = $tempdir.'/imsmanifest.xml';
                    149:     my $p = HTML::Parser->new
                    150:     (
                    151:        xml_mode => 1,
                    152:        start_h =>
                    153:            [sub {
                    154:                 my ($tagname, $attr) = @_;
                    155:                 push @state, $tagname;
                    156:                 my $num = @state - 3;
                    157:                 my $start = $num;
                    158:                 my $statestr = '';
                    159:                 foreach (@state) {
                    160:                     $statestr .= "$_ ";
                    161:                 }
                    162:                 if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {
                    163:                     my $searchstr = "manifest organizations $toc{$cms}";
                    164:                     while ($num > 0) {
                    165:                         $searchstr .= " item";
                    166:                         $num --; 
                    167:                     }
                    168:                     if (("@state" eq $searchstr) && (@state > 3)) {
                    169:                         $itm = $attr->{identifier};              
                    170:                         %{$$items{$itm}} = ();
                    171:                         $$items{$itm}{contentscount} = 0;
                    172:                         if ($cms eq 'bb5') {
                    173:                             $$items{$itm}{resnum} = $attr->{identifierref};
                    174:                             $$items{$itm}{title} = $attr->{title};
                    175:                         } elsif ($cms eq 'angel') {
                    176:                             if ($attr->{identifierref} =~ m/^res(.+)$/) {
                    177:                                 $$items{$itm}{resnum} = $1;
                    178:                             }
                    179:                         }
1.2       raeburn   180:                         unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
                    181:                             %{$$resources{$$items{$itm}{resnum}}} = ();
1.1       raeburn   182:                         }
                    183:                         $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
                    184: 
                    185:                         if ($start > @seq) {
                    186:                             unless ($lastitem eq '') {
                    187:                                 push @seq, $lastitem;
                    188:                                 unless ( defined($contents{$seq[-1]}) ) {
                    189:                                     @{$contents{$seq[-1]}} = ();
                    190:                                 }
                    191:                                 push @{$contents{$seq[-1]}},$itm;
                    192:                                 $$items{$itm}{parentseq} = $seq[-1];
                    193:                             }
                    194:                         }
                    195:                         elsif ($start < @seq) {
                    196:                             my $diff = @seq - $start;
                    197:                             while ($diff > 0) {
                    198:                                 pop @seq;
                    199:                                 $diff --;
                    200:                             }
                    201:                             if (@seq) {
                    202:                                 push @{$contents{$seq[-1]}}, $itm;
                    203:                             }
                    204:                         } else {
                    205:                             push @{$contents{$seq[-1]}}, $itm;
                    206:                         }
                    207:                         my $path;
                    208:                         if (@seq > 1) {
                    209:                             $path = join(',',@seq);
                    210:                         } elsif (@seq > 0) {
                    211:                             $path = $seq[0];
                    212:                         }
                    213:                         $$items{$itm}{filepath} = $path;
1.2       raeburn   214:                         if ($cms eq 'bb5') {
                    215:                             if ($$items{$itm}{filepath} eq 'Top') {
                    216:                                 $$items{$itm}{resnum} = $itm;
                    217:                                 $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
                    218:                                 $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
                    219:                                 $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
                    220:                             }
                    221:                         }
1.1       raeburn   222:                         $$items{$seq[-1]}{contentscount} ++;
                    223:                         $lastitem = $itm;
                    224:                     }
                    225:                 } elsif ("@state" eq "manifest resources resource" ) {
                    226:                     $identifier = $attr->{identifier};
                    227:                     if ($cms eq 'bb5') {                 
                    228:                         $$resources{$identifier}{file} = $attr->{file};
                    229:                         $$resources{$identifier}{type} = $attr->{type};
                    230:                     } elsif ($cms eq 'angel') {
                    231:                         $identifier = substr($identifier,3);
                    232:                         if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
                    233:                             $$resources{$identifier}{file} = $1;
                    234:                         }                    
                    235:                     }
                    236:                     @{$$hrefs{$identifier}} = ();
                    237:                 } elsif ("@state" eq "manifest resources resource file") {
                    238:                     if ($cms eq 'bb5') {
                    239:                         push @{$$hrefs{$identifier}},$attr->{href};
                    240:                     } elsif ($cms eq 'angel') {
                    241:                         if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
                    242:                             push @{$$hrefs{$identifier}},$1;
                    243:                         } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
                    244:                             $$resources{$identifier}{type} = $1;
                    245:                         } 
                    246:                     }
                    247:                 }
                    248:            }, "tagname, attr"],
                    249:         text_h =>
                    250:             [sub {
                    251:                 my ($text) = @_;
                    252:               }, "dtext"],
                    253:         end_h =>
                    254:               [sub {
                    255:                   my ($tagname) = @_;
                    256:                   pop @state;
                    257:                }, "tagname"],
                    258:     );
                    259:     $p->parse_file($xmlfile);
                    260:     $p->eof;
                    261: 
                    262:     foreach my $itm (keys %contents) {
                    263:         @{$$items{$itm}{contents}} = @{$contents{$itm}};
                    264:     }
                    265:     return 'ok' ;
                    266: }
                    267: 
                    268: sub target_resources {
1.2       raeburn   269:     my ($resources,$oktypes,$targets) = @_;
1.1       raeburn   270:     foreach my $key (keys %{$resources}) {
                    271:         if ( defined($$oktypes{$$resources{$key}{type}}) ) {
                    272:             push @{$targets}, $key;
                    273:         }
                    274:     }
                    275:     return;
                    276: }
                    277: 
                    278: sub copy_resources {
1.2       raeburn   279:     my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$chome,$destdir,$timenow) = @_;
1.1       raeburn   280:     if ($context eq 'DOCS') {
                    281:         foreach my $key (sort keys %{$hrefs}) {
                    282:             if (grep/^$key$/,@{$targets}) {
1.2       raeburn   283:                 %{$$url{$key}} = ();
1.1       raeburn   284:                 foreach my $file (@{$$hrefs{$key}}) {
1.2       raeburn   285:                     my $source = $tempdir.'/'.$key.'/'.$file;
                    286:                     my $filename = '';
1.3     ! raeburn   287:                     my $fpath = $timenow.'/resfiles/'.$key.'/';
        !           288:                     if ($cms eq 'angel') {
        !           289:                         if ($file eq 'pg'.$key.'.htm') {
        !           290:                             next;
1.1       raeburn   291:                         }
                    292:                     }
1.3     ! raeburn   293:                     $file =~ s-\\-/-g;
        !           294:                     $file = $fpath.$file;
        !           295:                     my $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$file,$source);
1.1       raeburn   296:                 }
                    297:             }
                    298:         }
                    299:     } elsif ($context eq 'CSTR') {
                    300:         if (!-e "$destdir/resfiles") {
1.2       raeburn   301:             mkdir("$destdir/resfiles",0770);
1.1       raeburn   302:         }
1.2       raeburn   303:         foreach my $key (sort keys %{$hrefs}) {
                    304:             foreach my $file (@{$$hrefs{$key}}) {
                    305:                 $file =~ s-\\-/-g;
                    306:                 if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') ) {
                    307:                     if (!-e "$destdir/resfiles/$key") {
                    308:                         mkdir("$destdir/resfiles/$key",0770);
1.1       raeburn   309:                     }
1.2       raeburn   310: 
1.1       raeburn   311:                     my $filepath = $file;
1.2       raeburn   312:                     my $front = '';
1.1       raeburn   313:                     while ($filepath =~ m-(\w+)/(.+)-) {
1.2       raeburn   314:                         $front .= $1.'/';
1.1       raeburn   315:                         $filepath = $2;
1.2       raeburn   316:                         my $fulldir = "$destdir/resfiles/$key/$front";
                    317:                         chop($fulldir);
                    318:                         if (!-e "$fulldir") {
                    319:                             mkdir("$fulldir",0770);
                    320:                         }
                    321:                     }
                    322:                     if ($cms eq 'angel') {
                    323:                         rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
                    324:                     } elsif ($cms eq 'bb5') {
                    325:                         rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
                    326:                     }
                    327:                 }
                    328:             }
                    329:         }
                    330:     }
                    331: }
                    332: 
1.3     ! raeburn   333: sub process_coursefile {
        !           334:     my ($crs,$cdom,$chome,$file,$source)=@_;
        !           335:     my $fetchresult = '';
        !           336:     my $fpath = '';
        !           337:     my $fname = $file;
        !           338:     ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/])$/);
        !           339:     $fpath=$cdom.'/'.$crs.'/'.$fpath;
        !           340:     my $filepath=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';
        !           341:     unless ($fpath eq '') {
        !           342:         my @parts=split(/\//,$fpath);
        !           343:         foreach my $part (@parts) {
        !           344:             $filepath.= '/'.$part;
        !           345:             if ((-e $filepath)!=1) {
        !           346:                 mkdir($filepath,0777);
        !           347:             }
        !           348:         }
        !           349:     }
        !           350:     if ($source eq '') {
        !           351:         $fetchresult eq 'no source file provided';
        !           352:     } else {
        !           353:         my $destination = $filepath.'/'.$fname;
        !           354:         rename($source,$destination);
        !           355:         $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome);
        !           356:         unless ($fetchresult eq 'ok') {
        !           357:             &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$fname.' to host '.$chome.': '.$fetchresult);
        !           358:         }
        !           359:     }
        !           360:     return $fetchresult;
        !           361: }
        !           362: 
1.2       raeburn   363: sub process_resinfo {
                    364:     my ($cms,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles) = @_;
                    365:     my $board_id = time;
                    366:     my $board_count = 0;
                    367:     my $announce_handling = 'include';
                    368:     my $longcrs = '';
                    369:     if ($crs =~ m/^(\d)(\d)(\d)/) {
                    370:         $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
                    371:     }
                    372:     if ($cms eq 'angel') {
                    373:         my $currboard = '';
                    374:         foreach my $key (sort keys %{$resources}) {
                    375:             if ($$resources{$key}{type} eq "BOARD") {
                    376:                 push @{$boards}, $key;
                    377:                 $$boardnum{$$resources{$key}{revitm}} = $board_count;
                    378:                 $currboard = $key;
                    379:                 @{$$messages{$key}} = ();
                    380:                 $$timestamp[$board_count] = $board_id;
                    381:                 $board_id ++;
                    382:                 $board_count ++;
                    383:             } elsif ($$resources{$key}{type} eq "MESSAGE") {
                    384:                 push @{$$messages{$currboard}}, $key;
                    385:             } elsif ($$resources{$key}{type} eq "PAGE" || $$resources{$key}{type} eq "LINK") {
                    386:                 %{$$resinfo{$key}} = ();
                    387:                 &angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
                    388:             } elsif ($$resources{$key}{type} eq "QUIZ") {
                    389:                 %{$$resinfo{$key}} = ();
1.3     ! raeburn   390:                 push @{$quizzes}, $key;
1.2       raeburn   391: #               &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
                    392:             } elsif ($$resources{$key}{type} eq "FORM") {
                    393:                 %{$$resinfo{$key}} = ();
1.3     ! raeburn   394:                 push @{$surveys}, $key;
1.2       raeburn   395: #                &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
                    396:             } elsif ($$resources{$key}{type} eq "DROPBOX") {
                    397:                 %{$$resinfo{$key}} = ();
                    398:             }
                    399:         }
                    400:     } elsif ($cms eq 'bb5') {
                    401:         foreach my $key (sort keys %{$resources}) {
                    402:             if ($$resources{$key}{type} eq "resource/x-bb-document") {
                    403:                 unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
1.3     ! raeburn   404:                     %{$$resinfo{$key}} = ();
1.2       raeburn   405:                     &process_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles);
                    406:                 }
                    407:             } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {
                    408:                 %{$$resinfo{$key}} = ();
                    409:                 &process_staff($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
                    410:             } elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") {
                    411:                 %{$$resinfo{$key}} = ();
                    412:                 &process_link($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
                    413:             } elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") {
                    414:                 %{$$resinfo{$key}} = ();
                    415:                 unless ($db_handling eq 'ignore') {
                    416:                     push @{$boards}, $key;
                    417:                     $$timestamp[$board_count] = $board_id;
                    418:                     &process_db($key,$docroot,$destdir,$board_id,$crs,$cdom,$db_handling,$uname,\%{$$resinfo{$key}},$longcrs);
                    419:                     $board_id ++;
                    420:                     $board_count ++;
                    421:                 }
                    422:             } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
                    423:                 %{$$resinfo{$key}} = ();
                    424:                 &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);
                    425:             } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
                    426:                 %{$$resinfo{$key}} = ();
                    427:                 &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);
                    428:                 push @{$quizzes}, $key;
                    429:             } elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {
                    430:                 %{$$resinfo{$key}} = ();
                    431:                 &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);
                    432:                 push @{$surveys}, $key;
                    433:             } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
                    434:                 %{$$resinfo{$key}} = ();
                    435:                 push @{$groups}, $key;
                    436:                 &process_group($key,$docroot,$destdir,\%{$$resinfo{$key}});
                    437:             } elsif ($$resources{$key}{type} eq "resource/x-bb-user") {   
                    438:                 %{$$resinfo{$key}} = ();
                    439:                 unless ($user_handling eq 'ignore') {
                    440:                     &process_user($key,$docroot,$destdir,\%{$$resinfo{$key}},$crs,$cdom,$user_handling);
                    441:                 }
                    442:             } elsif ($$resources{$key}{type} eq "resource/x-bb-announcement") {
                    443:                 unless ($announce_handling eq 'ignore') {
                    444:                     push @{$announcements}, $key;
                    445:                     %{$$resinfo{$key}} = ();
1.3     ! raeburn   446:                     &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
1.2       raeburn   447:                 }
                    448:             }
                    449:         }
1.3     ! raeburn   450:         if (@{$announcements}) {
        !           451:             $$items{'Top'}{'contentscount'} ++;
        !           452:         }
        !           453:         if (@{$boards}) {
        !           454:             $$items{'Top'}{'contentscount'} ++;
        !           455:         }
        !           456:         if (@{$quizzes}) {
        !           457:             $$items{'Top'}{'contentscount'} ++;
        !           458:         }
        !           459:         if (@{$surveys}) {
        !           460:             $$items{'Top'}{'contentscount'} ++;
        !           461:         
        !           462:         }
1.2       raeburn   463:     }
1.3     ! raeburn   464: 
1.2       raeburn   465:     $$total{'board'} = $board_count;
1.3     ! raeburn   466:     $$total{'quiz'} = @{$quizzes};
        !           467:     $$total{'surv'} = @{$surveys};
1.2       raeburn   468: }
                    469: 
                    470: sub build_structure {
1.3     ! raeburn   471:     my ($cms,$context,$destdir,$items,$resinfo,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;
1.2       raeburn   472:     my %flag = ();
                    473:     my %count = ();
                    474:     my %pagecontents = ();
                    475:     my %seqtext = ();
                    476:     my $topnum = 0;
                    477: 
                    478:     if (!-e "$destdir") {
                    479:         mkdir("$destdir",0755);
                    480:     }
                    481:     if (!-e "$destdir/sequences") {
                    482:         mkdir("$destdir/sequences",0770);
                    483:     }
                    484:     if (!-e "$destdir/resfiles") {
                    485:         mkdir("$destdir/resfiles",0770);
                    486:     }
                    487:     if (!-e "$destdir/pages") {
                    488:         mkdir("$destdir/pages",0770);
                    489:     }
                    490:     if (!-e "$destdir/problems") {
                    491:         mkdir("$destdir/problems",0770);
                    492:     }
                    493: 
                    494:     $seqtext{'Top'} = qq|<map>\n|;       
                    495:     %{$$resinfo{$$items{'Top'}{resnum}}} = (
                    496:                                          isfolder => 'true',
                    497:                                         );
                    498: 
                    499:     my $srcstem = "";
                    500:  
                    501:     if ($context eq 'DOCS') {
                    502:         $srcstem = "/uploaded/$cdom/$crs/$timenow";
                    503:     } elsif ($context eq 'CSTR') {
                    504:         $srcstem = "/res/$udom/$uname/$newdir";
                    505:     }
                    506: 
                    507:     foreach my $key (sort keys %{$items}) {
                    508:         %{$flag{$key}} = (
                    509:                           page => 0,
                    510:                           seq => 0,
                    511:                           board => 0,
                    512:                           file => 0,
                    513:                          );
                    514: 
                    515:         %{$count{$key}} = (
                    516:                            page => -1,
                    517:                            seq => 0,
                    518:                            board => 0,
                    519:                            file => 0,
                    520:                           );
                    521: 
                    522:         my $src = "";
                    523: 
                    524:         my $next_id = 2;
                    525:         my $curr_id = 1;
                    526:         my $resnum = $$items{$key}{resnum};
                    527:         my $type = $$resources{$resnum}{type};
                    528:         if (($cms eq 'angel' && $type eq "FOLDER") || ($cms eq 'bb5' && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) ) {
                    529:             unless ($cms eq 'bb5' && $key eq 'Top') {
                    530:                 $seqtext{$key} = "<map>\n";
                    531:             }
                    532:             if ($$items{$key}{contentscount} == 0) {
                    533:                 $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
                    534: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
                    535: <resource id="$next_id" src="" type="finish"></resource>\n|;
                    536:             } else {
                    537:                 my $contcount = @{$$items{$key}{contents}};
                    538:                 my $contitem = $$items{$key}{contents}[0];
                    539:                 my $res = $$items{$contitem}{resnum};
                    540:                 my $type = $$resources{$res}{type};
                    541:                 my $title = $$items{$contitem}{title};
                    542:                 $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);
                    543:                 unless ($flag{$key}{page} == 1) {
                    544:                     $seqtext{$key} .= qq|<resource id="$curr_id" src="$src" title="$title"|;
                    545:                     unless ($cms eq 'bb5' && $key eq 'Top' && @{$announcements}) {
                    546:                         $seqtext{$key} .= qq| type="start"|;
                    547:                     }
                    548:                     unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
                    549:                         $flag{$key}{page} = 1;
                    550:                     }
                    551:                     if ($key eq 'Top') {
                    552:                         push @{$topurls}, $src;
                    553:                         push @{$topnames}, $title;
                    554:                     }
                    555:                 }
                    556:                 if ($contcount == 1) {
                    557:                     $seqtext{$key} .= qq|></resource>
                    558: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
                    559: <resource id="$next_id" src="" type="finish"></resource>\n|;
                    560:                 } else {
                    561:                     if ($contcount > 2 ) {
                    562:                         for (my $i=1; $i<$contcount-1; $i++) {
                    563:                             my $contitem = $$items{$key}{contents}[$i];
                    564:                             my $res = $$items{$contitem}{resnum};
                    565:                             my $type = $$resources{$res}{type};
                    566:                             my $title = $$items{$contitem}{title};  
                    567:                             $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);
                    568:                             unless ($flag{$key}{page} == 1) {
                    569:                                 $seqtext{$key} .= qq|></resource>
                    570: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
                    571: <resource id="$next_id" src="$src" title="$title"|;
                    572:                                 $curr_id ++;
                    573:                                 $next_id ++;
                    574:                                 unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
                    575:                                     $flag{$key}{page} = 1;
                    576:                                 }
                    577:                                 if ($key eq 'Top') {
                    578:                                     push @{$topurls}, $src;
                    579:                                     push @{$topnames}, $title;
                    580:                                 }
                    581:                             }
                    582:                         }
                    583:                     }
                    584:                     my $contitem = $$items{$key}{contents}[-1];
                    585:                     my $res = $$items{$contitem}{resnum};
                    586:                     my $type = $$resources{$res}{type};
                    587:                     my $title = $$items{$contitem}{title};
                    588: 
                    589:                     $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);
                    590:                     if ($flag{$key}{page}) {
                    591:                         if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
                    592:                             $seqtext{$key} .= qq|></resource>
                    593: <link from="$curr_id" index="$curr_id" to="$next_id">
                    594: <resource id ="$next_id" src="" |;
                    595:                         }
                    596:                     } else {
                    597:                         $seqtext{$key} .= qq|></resource>
                    598: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
                    599: <resource id="$next_id" src="$src" title="$title" |;
                    600:                         if ($key eq 'Top') {
                    601:                             push @{$topurls}, $src;
                    602:                             push @{$topnames}, $title;
                    603:                         }
                    604:                     }
                    605:                     if ($contcount == $$items{$key}{contentscount}) {
                    606:                         $seqtext{$key} .= qq|type="finish"></resource>\n|;
                    607:                     } else {
                    608:                         $curr_id ++;
                    609:                         $next_id ++;
                    610:                         $seqtext{$key} .= qq|></resource>
                    611: <link from="$curr_id" to="$next_id index="$curr_id"></link>\n|;
                    612:                     } 
                    613:                 }
                    614:             }
                    615:             unless ($cms eq 'bb5' && $key eq 'Top') {
                    616:                 $seqtext{$key} .= "</map>\n";
                    617:                 open(LOCFILE,">$destdir/sequences/$key.sequence");
                    618:                 print LOCFILE $seqtext{$key};
                    619:                 close(LOCFILE);
                    620:                 push @{$seqfiles}, "$key.sequence";
                    621:             }
                    622:             $count{$key}{page} ++;
                    623:             $$total{page} += $count{$key}{page};
                    624:         }
                    625:         $$total{seq} += $count{$key}{seq};
                    626:     }
                    627:     $topnum += ($count{'Top'}{page} + $count{'Top'}{seq});
                    628: 
                    629:     if ($cms eq 'bb5') {
                    630:         if (@{$announcements} > 0) {
                    631:             &process_specials($context,'announcements',$announcements,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
                    632:         }
                    633:         if (@{$boards} > 0) {
                    634:             &process_specials($context,'boards',$boards,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
                    635:         }
                    636:         if (@{$quizzes} > 0) {
                    637:             &process_specials($context,'quizzes',$quizzes,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
                    638:         }
                    639:         if (@{$surveys} > 0)  {
                    640:             &process_specials($context,'surveys',$surveys,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
                    641:         }
                    642: 
                    643:         $seqtext{'Top'} .= "</map>\n";
                    644:         open(TOPFILE,">$destdir/sequences/Top.sequence");
                    645:         print TOPFILE $seqtext{'Top'};
                    646:         close(TOPFILE);
                    647:         push @{$seqfiles}, 'Top.sequence';
                    648:     }
                    649: 
                    650:     my $filestem;
                    651:     if ($context eq 'DOCS') {
                    652:         $filestem = "/uploaded/$cdom/$crs";
                    653:     } elsif ($context eq 'CSTR') {
                    654:         $filestem = "/res/$udom/$uname/$newdir";
                    655:     }
                    656: 
                    657:     foreach my $key (sort keys %pagecontents) {
                    658:         for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
                    659:             my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
                    660:             open(PAGEFILE,">$filename");
                    661:             print PAGEFILE qq|<map>
1.3     ! raeburn   662: <resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>
1.2       raeburn   663: <link to="2" index="1" from="1">\n|;
                    664:             if (@{$pagecontents{$key}[$i]} == 1) {
1.3     ! raeburn   665:                 print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|;
1.2       raeburn   666:             } elsif (@{$pagecontents{$key}[$i]} == 2)  {
1.3     ! raeburn   667:                 print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][1]}{resnum}.html" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|;
1.2       raeburn   668:             } else {
                    669:                 for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
                    670:                     my $curr_id = $j+1;
                    671:                     my $next_id = $j+2;
                    672:                     my $resource = $filestem.'/resfiles/'.$$items{$pagecontents{$key}[$i][$j]}{resnum}.'.html';
                    673:                     print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$$items{$pagecontents{$key}[$i][$j]}{title}"></resource>
                    674: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
                    675:                 }
                    676:                 my $final_id = @{$pagecontents{$key}[$i]};
1.3     ! raeburn   677:                 print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][-1]}{resnum}.html" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;
1.2       raeburn   678:             }
                    679:             print PAGEFILE "</map>";
                    680:             close(PAGEFILE);
                    681:             push @{$pagesfiles}, $key.'_'.$i.'.page'; 
                    682:         }
                    683:     }
                    684: }
                    685: 
                    686: sub make_structure {
                    687:     my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom) = @_;
                    688:     my $src ='';
                    689:     if (($cms eq 'angel' && $type eq 'FOLDER') || ($cms eq 'bb5' && ($$resinfo{$res}{'isfolder'} eq 'true')  || ($key eq 'Top')) ) {
                    690:         $src = $srcstem.'/sequences/'.$contitem.'.sequence';
                    691:         $$flag{$key}{page} = 0;
                    692:         $$flag{$key}{seq} = 1;
                    693:         $$count{$key}{seq} ++;
                    694:     } elsif ($cms eq 'angel' && $type eq 'BOARD') {
                    695:         $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard'; 
                    696:         $$flag{$key}{page} = 0;
                    697:         $$flag{$key}{board} = 1;
                    698:         $$count{$key}{board} ++;
                    699:     } elsif ($cms eq 'angel' && $type eq "FILE") {
                    700:         foreach my $file (@{$$hrefs{$res}}) {
                    701:             unless ($file eq 'pg'.$res.'.htm') {
                    702:                 $src = $srcstem.'/resfiles/'.$res.'/'.$file;
                    703:             }
                    704:         }
                    705:         $$flag{$key}{page} = 0;
                    706:         $$flag{$key}{file} = 1;
                    707:     } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) )  {
                    708:         if ($$flag{$key}{page}) {
1.3     ! raeburn   709:             if ($$count{$key}{page} == -1) {
        !           710:                 print STDERR "Array index is -1, we shouldnt be here, key is $key, type is $type\n";
1.2       raeburn   711:             } else { 
                    712:                 push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
                    713:             }
                    714:         } else {
                    715:             $$count{$key}{page} ++;
                    716:             $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
                    717:             @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
                    718:             $$flag{$key}{seq} = 0;
                    719:         }
                    720:     } elsif ($cms eq 'bb5') {
                    721:         if ($$flag{$key}{page}) {
                    722:             push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
                    723:         } else {
                    724:             $$count{$key}{page} ++;
                    725:             $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
                    726:             @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
                    727:             $$flag{$key}{seq} = 0;
                    728:         }
                    729:     }
                    730:     return $src;
                    731: }
                    732: 
                    733: 
                    734: # ---------------------------------------------------------------- Process Blackboard specials - announcements, bulletin boards, quizzes and surveys
                    735: sub process_specials {
                    736:     my ($context,$type,$specials,$topnum,$contentscount,$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,$seqtext,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;
                    737:     my $src = '';
                    738:     my $specialsrc = '';
                    739:     my $nextnum = 0;
                    740:     my $seqstem = '';
                    741:     if ($context eq 'CSTR') {
1.3     ! raeburn   742:         $seqstem = "/res/$udom/$uname/$newdir";
1.2       raeburn   743:     } elsif ($context eq 'DOCS') {
                    744:         $seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow;
                    745:     }
                    746:     my %seqnames = (
                    747:                   boards => 'bulletinboards',
                    748:                   quizzes => 'quizzes',
                    749:                   surveys => 'surveys',
                    750:                   announcements => 'announcements',
                    751:                   );
                    752:     my %seqtitles = (
                    753:                   boards => 'Course Bulletin Boards',
                    754:                   quizzes => 'Course Quizzes',
                    755:                   surveys => 'Course Surveys',
                    756:                   announcements => 'Course Announcements',
                    757:                    );
                    758:     $$topnum ++;
                    759: 
                    760:     if ($type eq 'announcements') {
                    761:         $src = "$seqstem/pages/$seqnames{$type}.page";
                    762:     } else {
                    763:         $src = "$seqstem/sequences/$seqnames{$type}.sequence";
                    764:     }
                    765: 
                    766:     push @{$topurls}, $src;
                    767:     push @{$topnames}, $seqtitles{$type};
                    768: 
                    769:     $$seqtext .= qq|<resource id="$$topnum" src="$src" title="$seqtitles{$type}"|;
                    770:     $nextnum = $$topnum +1;
                    771:     if ($$topnum == 1) {
                    772:         $$seqtext .= qq| type="start"></resource>
                    773: <link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
                    774:         if ($$topnum == $contentscount) {
                    775:             $$seqtext .= qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
                    776:         }
                    777:     } else {
                    778:         if ($$topnum == $contentscount) {
                    779:             $$seqtext .= qq| type="finish"></resource>\n|;
                    780:         } else {
                    781:             $$seqtext .= qq|></resource>
                    782: <link from="$$topnum" to="$nextnum" index="$$topnum"></link>\n|;
                    783:         }
                    784:     }
                    785: 
                    786:     if ($type eq "announcements") {
                    787:         push @{$pagesfiles}, "$seqnames{$type}.page";
                    788:         open(ITEM,">$destdir/pages/$seqnames{$type}.page");
                    789:     } else {
                    790:         push @{$seqfiles}, "$seqnames{$type}.sequence";
                    791:         open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence");
                    792:     }
                    793: 
                    794:     if ($type eq 'boards') {
                    795:         $specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";
                    796:     } elsif ($type eq 'announcements') {
                    797:         $specialsrc = "$seqstem/resfiles/$$specials[0].html";
                    798:     } else {
                    799:         $specialsrc = "$seqstem/pages/$$specials[0].page";
                    800:     }
                    801:     print ITEM qq|<map>
                    802: <resource id="1" src="$specialsrc" title="$$resinfo{$$specials[0]}{title}" type="start"></resource>
                    803: <link from="1" to="2" index="1"></link>|;
                    804:     if (@{$specials} == 1) {
                    805:         print ITEM qq|
                    806: <resource id="2" src="" type="finish"></resource>\n|;
                    807:     } else {
                    808:         for (my $i=1; $i<@{$specials}; $i++) {
                    809:             my $curr = $i+1;
                    810:             my $next = $i+2;
                    811:             if ($type eq 'boards') {
                    812:                 $specialsrc = "/adm/$udom/$uname/$$timestamp[$i]/bulletinboard";
                    813:             } elsif ($type eq 'announcements') {
                    814:                 $specialsrc = "$seqstem/resfiles/$$specials[$i].html";
                    815:             } else {
                    816:                 $specialsrc = "$seqstem/pages/$$specials[$i].page";
                    817:             }
                    818:             print ITEM qq|<resource id="$curr" src="$specialsrc" title="$$resinfo{$$specials[$i]}{title}"|;
                    819:             if (@{$specials} == $i+1) {
                    820:                 print ITEM qq| type="finish"></resource>\n|;
                    821:             } else {
                    822:                 print ITEM qq|></resource>
                    823: <link from="$curr" to="$next" index="$next">\n|;
                    824:             }
                    825:         }
                    826:     }
                    827:     print ITEM qq|</map>|;
                    828:     close(ITEM);
                    829: }
                    830: 
                    831: # ---------------------------------------------------------------- Process Blackboard users
                    832: sub process_user {
                    833:   my ($res,$docroot,$destdir,$settings,$user_crs,$user_cdom,$user_handling) = @_;
                    834:   my $xmlfile = $docroot.'/'.$res.".dat";
                    835:   my $filecount = 0;
                    836:   my @state;
                    837:   my $userid = '';
                    838:   my $linknum = 0;
                    839: 
                    840:   my $p = HTML::Parser->new
                    841:     (
                    842:      xml_mode => 1,
                    843:      start_h =>
                    844:      [sub {
                    845:         my ($tagname, $attr) = @_;
                    846:         push @state, $tagname;
                    847:         if (@state eq "USERS USER") {
                    848:             $userid = $attr->{value};
                    849:             %{$$settings{$userid}} = ();
                    850:             @{$$settings{$userid}{links}} = ();
                    851:         } elsif (@state eq "USERS USER LOGINID") {  
                    852:             $$settings{$userid}{loginid} = $attr->{value};
                    853:         } elsif (@state eq "USERS USER PASSPHRASE") {  
                    854:             $$settings{$userid}{passphrase} = $attr->{value};
                    855:         } elsif ("@state" eq "USERS USER STUDENTID" ) {
                    856:             $$settings{$userid}{studentid} = $attr->{value};
                    857:         } elsif ("@state" eq "USERS USER NAMES FAMILY" ) {
                    858:             $$settings{$userid}{family} = $attr->{value};
                    859:         } elsif ("@state" eq "USERS USER NAMES GIVEN" ) {
                    860:             $$settings{$userid}{given} = $attr->{value};
                    861:         } elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") {
                    862:             $$settings{$userid}{email} = $attr->{value};
                    863:         } elsif ("@state" eq "USERS USER USER_ROLE") {
                    864:             $$settings{$userid}{user_role} = $attr->{value};
                    865:         } elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") {
                    866:             $$settings{$userid}{isavailable} = $attr->{value};
                    867:         } elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") {
                    868:             $$settings{$userid}{image} = $attr->{value};
                    869:         } elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) {
                    870:             %{$$settings{$userid}{links}[$linknum]} = ();
                    871:             $$settings{$userid}{links}[$linknum]{url} = $attr->{value};
                    872:             $linknum ++;
                    873:         }
                    874:      }, "tagname, attr"],
                    875:      text_h =>
                    876:      [sub {
                    877:         my ($text) = @_;
                    878:         if ("@state" eq "USERS USER PERSONALPAGE TITLE") {
                    879:             $$settings{$userid}{title} = $text;
                    880:         } elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") {
                    881:             $$settings{$userid}{description} = $text;
                    882:         } elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) {
                    883:             $$settings{$userid}{links}[$linknum]{title} = $text;
                    884:         } elsif (($state[-3] eq "LINK") && ($state[-2] eq  "DESCRIPTION") && ($state[-1] eq "TEXT")) {
                    885:             $$settings{$userid}{links}[$linknum]{text} = $text;
                    886:         }
                    887:       }, "dtext"],
                    888:      end_h =>
                    889:      [sub {
                    890:         my ($tagname) = @_;
                    891:         if (@state eq "USERS USER") {
                    892:             $linknum = 0;
                    893:         }
                    894:         pop @state;
                    895:      }, "tagname"],
                    896:     );
                    897:   $p->unbroken_text(1);
                    898:   $p->parse_file($xmlfile);
                    899:   $p->eof;
                    900:   
                    901:   my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
                    902:   my $xmlstem =  $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";
                    903: 
                    904:   foreach my $user_id (keys %{$settings}) {
                    905:       if ($$settings{$user_id}{user_role} eq "s") {
                    906:            
                    907:       } elsif ($user_handling eq 'enrollall') {
                    908: 
                    909:       }
                    910:   }
                    911: }
                    912: 
                    913: # ---------------------------------------------------------------- Process Blackboard groups
                    914: sub process_group {  
                    915:   my ($res,$docroot,$destdir,$settings) = @_;
                    916:   my $xmlfile = $docroot.'/'.$res.".dat";
                    917:   my $filecount = 0;
                    918:   my @state;
                    919:   my $grp;
                    920: 
                    921:   my $p = HTML::Parser->new
                    922:     (
                    923:      xml_mode => 1,
                    924:      start_h =>
                    925:      [sub {
                    926:         my ($tagname, $attr) = @_;
                    927:         push @state, $tagname;
                    928:         if (@state eq "GROUPS GROUP") {
                    929:             $grp = $attr->{id};
                    930:         }        
                    931:         if (@state eq "GROUPS GROUP TITLE") {
                    932:             $$settings{$grp}{title} = $attr->{value};
                    933:         } elsif (@state eq "GROUPS GROUP FLAGS ISAVAILABLE") {  
                    934:             $$settings{$grp}{isavailable} = $attr->{value};
                    935:         } elsif (@state eq "GROUPS GROUP FLAGS HASCHATROOM") {  
                    936:             $$settings{$grp}{chat} = $attr->{value};
                    937:         } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
                    938:             $$settings{$grp}{discussion} = $attr->{value};
                    939:         } elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") {
                    940:             $$settings{$grp}{transfer} = $attr->{value};
                    941:         } elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") {
                    942:             $$settings{$grp}{public} = $attr->{value};
                    943:         }
                    944:      }, "tagname, attr"],
                    945:      text_h =>
                    946:      [sub {
                    947:         my ($text) = @_;
                    948:         if ("@state" eq "GROUPS DESCRIPTION") {
                    949:           $$settings{$grp}{description} = $text;
                    950: #          print "Staff text is $text\n";
                    951:         }
                    952:       }, "dtext"],
                    953:      end_h =>
                    954:      [sub {
                    955:         my ($tagname) = @_;
                    956:         pop @state;
                    957:      }, "tagname"],
                    958:     );
                    959:   $p->unbroken_text(1);
                    960:   $p->parse_file($xmlfile);
                    961:   $p->eof;
                    962: }
                    963: 
                    964: # ---------------------------------------------------------------- Process Blackboard Staff
                    965: sub process_staff {
                    966:   my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;
                    967:   my $xmlfile = $docroot.'/'.$res.".dat";
                    968:   my $filecount = 0;
                    969:   my @state;
                    970:   %{$$settings{name}} = ();
                    971:   %{$$settings{office}} = ();  
                    972: 
                    973:   my $p = HTML::Parser->new
                    974:     (
                    975:      xml_mode => 1,
                    976:      start_h =>
                    977:      [sub {
                    978:         my ($tagname, $attr) = @_;
                    979:         push @state, $tagname;
                    980:         if (@state eq "STAFFINFO TITLE") {
                    981:             $$settings{title} = $attr->{value};
                    982:         } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
                    983:             $$settings{textcolor} = $attr->{value};
                    984:         } elsif (@state eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
                    985:             $$settings{ishtml} = $attr->{value};
                    986:         } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
                    987:             $$settings{isavailable} = $attr->{value};
                    988:         } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) {
                    989:             $$settings{isfolder} = $attr->{value};
                    990:         } elsif ("@state" eq "STAFFINFO POSITION" ) {
                    991:             $$settings{position} = $attr->{value};
                    992:         } elsif ("@state" eq "STAFFINFO HOMEPAGE" ) {
                    993:             $$settings{homepage} = $attr->{value};
                    994:         } elsif ("@state" eq "STAFFINFO IMAGE") {
                    995:             $$settings{image} = $attr->{value};
                    996:         }
                    997:      }, "tagname, attr"],
                    998:      text_h =>
                    999:      [sub {
                   1000:         my ($text) = @_;
                   1001:         if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") {
                   1002:           $$settings{text} = $text;
                   1003: #          print "Staff text is $text\n";
                   1004:         } elsif ("@state" eq "STAFFINFO CONTACT PHONE") {
                   1005:           $$settings{phone} = $text;
                   1006:         } elsif ("@state" eq "STAFFINFO CONTACT EMAIL") {
                   1007:           $$settings{email} = $text;
                   1008:         } elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") {
                   1009:           $$settings{name}{formaltitle} = $text;
                   1010:         } elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") {
                   1011:           $$settings{name}{family} = $text;
                   1012:         } elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") {
                   1013:           $$settings{name}{given} = $text;
                   1014:         } elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") {
                   1015:           $$settings{office}{hours} = $text;
                   1016:         }  elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") {
                   1017:           $$settings{office}{address} = $text;
                   1018:         }        
                   1019:       }, "dtext"],
                   1020:      end_h =>
                   1021:      [sub {
                   1022:         my ($tagname) = @_;
                   1023:         pop @state;
                   1024:      }, "tagname"],
                   1025:     );
                   1026:   $p->unbroken_text(1);
                   1027:   $p->parse_file($xmlfile);
                   1028:   $p->eof;
                   1029: 
                   1030:     my $fontcol = '';
                   1031:     if (defined($$settings{textcolor})) {
                   1032:         $fontcol =  qq|color="$$settings{textcolor}"|;
                   1033:     }
                   1034:     if (defined($$settings{text})) {
                   1035:         if ($$settings{ishtml} eq "true") {
                   1036:             $$settings{text} = &HTML::Entities::decode($$settings{text});
                   1037:         }
                   1038:     }
                   1039:     my $staffentry = qq|
                   1040: <table border="0" cellpadding="0" cellspacing="0" width="100%">
                   1041:   <tr>
                   1042:     <td colspan="2"><hr /><font face="arial,helv" size="3"><b>$$settings{name}{formaltitle} $$settings{name}{given} $$settings{name}{family}</b></font>
                   1043:     </td>
                   1044:   </tr>
                   1045:   <tr>
                   1046:     <td valign="top">
                   1047:       <table width="100% border="0" cols="2" cellpadding="0" cellspacing="0">|;
                   1048:     if ( defined($$settings{email}) && $$settings{email} ne '') {
                   1049:         $staffentry .= qq|
                   1050:         <tr>
                   1051:           <td width="100" valign="top">
                   1052:            <font face="arial" size="2"><b>Email:</b></font>
                   1053:           </td>
                   1054:           <td>
                   1055:            <font face="arial" size="2"><a href="mailto:$$settings{email}">$$settings{email}</a></font>
                   1056:           </td>
                   1057:         </tr>
                   1058:         |;
                   1059:     }
                   1060:     if (defined($$settings{phone}) && $$settings{phone} ne '') {
                   1061:         $staffentry .= qq|
                   1062:         <tr>
                   1063:           <td width="100" valign="top">
                   1064:             <font face="arial" size="2"><b>Phone:</b></font>
                   1065:           </td>
                   1066:           <td>
                   1067:             <font face="arial" size="2">$$settings{phone}</font>
                   1068:           </td>
                   1069:         </tr>
                   1070:         |;
                   1071:     }
                   1072:     if (defined($$settings{office}{address}) && $$settings{office}{address} ne '') {
                   1073:         $staffentry .= qq|
                   1074:         <tr>
                   1075:          <td width="100" valign="top">
                   1076:            <font face="arial" size="2"><b>Address:</b></font>
                   1077:          </td>
                   1078:          <td>
                   1079:            <font face="arial" size="2">$$settings{office}{address}</font>
                   1080:          </td>
                   1081:         </tr>
                   1082:         |;
                   1083:     }
                   1084:     if (defined($$settings{office}{hours}) && $$settings{office}{hours} ne '') {
                   1085:         $staffentry .= qq|
                   1086:         <tr>
                   1087:           <td width="100" valign="top">
                   1088:             <font face="arial" size="2"><b>Office Hours:</b></font>
                   1089:           </td>
                   1090:           <td>
                   1091:             <font face=arial size=2>$$settings{office}{hours}</font>
                   1092:           </td>
                   1093:         </tr>
                   1094:         |;
                   1095:     }
                   1096:     if ( defined($$settings{homepage}) && $$settings{homepage} ne '') {
                   1097:         $staffentry .= qq|
                   1098:         <tr>
                   1099:           <td width="100" valign="top">
                   1100:             <font face="arial" size="2"><b>Personal Link:</b></font>
                   1101:           </td>
                   1102:           <td>
                   1103:             <font face="arial" size="2"><a href="$$settings{homepage}">$$settings{homepage}</a></font>
                   1104:           </td>
                   1105:         </tr>
                   1106:         |;
                   1107:     }
                   1108:     if (defined($$settings{text}) && $$settings{text} ne '') {
                   1109:         $staffentry .= qq|
                   1110:         <tr>
                   1111:           <td colspan="2">
                   1112:             <font face="arial" size="2" $fontcol><b>Other Information:</b><br/>$$settings{text}</font>
                   1113:           </td>
                   1114:         </tr>
                   1115:         |;
                   1116:      }
                   1117:      $staffentry .= qq|
                   1118:       </table>
                   1119:     </td>
                   1120:     <td align="right" valign="top">
                   1121:      |;
                   1122:      if ( defined($$settings{image}) ) {
                   1123:          $staffentry .= qq|
                   1124:       <img src="$dirname/resfiles/$res/$$settings{image}">
                   1125:          |;
                   1126:      }
                   1127:      $staffentry .= qq|
                   1128:     </td>
                   1129:   </tr>
                   1130: </table>
                   1131:     |;
                   1132:     open(FILE,">$destdir/resfiles/$res.html");
                   1133:     push @{$resrcfiles}, "$res.html";
                   1134:     print FILE qq|<html>
                   1135: <head>
                   1136: <title>$$settings{title}</title>
                   1137: </head>
                   1138: <body bgcolor='#ffffff'>
                   1139: $staffentry
                   1140: </body>
                   1141: </html>|;
                   1142:     close(FILE);
                   1143: }
                   1144: 
                   1145: # ---------------------------------------------------------------- Process Blackboard Links
                   1146: sub process_link {
                   1147:     my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;
                   1148:     my $xmlfile = $docroot.'/'.$res.".dat";
                   1149:     my @state = ();
                   1150:     my $p = HTML::Parser->new
                   1151:     (
                   1152:         xml_mode => 1,
                   1153:         start_h =>
                   1154:         [sub {
                   1155:             my ($tagname, $attr) = @_;
                   1156:             push @state, $tagname;
                   1157:             if (@state eq "EXTERNALLINK TITLE") {
                   1158:                 $$settings{title} = $attr->{value};
                   1159:             } elsif (@state eq "EXTERNALLINK TEXTCOLOR") {  
                   1160:                 $$settings{textcolor} = $attr->{value};
                   1161:             } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {  
                   1162:                 $$settings{ishtml} = $attr->{value};                               
                   1163:             } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {
                   1164:                 $$settings{isavailable} = $attr->{value};
                   1165:             } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {
                   1166:                 $$settings{newwindow} = $attr->{value};
                   1167:             } elsif ("@state" eq "EXTERNALLINK FLAGS ISFOLDER" ) {
                   1168:                 $$settings{isfolder} = $attr->{value};
                   1169:             } elsif ("@state" eq "EXTERNALLINK POSITION" ) {
                   1170:                 $$settings{position} = $attr->{value};
                   1171:             } elsif ("@state" eq "EXTERNALLINK URL" ) {
                   1172:               $$settings{url} = $attr->{value};
                   1173:             }
                   1174:         }, "tagname, attr"],
                   1175:         text_h =>
                   1176:         [sub {
                   1177:             my ($text) = @_;
                   1178:             if ("@state" eq "EXTERNALLINK DESCRIPTION TEXT") {
                   1179:                $$settings{text} = $text;
                   1180:             }
                   1181:         }, "dtext"],
                   1182:         end_h =>
                   1183:         [sub {
                   1184:             my ($tagname) = @_;
                   1185:             pop @state;
                   1186:         }, "tagname"],
                   1187:     );
                   1188:     $p->unbroken_text(1);
                   1189:     $p->parse_file($xmlfile);
                   1190:     $p->eof;
                   1191: 
                   1192:     my $linktag = '';
                   1193:     my $fontcol = '';
                   1194:     if (defined($$settings{textcolor})) {
                   1195:         $fontcol =  qq|<font color="$$settings{textcolor}">|;
                   1196:     }
                   1197:     if (defined($$settings{text})) {
                   1198:         if ($$settings{ishtml} eq "true") {
                   1199:             $$settings{text} = &HTML::Entities::decode($$settings{text});
                   1200:         }
                   1201:     }
                   1202: 
                   1203:     if (defined($$settings{url}) ) {
                   1204:         $linktag = qq|<a href="$$settings{url}"|;
                   1205:         if ($$settings{newwindow} eq "true") {
                   1206:             $linktag .= qq| target="launch"|;
                   1207:         }
                   1208:         $linktag .= qq|>$$settings{title}</a>|;
                   1209:     }
                   1210: 
                   1211:     open(FILE,">$destdir/resfiles/$res.html");
                   1212:     push @{$resrcfiles}, "$res.html";
                   1213:     print FILE qq|<html>
                   1214: <head>
                   1215: <title>$$settings{title}</title>
                   1216: </head>
                   1217: <body bgcolor='#ffffff'>
                   1218: $fontcol
                   1219: $linktag
                   1220: $$settings{text}
                   1221: |;
                   1222:     if (defined($$settings{textcolor})) {
                   1223:         print FILE qq|</font>|;
                   1224:     }
                   1225:     print FILE qq|
                   1226:   </body>
                   1227:  </html>|;
                   1228:     close(FILE);
                   1229: }
                   1230: 
                   1231: # ---------------------------------------------------------------- Process Blackboard Discussion Boards
                   1232: sub process_db {
                   1233:     my ($res,$docroot,$destdir,$timestamp,$crs,$cdom,$handling,$uname,$settings,$longcrs) = @_;
                   1234:     my $xmlfile = $docroot.'/'.$res.".dat";
                   1235:     my @state = ();
                   1236:     my @allmsgs = ();
                   1237:     my %msgidx = ();
                   1238:     my %threads; # all threads, keyed by message ID
                   1239:     my $msg_id; # the current message ID
                   1240:     my %message; # the current message being accumulated for $msg_id
                   1241: 
                   1242:     my $p = HTML::Parser->new
                   1243:     (
                   1244:        xml_mode => 1,
                   1245:        start_h =>
                   1246:        [sub {
                   1247:            my ($tagname, $attr) = @_;
                   1248:            push @state, $tagname;
                   1249:            my $depth = 0;
                   1250:            my @seq = ();
                   1251:            if ("@state" eq "FORUM TITLE") {
                   1252:                $$settings{title} = $attr->{value};
                   1253:            } elsif ("@state" eq "FORUM DESCRIPTION TEXTCOLOR") {  
                   1254:                $$settings{textcolor} = $attr->{value};
                   1255:            } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISHTML") {  
                   1256:                $$settings{ishtml} = $attr->{value};
                   1257:            } elsif ("@state" eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") {  
                   1258:                $$settings{newline} = $attr->{value};
                   1259:            } elsif ("@state" eq "FORUM POSITION" ) {
                   1260:                $$settings{position} = $attr->{value};
                   1261:            } elsif ("@state" eq "FORUM FLAGS ISREADONLY") {
                   1262:                $$settings{isreadonly} = $attr->{value};
                   1263:            } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) {
                   1264:                $$settings{isavailable} = $attr->{value};
                   1265:            } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) {
                   1266:                $$settings{allowanon} = $attr->{value};
                   1267:            } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
                   1268:                if ($state[-1] eq "MSG") {
                   1269:                    unless ($msg_id eq '') {
                   1270:                        push @{$threads{$msg_id}}, { %message };
                   1271:                        $depth = @state - 3;
                   1272:                        if ($depth > @seq) {
                   1273:                            push @seq, $msg_id; 
                   1274:                        }
                   1275:                    }
                   1276:                    if ($depth < @seq) {
                   1277:                        pop @seq;
                   1278:                    }                
                   1279:                    $msg_id = $attr->{id};
                   1280:                    push @allmsgs, $msg_id;
                   1281:                    $msgidx{$msg_id} = @allmsgs;
                   1282:                    %message = ();
                   1283:                    $message{depth} = $depth;
                   1284:                    if ($depth > 0) {
                   1285:                        $message{parent} = $seq[-1];
                   1286:                    } else {
                   1287:                        $message{parent} = "None";
                   1288:                    }
                   1289:                } elsif ($state[-1] eq "TITLE") {
                   1290:                    $message{title} = $attr->{value};
                   1291:                } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISHTML" ) ) {
                   1292:                    $message{ishtml} = $attr->{value};
                   1293:                } elsif ( ( $state[-3] eq "MESSAGETEXT" ) && ( $state[-2] eq "FLAGS" ) && ( $state[-1] eq "ISNEWLINELITERAL" ) ) {
                   1294:                    $message{newline} = $attr->{value};
                   1295:                } elsif ( ( $state[-2] eq "DATES" ) && ( $state[-1] eq "CREATED" ) ) {
                   1296:                    $message{created} = $attr->{value};
                   1297:                } elsif ( $state[@state-2] eq "FLAGS") {
                   1298:                    if ($state[@state-1] eq "ISANONYMOUS") {
                   1299:                        $message{isanonymous} =  $attr->{value};
                   1300:                    }
                   1301:                } elsif ( $state[-2] eq "USER" ) {
                   1302:                    if ($state[-1] eq "USERID") {
                   1303:                        $message{userid} =  $attr->{value};
                   1304:                    } elsif ($state[@state-1] eq "USERNAME") {
                   1305:                        $message{username} =  $attr->{value};
                   1306:                    } elsif ($state[@state-1] eq "EMAIL") {
                   1307:                        $message{email} =  $attr->{value};
                   1308:                    }          
                   1309:                } elsif ( ($state[-2] eq "FILELIST") && ($state[-1] eq "IMAGE") ) {
                   1310:                    $message{attachment} = $attr->{value};
                   1311:                }
                   1312:            }
                   1313:        }, "tagname, attr"],
                   1314:        text_h =>
                   1315:        [sub {
                   1316:            my ($text) = @_;
                   1317:            if ("@state" eq "FORUM DESCRIPTION TEXT") {
                   1318:                $$settings{text} = $text;
                   1319:            } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
                   1320:                if ( ($state[-2] eq "MESSAGETEXT") && ($state[-1] eq "TEXT") ){
                   1321:                    $message{text} = $text;
                   1322:                }
                   1323:            }
                   1324:        }, "dtext"],
                   1325:        end_h =>
                   1326:        [sub {
                   1327:            my ($tagname) = @_;
                   1328:            if ( $state[-1] eq "MESSAGETHREADS" ) {
                   1329:                push @{$threads{$msg_id}}, { %message };
                   1330:            }
                   1331:            pop @state;
                   1332:        }, "tagname"],
                   1333:     );
                   1334:     $p->unbroken_text(1);
                   1335:     $p->parse_file($xmlfile);
                   1336:     $p->eof;
                   1337: 
                   1338:     if (defined($$settings{text})) {
                   1339:         if ($$settings{ishtml} eq "false") {
                   1340:             if ($$settings{isnewline} eq "true") {
                   1341:                 $$settings{text} =~ s#\n#<br/>#g;
                   1342:             }
                   1343:         } else {
                   1344:             $$settings{text} = &HTML::Entities::decode($$settings{text});
                   1345:         }
                   1346:         if (defined($$settings{fontcolor}) ) {
                   1347:             $$settings{text} = "<font color=\"".$$settings{textcolor}."\">".$$settings{text}."</font>";
                   1348:         }
                   1349:     }
                   1350:     my $boardname = 'bulletinpage_'.$timestamp;
                   1351:     my %boardinfo = (
                   1352:                   'aaa_title' => $$settings{title},
                   1353:                   'bbb_content' => $$settings{text},
                   1354:                   'ccc_webreferences' => '',
                   1355:                   'uploaded.lastmodified' => time,
                   1356:                   );
                   1357:   
                   1358:     my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
                   1359:     if ($handling eq 'importall') {
                   1360:         foreach my $msg_id (@allmsgs) {
                   1361:             foreach my $message ( @{$threads{$msg_id}} ) {
                   1362:                 my %contrib = (
                   1363:                             'sendername' => $$message{userid},
                   1364:                             'senderdomain' => $cdom,
                   1365:                             'screenname' => '',
                   1366:                             'plainname' => $$message{username},
                   1367:                             );
                   1368:                 unless ($$message{parent} eq 'None') {
                   1369:                     $contrib{replyto} = $msgidx{$$message{parent}};
                   1370:                 }
                   1371:                 if (defined($$message{isanonymous}) ) {
                   1372:                     if ($$message{isanonymous} eq 'true') {
                   1373:                         $contrib{'anonymous'} = 'true';
                   1374:                     }
                   1375:                 }
                   1376:                 if ( defined($$message{attachment}) )  {
                   1377:                     my $url = $$message{attachment};
                   1378:                     my $oldurl = $url;
                   1379:                     my $newurl = $url;
                   1380:                     unless ($url eq '') {
                   1381:                         $newurl =~ s/\//_/g;
                   1382:                         unless ($longcrs eq '') {
                   1383:                             if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
                   1384:                                 mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
                   1385:                             }
                   1386:                             if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
                   1387:                                 system("cp $destdir/resfiles/$res/$$message{attachment} /home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
                   1388:                             }
                   1389:                             $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$newurl;
                   1390:                         }
                   1391:                     }
                   1392:                 }
                   1393:                 if (defined($$message{title}) ) {
                   1394:                     $contrib{'message'} = $$message{title};
                   1395:                 }
                   1396:                 if (defined($$message{text})) {
                   1397:                     if ($$message{ishtml} eq "false") {
                   1398:                         if ($$message{isnewline} eq "true") {
                   1399:                             $$message{text} =~ s#\n#<br/>#g;
                   1400:                         }
                   1401:                     } else {
                   1402:                         $$message{text} = &HTML::Entities::decode($$message{text});
                   1403:                     }
                   1404:                     $contrib{'message'} .= '<br /><br />'.$$message{text};
                   1405:                     my $symb = 'bulletin___'.$timestamp.'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$timestamp.'/bulletinboard';
                   1406:                     my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
                   1407:                 }
                   1408:             }
                   1409:         }
                   1410:     }
                   1411: }
                   1412: 
                   1413: # ---------------------------------------------------------------- Add Posting to Bulletin Board
                   1414: sub addposting {
                   1415:     my ($symb,$contrib,$cdom,$crs)=@_;
                   1416:     my $status='';
                   1417:     if (($symb) && ($$contrib{message})) {
                   1418:          my $crsdom = $cdom.'_'.$crs;
                   1419:          &Apache::lonnet::store($contrib,$symb,$crsdom,$cdom,$crs);
                   1420:          my %storenewentry=($symb => time);
                   1421:          &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
                   1422:     }
                   1423:     my %record=&Apache::lonnet::restore('_discussion');
                   1424:     my ($temp)=keys %record;
                   1425:     unless ($temp=~/^error\:/) {
                   1426:         my %newrecord=();
                   1427:         $newrecord{'resource'}=$symb;
                   1428:         $newrecord{'subnumber'}=$record{'subnumber'}+1;
                   1429:         &Apache::lonnet::cstore(\%newrecord,'_discussion');
                   1430:         $status = 'ok';
                   1431:     } else {
                   1432:         $status.='Failed.';
                   1433:     }
                   1434:     return $status;
                   1435: }
                   1436: # ---------------------------------------------------------------- Process Blackboard Assessments - pools, quizzes, surveys
                   1437: sub process_assessment {
                   1438:     my ($res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname) = @_;
                   1439:     my $xmlfile = $docroot.'/'.$res.".dat";
                   1440: #  print "XML file is $xmlfile\n";
                   1441:     my @state = ();
                   1442:     my @allids = ();
                   1443:     my %allanswers = ();
                   1444:     my %allchoices = ();
                   1445:     my $resdir = '';
                   1446:     if ($docroot =~ m|public_html/(.+)$|) {
                   1447:         $resdir = $1;
                   1448:     }
                   1449:     my $id; # the current question ID
                   1450:     my $answer_id; # the current answer ID
                   1451:     my %toptag = ( pool => 'POOL',
                   1452:                  quiz => 'ASSESSMENT',
                   1453:                  survey => 'ASSESSMENT'
                   1454:                );
                   1455: 
                   1456:     my $p = HTML::Parser->new
                   1457:     (
                   1458:      xml_mode => 1,
                   1459:      start_h =>
                   1460:      [sub {
                   1461:         my ($tagname, $attr) = @_;
                   1462:         push @state, $tagname;
                   1463:         my $depth = 0;
                   1464:         my @seq = ();
                   1465:         my $class;
                   1466:         my $state_str = join(" ",@state);
                   1467:         if ($container eq "pool") {
                   1468:             if ("@state" eq "POOL TITLE") {
                   1469:                 $$settings{title} = $attr->{value};
                   1470:             }
                   1471:         } else {
                   1472:             if ("@state" eq "ASSESSMENT TITLE") {  
                   1473:                 $$settings{title} = $attr->{value};          
                   1474:             } elsif ("@state" eq "ASSESSMENT FLAG" ) {
                   1475:                 $$settings{isnewline} = $attr->{value};
                   1476:             } elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") {
                   1477:                 $$settings{isavailable} = $attr->{value};
                   1478:             } elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) {
                   1479:                 $$settings{isanonymous} = $attr->{id};
                   1480:             } elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) {
                   1481:                 $$settings{feedback} = $attr->{id};        
                   1482:             } elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) {
                   1483:                 $$settings{showcorrect} = $attr->{id};        
                   1484:             } elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) {
                   1485:                 $$settings{showresults} = $attr->{id};        
                   1486:             } elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) {
                   1487:                 $$settings{allowmultiple} = $attr->{id};        
                   1488:             } elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) {
                   1489:                 $$settings{type} = $attr->{id};        
                   1490:             }
                   1491:         }    
                   1492:         if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {  
                   1493:             $id = $attr->{id};
                   1494:             unless ($container eq 'pool') {
                   1495:                 push @allids, $id;
                   1496:             }
                   1497:             %{$$settings{$id}} = ();
                   1498:             @{$allanswers{$id}} = ();
                   1499:             $$settings{$id}{class} = $attr->{class};
                   1500:             unless ($container eq "pool") {
                   1501:                 $$settings{$id}{points} = $attr->{points};
                   1502:             }
                   1503:             @{$$settings{$id}{correctanswer}} = ();                              
                   1504:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) {
                   1505:             $id = $attr->{id};
                   1506:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
                   1507:             if ($state[4] eq "ISHTML") {
                   1508:                 $$settings{$id}{html} = $attr->{value};
                   1509:             } elsif ($state[4] eq "ISNEWLINELITERAL") {
                   1510:                 $$settings{$id}{newline} = $attr->{value};
                   1511:             }
                   1512:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) {
                   1513:             $$settings{$id}{image} = $attr->{value};
                   1514:             $$settings{$id}{style} = $attr->{style};
                   1515:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) {
                   1516:             $$settings{$id}{url} = $attr->{value};
                   1517:             $$settings{$id}{name} = $attr->{name};
                   1518:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
                   1519:             $answer_id = $attr->{id};
                   1520:             push @{$allanswers{$id}},$answer_id;
                   1521:             %{$$settings{$id}{$answer_id}} = ();
                   1522:             $$settings{$id}{$answer_id}{position} = $attr->{position};
                   1523:             if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
                   1524:                 $$settings{$id}{$answer_id}{placement} = $attr->{placement};
                   1525:                 $$settings{$id}{$answer_id}{type} = 'answer';
                   1526:             }
                   1527:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
                   1528:             $answer_id = $attr->{id};
                   1529:             push @{$allchoices{$id}},$answer_id; 
                   1530:             %{$$settings{$id}{$answer_id}} = ();
                   1531:             $$settings{$id}{$answer_id}{position} = $attr->{position};
                   1532:             $$settings{$id}{$answer_id}{placement} = $attr->{placement};
                   1533:             $$settings{$id}{$answer_id}{type} = 'choice';
                   1534:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") ) {
                   1535:             if ($state[3] eq "IMAGE") {
                   1536:                 $$settings{$id}{$answer_id}{image} = $attr->{value};
                   1537:                 $$settings{$id}{$answer_id}{style} = $attr->{style};
                   1538:             } elsif ($state[3] eq "URL") {
                   1539:                 $$settings{$id}{$answer_id}{url} = $attr->{value};
                   1540:             }
                   1541:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") ) {
                   1542:             if ($state[3] eq "IMAGE") {
                   1543:                 $$settings{$id}{$answer_id}{image} = $attr->{value};
                   1544:                 $$settings{$id}{$answer_id}{style} = $attr->{style};
                   1545:             } elsif ($state[3] eq "URL") {
                   1546:                 $$settings{$id}{$answer_id}{url} = $attr->{value};
                   1547:             }
                   1548:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) {
                   1549:             my $corr_answer = $attr->{answer_id};
                   1550:             push @{$$settings{$id}{correctanswer}}, $corr_answer;
                   1551:             my $type = $1;
                   1552:             if ($type eq 'TRUEFALSE') {
                   1553:                 $$settings{$id}{$corr_answer}{answer_position} = $attr->{position};
                   1554:             } elsif ($type eq 'ORDER') {
                   1555:                 $$settings{$id}{$corr_answer}{order} = $attr->{order};
                   1556:             } elsif ($type eq 'MATCH') {
                   1557:                 $$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id};
                   1558:             }
                   1559:         }
                   1560:      }, "tagname, attr"],
                   1561:      text_h =>
                   1562:      [sub {
                   1563:         my ($text) = @_;
                   1564:         unless ($container eq "pool") {        
                   1565:             if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
                   1566:                 $$settings{description} = $text;
                   1567:             } elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") {
                   1568:                 $$settings{instructions}{text} = $text;
                   1569:             }
                   1570:         }
                   1571:         if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "TEXT") ) {
                   1572:             $$settings{$id}{text} = $text;
                   1573:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) {
                   1574:             $$settings{$id}{$answer_id}{text} = $text;
                   1575:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) {
                   1576:             $$settings{$id}{$answer_id}{text} = $text;            
                   1577:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) {
                   1578:             $$settings{$id}{feedback_corr} = $text;
                   1579:         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) {
                   1580:             $$settings{$id}{feedback_incorr} = $text;       
                   1581:         }
                   1582:       }, "dtext"],
                   1583:      end_h =>
                   1584:      [sub {
                   1585:         my ($tagname) = @_;
                   1586:         pop @state;
                   1587:      }, "tagname"],
                   1588:     );
                   1589:     $p->unbroken_text(1);
                   1590:     $p->parse_file($xmlfile);
                   1591:     $p->eof;
                   1592: 
                   1593:     my $dirtitle = $$settings{'title'};
                   1594:     $dirtitle =~ s/\W//g;
                   1595:     $dirtitle .= '_'.$res;
                   1596:     if (!-e "$destdir/problems/$dirtitle") {
                   1597:         mkdir("$destdir/problems/$dirtitle",0755);
                   1598:     }
                   1599:     my $newdir = "$destdir/problems/$dirtitle";
                   1600:     my $pagedir = "$destdir/pages";
                   1601:     my $curr_id = 0;
                   1602:     my $next_id = 1;
                   1603:     unless ($container eq 'pool') {
                   1604:         open(PAGEFILE,">$pagedir/$res.page");
                   1605:         print PAGEFILE qq|<map>
                   1606: |;
                   1607:         $$total{page} ++; 
                   1608:         print PAGEFILE qq|<resource id="1" src="/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[0].problem" type="start"></resource>|;
                   1609:         if (@allids == 1) {
                   1610:             print PAGEFILE qq|
                   1611: <link from="1" to="2" index="1"></link>
                   1612: <resource id="2" src="" type="finish">\n|;
                   1613:         } else {
                   1614:             for (my $j=1; $j<@allids; $j++) {
                   1615:                 $curr_id = $j;
                   1616:                 $next_id = $curr_id + 1;
                   1617:                 print PAGEFILE qq|
                   1618: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
                   1619: <resource id="$next_id" src="/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[$j].problem"|;
                   1620:                 if ($next_id == @allids) {
                   1621:                     print PAGEFILE qq| type="finish"></resource>\n|;
                   1622:                 } else {
                   1623:                     print PAGEFILE qq|></resource>|;
                   1624:                 }
                   1625:             }
                   1626:         }
                   1627:         print PAGEFILE qq|</map>|;
                   1628:         close(PAGEFILE);
                   1629:     }
                   1630:     foreach my $id (@allids) {
                   1631:         my $output = qq|<problem>
                   1632: |;
1.3     ! raeburn  1633:         $$total{prob} ++;
1.2       raeburn  1634:         if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
                   1635:             $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
                   1636:  <essayresponse>
                   1637:  <textfield></textfield>
                   1638:  </essayresponse>
                   1639:  <postanswerdate>
                   1640:  $$settings{$id}{feedbackcorr}
                   1641:  </postanswerdate>
                   1642: |;
                   1643:         } else {
                   1644:             $output .= qq|<startouttext />$$settings{$id}{text}\n|;
                   1645:             if ( defined($$settings{$id}{image}) ) { 
                   1646:                 if ( $$settings{$id}{style} eq 'embed' ) {
                   1647:                     $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{image}" /><br />|;
                   1648:                 } else {
                   1649:                     $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
                   1650:                 }
                   1651:             }
                   1652:             if ( defined($$settings{$id}{url}) ) {
                   1653:                 $output .= qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
                   1654:             }
                   1655:             $output .= qq|
                   1656: <endouttext />|;
                   1657:             if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
                   1658:                 my $numfoils = @{$allanswers{$id}};
                   1659:                 $output .= qq|
                   1660:  <radiobuttonresponse max="$numfoils" randomize="yes">
                   1661:   <foilgroup>
                   1662: |;
                   1663:                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
                   1664:                     $output .= "   <foil name=\"foil".$k."\" value=\"";
                   1665:                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                   1666:                         $output .= "true\" location=\"";
                   1667:                     } else {
                   1668:                         $output .= "false\" location=\"";
                   1669:                     }
                   1670:                     if (lc ($allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
                   1671:                         $output .= "bottom\"";
                   1672:                     } else {
                   1673:                         $output .= "random\"";
                   1674:                     }
                   1675:                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};
                   1676:                     if ( defined($$settings{$id}{$allanswers{$id}[$k]}{image}) ) {
                   1677:                         if ( $$settings{$id}{$allanswers{$id}[$k]}{style} eq 'embed' ) {
                   1678:                             $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" /><br />|;
                   1679:                         } else {
                   1680:                             $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
                   1681:                         }
                   1682:                     }
                   1683:                     $output .= qq|<endouttext /></foil>\n|;
                   1684:                 }
                   1685:                 chomp($output);
                   1686:                 $output .= qq|
                   1687:   </foilgroup>
                   1688:  </radiobuttonresponse>
                   1689: |;
                   1690:             } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
                   1691:                 my $numfoils = @{$allanswers{$id}};
                   1692:                 $output .= qq|
                   1693:    <radiobuttonresponse max="$numfoils" randomize="yes">
                   1694:     <foilgroup>
                   1695: |;
                   1696:                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
                   1697:                     $output .= "   <foil name=\"foil".$k."\" value=\"";
                   1698:                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                   1699:                         $output .= "true\" location=\"random\"";
                   1700:                     } else {
                   1701:                         $output .= "false\" location=\"random\"";
                   1702:                     }
                   1703:                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                   1704:                 }
                   1705:                 chomp($output);
                   1706:                 $output .= qq|
                   1707:     </foilgroup>
                   1708:    </radiobuttonresponse>
                   1709: |;
                   1710:             } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
                   1711:                 my $numfoils = @{$allanswers{$id}};
                   1712:                 $output .= qq|
                   1713:    <optionresponse max="$numfoils" randomize="yes">
                   1714:     <foilgroup options="('True','False')">
                   1715: |;
                   1716:                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
                   1717:                     $output .= "   <foil name=\"foil".$k."\" value=\"";
                   1718:                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                   1719:                         $output .= "True\"";
                   1720:                     } else {
                   1721:                         $output .= "False\"";
                   1722:                     }
                   1723:                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                   1724:                 }
                   1725:                 chomp($output);
                   1726:                 $output .= qq|
                   1727:     </foilgroup>
                   1728:    </optionresponse>
                   1729: |;
                   1730:             } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
                   1731:                 my $numfoils = @{$allanswers{$id}};
                   1732:                 $output .= qq|
                   1733:    <rankresponse max="$numfoils" randomize="yes">
                   1734:     <foilgroup>
                   1735: |;
                   1736:                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
                   1737:                     $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                   1738:                 }
                   1739:                 chomp($output);
                   1740:                 $output .= qq|
                   1741:     </foilgroup>
                   1742:    </rankresponse>
                   1743: |;
                   1744:             } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
                   1745:                 my $numerical = 1;
                   1746:                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
                   1747:                     if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
                   1748:                         $numerical = 0;
                   1749:                     }
                   1750:                 }
                   1751:                 if ($numerical) {
                   1752:                     my $numans;
                   1753:                     my $tol;
                   1754:                     if (@{$allanswers{$id}} == 1) {
                   1755:                         $tol = 5;
                   1756:                         $numans = $$settings{$id}{$allanswers{$id}[0]}{text};
                   1757:                     } else {
                   1758:                         my $min = $$settings{$id}{$allanswers{$id}[0]}{text};
                   1759:                         my $max = $$settings{$id}{$allanswers{$id}[0]}{text};
                   1760:                         for (my $k=1; $k<@{$allanswers{$id}}; $k++) {
                   1761:                             if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {
                   1762:                                 $min = $$settings{$id}{$allanswers{$id}[$k]}{text};
                   1763:                             }
                   1764:                             if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {
                   1765:                                 $max = $$settings{$id}{$allanswers{$id}[$k]}{text};
                   1766:                             }
                   1767:                         }
                   1768:                         $numans = ($max + $min)/2;
                   1769:                         $tol = 100*($max - $min)/($numans*2);
                   1770:                     }
                   1771:                     $output .= qq|
                   1772: <numericalresponse answer="$numans">
                   1773:         <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
                   1774:         <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
                   1775: />
                   1776:         <textline />
                   1777: </numericalresponse>
                   1778: |;
                   1779:                 } else {
                   1780:                     if (@{$allanswers{$id}} == 1) {
                   1781:                         $output .= qq|
                   1782: <stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">
                   1783: <textline>
                   1784: </textline>
                   1785: </stringresponse>
                   1786: |;
                   1787:                     } else {
                   1788:                         my @answertext = ();
                   1789:                         for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
                   1790:                             $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
                   1791:                             push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};
                   1792:                         }
                   1793:                         my $regexpans = join('|',@answertext);
                   1794:                         $regexpans = '/^('.$regexpans.')\b/';
                   1795:                         $output .= qq|
                   1796: <stringresponse answer="$regexpans" type="re">
                   1797: <textline>
                   1798: </textline>
                   1799: </stringresponse>
                   1800: |;
                   1801:                     }
                   1802:                 }
                   1803:             } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
                   1804:                 $output .= qq|
                   1805: <matchresponse max="10" randomize="yes">
                   1806:     <foilgroup>
                   1807:         <itemgroup>
                   1808: |;
                   1809:                 for (my $k=0; $k<@{$allchoices{$id}}; $k++) {
                   1810:                     $output .= qq|
                   1811: <item name="$allchoices{$id}[$k]">
                   1812: <startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />
                   1813: </item>
                   1814:                     |;
                   1815:                 }
                   1816:                 $output .= qq|
                   1817:         </itemgroup>
                   1818: |;
                   1819:                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
                   1820:                     $output .= qq|
                   1821:         <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">
                   1822:          <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />
                   1823:         </foil>
                   1824: |;
                   1825:                 }
                   1826:                 $output .= qq|
                   1827:     </foilgroup>
                   1828: </matchresponse>
                   1829: |;
                   1830:             }
                   1831:         }
                   1832:         $output .= qq|</problem>
                   1833: |;
                   1834:         open(PROB,">$newdir/$id.problem");
                   1835:         print PROB $output;
                   1836:         close PROB;
                   1837:     }
                   1838: }
                   1839: 
                   1840: # ---------------------------------------------------------------- Process Blackboard Announcements
                   1841: sub process_announce {
1.3     ! raeburn  1842:     my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;
1.2       raeburn  1843:     my $xmlfile = $docroot.'/'.$res.".dat";
                   1844:     my @state = ();
                   1845:     my @assess = ();
                   1846:     my $id;
                   1847:     my $p = HTML::Parser->new
                   1848:     (
                   1849:      xml_mode => 1,
                   1850:      start_h =>
                   1851:      [sub {
                   1852:         my ($tagname, $attr) = @_;
                   1853:         push @state, $tagname;
                   1854:         if ("@state" eq "ANNOUNCEMENT TITLE") {
                   1855:             $$settings{title} = $attr->{value};
                   1856:             $$settings{startassessment} = ();
                   1857:         } elsif (@state eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {  
                   1858:             $$settings{ishtml} = $attr->{value};          
                   1859:         } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
                   1860:             $$settings{isnewline} = $attr->{value};
                   1861:         } elsif ("@state" eq "ANNOUNCEMENT ISPERMANENT" ) {
                   1862:             $$settings{ispermanent} = $attr->{value};
                   1863:         } elsif ("@state" eq "ANNOUNCEMENT DATES UPDATED") {
                   1864:             $$settings{dates} = $attr->{value}; 
                   1865:         } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) {
                   1866:             $id = $attr->{id};
                   1867:             %{$$settings{startassessment}{$id}} = ();
                   1868:             push @assess,$id;
                   1869:         } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) {
                   1870:             my $key = $attr->{key};
                   1871:             $$settings{startassessment}{$id}{$key} = $attr->{value};
                   1872:         }
                   1873:      }, "tagname, attr"],
                   1874:      text_h =>
                   1875:      [sub {
                   1876:         my ($text) = @_;
                   1877:         if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") {
                   1878:             $$settings{text} = $text;
                   1879:         }
                   1880:       }, "dtext"],
                   1881:      end_h =>
                   1882:      [sub {
                   1883:         my ($tagname) = @_;
                   1884:         pop @state;
                   1885:      }, "tagname"],
                   1886:     );
                   1887:     $p->unbroken_text(1);
                   1888:     $p->parse_file($xmlfile);
                   1889:     $p->eof;
                   1890: 
                   1891:     if (defined($$settings{text})) {
                   1892:         if ($$settings{ishtml} eq "false") {
                   1893:             if ($$settings{isnewline} eq "true") {
                   1894:                 $$settings{text} =~ s#\n#<br/>#g;
                   1895:             }
                   1896:         } else {
                   1897:             $$settings{text} = &HTML::Entities::decode($$settings{text});
                   1898:         }
                   1899:     }
                   1900:   
                   1901:     if (@assess > 0) {
                   1902:         foreach my $id (@assess) {
1.3     ! raeburn  1903:             $$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  1904:         }
                   1905:     }
                   1906: 
                   1907:     open(FILE,">$destdir/resfiles/$res.html");
                   1908:     push @{$resrcfiles}, "$res.html";
                   1909:     print FILE qq|<html>
                   1910: <head>
                   1911: <title>$$settings{title}</title>
                   1912: </head>
                   1913: <body bgcolor='#ffffff'>
                   1914: <table>
                   1915:  <tr>
1.3     ! raeburn  1916:   <td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{dates}</td>
1.2       raeburn  1917:  </tr>
                   1918: </table>
                   1919: <br/>
                   1920: $$settings{text}
                   1921: |;
                   1922:     print FILE qq|
                   1923:   </body>
                   1924:  </html>|;
                   1925:     close(FILE);
                   1926: }
                   1927: 
                   1928: # ---------------------------------------------------------------- Process Blackboard Content
                   1929: sub process_content {
                   1930:     my ($res,$docroot,$destdir,$settings,$dom,$user,$resrcfiles) = @_;
                   1931:     my $xmlfile = $docroot.'/'.$res.".dat";
                   1932:     my $destresdir = $destdir;
                   1933:     $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
                   1934:     my $filecount = 0;
                   1935:     my @allrelfiles = ();
                   1936:     my @state;
                   1937:     @{$$settings{files}} = (); 
                   1938:     my $p = HTML::Parser->new
                   1939:     (
                   1940:       xml_mode => 1,
                   1941:       start_h =>
                   1942:       [sub {
                   1943:         my ($tagname, $attr) = @_;
                   1944:         push @state, $tagname;
                   1945:         if (@state eq "CONTENT MAINDATA") {
                   1946:             %{$$settings{maindata}} = ();
                   1947:         } elsif (@state eq "CONTENT MAINDATA TEXTCOLOR") {
                   1948:             $$settings{maindata}{color} = $attr->{value};
                   1949:         } elsif (@state eq "CONTENT MAINDATA FLAGS ISHTML") {  
                   1950:             $$settings{maindata}{ishtml} = $attr->{value}; 
                   1951:         } elsif (@state eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {  
                   1952:             $$settings{maindata}{isnewline} = $attr->{value};
                   1953:         } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
                   1954:             $$settings{isavailable} = $attr->{value};
                   1955:         } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
                   1956:             $$settings{isfolder} = $attr->{value};
                   1957:         } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
                   1958:             $$settings{newwindow} = $attr->{value};
                   1959:         } elsif ("@state" eq "CONTENT FILES FILEREF") {
                   1960:             %{$$settings{files}[$filecount]} = ();
                   1961:             %{$$settings{files}[$filecount]{registry}} = (); 
                   1962:         } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
                   1963:             $$settings{files}[$filecount]{'relfile'} = $attr->{value};
                   1964:             push @allrelfiles, $attr->{value};
                   1965:         } elsif ("@state" eq "CONTENT FILES FILEREF MIMETYPE") {
                   1966:             $$settings{files}[$filecount]{mimetype} = $attr->{value};
                   1967:         } elsif ("@state" eq "CONTENT FILES FILEREF CONTENTTYPE") {
                   1968:             $$settings{files}[$filecount]{contenttype} = $attr->{value};
                   1969:         } elsif ("@state" eq "CONTENT FILES FILEREF FILEACTION") {
                   1970:             $$settings{files}[$filecount]{fileaction} = $attr->{value};
                   1971:         } elsif ("@state" eq "CONTENT FILES FILEREF PACKAGEPARENT") {
                   1972:             $$settings{files}[$filecount]{packageparent} = $attr->{value};
                   1973:         } elsif ("@state" eq "CONTENT FILES FILEREF LINKNAME") {
                   1974:             $$settings{files}[$filecount]{linkname} = $attr->{value};
                   1975:         } elsif ("@state" eq "CONTENT FILES FILEREF REGISTRY REGISTRYENTRY") {
                   1976:             my $key = $attr->{key};
                   1977:             $$settings{files}[$filecount]{registry}{$key} = $attr->{value};
                   1978:         }
                   1979:       }, "tagname, attr"],
                   1980:       text_h =>
                   1981:       [sub {
                   1982:         my ($text) = @_;
                   1983:         if ("@state" eq "CONTENT TITLE") {
                   1984:             $$settings{title} = $text;
                   1985:         } elsif ("@state" eq "CONTENT MAINDATA TEXT") {
                   1986:             $$settings{maindata}{text} = $text;
                   1987:         }  elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") {
                   1988:             $$settings{files}[$filecount]{reftext} = $text;
                   1989:         }
                   1990:        }, "dtext"],
                   1991:       end_h =>
                   1992:       [sub {
                   1993:         my ($tagname) = @_;
                   1994:         if ("@state" eq "CONTENT FILES FILEREF") {
                   1995:             $filecount ++;
                   1996:         }
                   1997:         pop @state;
                   1998:       }, "tagname"],
                   1999:      );
                   2000:     $p->unbroken_text(1);
                   2001:     $p->parse_file($xmlfile);
                   2002:     $p->eof;
                   2003:     my $linktag = '';
                   2004:     my $fontcol = '';
                   2005:     if (@{$$settings{files}} > 0) {
                   2006:         for (my $filecount=0;  $filecount<@{$$settings{files}}; $filecount++) {
                   2007:             if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') {
                   2008:                 if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) { 
                   2009:                     my $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"/>|;
                   2010:                     $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#;
                   2011:                 } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) {
                   2012:                     my $reftag = $1;
                   2013:                     my $newtag;
                   2014:                     if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) {
                   2015:                         $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
                   2016:                         if ( defined($$settings{files}[$filecount]{registry}{alttext}) ) {
                   2017:                             $newtag .= qq| alt="$$settings{files}[$filecount]{registry}{alttext}"|;
                   2018:                         }
                   2019:                         if ( defined($$settings{files}[$filecount]{registry}{alignment}) )
                   2020: {
                   2021:                             $newtag .= qq| align="$$settings{files}[$filecount]{registry}{alignment}"|; 
1.1       raeburn  2022:                         }
1.2       raeburn  2023:                         if ( defined($$settings{files}[$filecount]{registry}{border}) ) {
                   2024:                             $newtag .= qq| border="$$settings{files}[$filecount]{registry}{border}"|;
                   2025:                         }
                   2026:                         $newtag .= " />";
                   2027:                         my $reftext =  $$settings{files}[$filecount]{reftext};
                   2028:                         my $fname = $$settings{files}[$filecount]{'relfile'};
                   2029:                         $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
                   2030: #                      $$settings{maindata}{text} =~ s/DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
                   2031:                         $$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//;
                   2032:                         $$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/;
                   2033:                         $$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//;
                   2034:                         $$settings{maindata}{text} =~ s/\-\->//;
                   2035: #                      $$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/;
                   2036: #                      print STDERR $$settings{maindata}{text};
                   2037:                     }
                   2038:                 } else {
                   2039:                     my $filename=$$settings{files}[$filecount]{'relfile'};
                   2040: #                  print "File is $filename\n";
                   2041:                     my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
                   2042: #                  print "New filename is $newfilename\n";
                   2043:                     $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g;
                   2044:                 }
                   2045:             } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
                   2046:                 unless (($$settings{files}[$filecount]{packageparent} ne '') && (grep/^$$settings{files}[$filecount]{packageparent}$/,@{$$settings{files}}) ) {
                   2047:                     $linktag .= qq|<a href="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
                   2048:                     if ($$settings{newwindow} eq "true") {
                   2049:                         $linktag .= qq| target="$res$filecount"|;
1.1       raeburn  2050:                     }
1.2       raeburn  2051:                     foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {
                   2052:                         $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
1.1       raeburn  2053:                     }
1.2       raeburn  2054:                       $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;
1.1       raeburn  2055:                 }
1.2       raeburn  2056:             } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') {
                   2057: #              print "Found a package\n";
1.1       raeburn  2058:             }
1.2       raeburn  2059:         }
                   2060:     }
                   2061:     if (defined($$settings{maindata}{textcolor})) {
                   2062:         $fontcol =  qq|<font color="$$settings{maindata}{textcolor}">|;
                   2063:     }
                   2064:     if (defined($$settings{maindata}{text})) {
                   2065:         if ($$settings{maindata}{ishtml} eq "false") {
                   2066:             if ($$settings{maindata}{isnewline} eq "true") {
                   2067:                 $$settings{maindata}{text} =~ s#\n#<br/>#g;
                   2068:             }
                   2069:         } else {
                   2070:             $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
                   2071:         }
                   2072:     }
                   2073: 
                   2074:     open(FILE,">$destdir/resfiles/$res.html");
                   2075:     push @{$resrcfiles}, "$res.html";
                   2076:     print FILE qq|<html>
                   2077: <head>
                   2078: <title>$$settings{title}</title>
                   2079: </head>
                   2080: <body bgcolor='#ffffff'>
                   2081: $fontcol
                   2082: |;
                   2083:     unless ($$settings{title} eq '') { 
                   2084:         print FILE qq|$$settings{title}<br/><br/>\n|;
                   2085:     }
                   2086:     print FILE qq|
                   2087: $$settings{maindata}{text}
                   2088: $linktag|;
                   2089:     if (defined($$settings{maindata}{textcolor})) {
                   2090:         print FILE qq|</font>|;
                   2091:     }
                   2092:     print FILE qq|
                   2093:   </body>
                   2094:  </html>|;
                   2095:     close(FILE);
                   2096: }
                   2097: 
                   2098: 
                   2099: sub process_angelboards {
                   2100:     my ($context,$destdir,$boards,$timestamp,$crs,$cdom,$uname,$db_handling,$messages,$items,$resources,$hrefs,$tempdir,$longcrs) = @_;
                   2101:     for (my $i=0; $i<@{$boards}; $i++) {
                   2102:         my %msgidx = ();
                   2103:         my $forumtext = '';
                   2104:         my $boardname = 'bulletinpage_'.$$timestamp[$i];
                   2105:         my $forumfile = $tempdir.'/_assoc/'.$$boards[$i].'/pg'.$$boards[$i].'.htm';
                   2106:         my @state = ();
                   2107:         my $p = HTML::Parser->new
                   2108:         (
                   2109:            xml_mode => 1,
                   2110:            start_h =>
                   2111:            [sub {
                   2112:                 my ($tagname, $attr) = @_;
                   2113:                 push @state, $tagname;
                   2114:                 },  "tagname, attr"],
                   2115:            text_h =>
                   2116:            [sub {
                   2117:                 my ($text) = @_;
                   2118:                 if ("@state" eq "html body div div") {
                   2119:                     $forumtext = $text;
                   2120:                 }
                   2121:               }, "dtext"],
                   2122:             end_h =>
                   2123:             [sub {
                   2124:                   my ($tagname) = @_;
                   2125:                   pop @state;
                   2126:                }, "tagname"],
                   2127:         );
                   2128:         $p->parse_file($forumfile);
                   2129:         $p->eof;
                   2130: 
                   2131:         my %boardinfo = (
                   2132:                   'aaa_title' => $$items{$$resources{$$boards[$i]}{revitm}}{title},
                   2133:                   'bbb_content' => $forumtext,
                   2134:                   'ccc_webreferences' => '',
                   2135:                   'uploaded.lastmodified' => time,
                   2136:                   );
                   2137:         my $msgcount = 0; 
                   2138:                                                                                                      
                   2139:         my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
                   2140: #        print STDERR "putresult is $putresult for $boardname $cdom $crs\n";
                   2141:         if ($db_handling eq 'importall') {
                   2142:             foreach my $msg_id (@{$$messages{$$boards[$i]}}) {
                   2143:                 $msgcount ++;
                   2144:                 $msgidx{$msg_id} = $msgcount;
                   2145:                 my %contrib = (
                   2146:                             'sendername' => 'NoName',
                   2147:                             'senderdomain' => $cdom,
                   2148:                             'screenname' => '',
                   2149:                             'message' => $$items{$$resources{$msg_id}{revitm}}{title}
                   2150:                             );
                   2151:                 unless ( $$items{$$resources{$msg_id}{revitm}}{parentseq} eq $$resources{$$boards[$i]}{revitm} ) {
                   2152:                     unless ( $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}} eq ''){
                   2153:                         $contrib{replyto} = $msgidx{$$items{$$items{$$resources{$msg_id}{revitm}}{parentseq}}{resnum}};
1.1       raeburn  2154:                     }
1.2       raeburn  2155:                 }
                   2156:                 if ( @{$$hrefs{$msg_id}} > 1 )  {
                   2157:                     my $newurl = '';
                   2158:                     foreach my $file (@{$$hrefs{$msg_id}}) {
                   2159:                         unless ($file eq 'pg'.$msg_id.'.htm') {
                   2160:                             $newurl = $msg_id.$file;
                   2161:                              unless ($longcrs eq '') {
                   2162:                                 if ($context eq 'CSTR') {
                   2163:                                     if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles") {
                   2164:                                         mkdir("/home/httpd/lonUsers/$cdom/$longcrs/userfiles",0755);
                   2165:                                     }
                   2166:                                     if (!-e "/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl") {
                   2167:                                         rename("$destdir/resfiles/$msg_id/$file","/home/httpd/lonUsers/$cdom/$longcrs/userfiles/$newurl");
                   2168:                                     }
                   2169:                                 }
                   2170:                                 $contrib{attachmenturl} = '/uploaded/'.$cdom.'/'.$crs.'/'.$file;
                   2171:                             }
1.1       raeburn  2172:                         }
                   2173:                     }
                   2174:                 }
1.2       raeburn  2175:                 my $xmlfile = $tempdir.'/_assoc/'.$msg_id.'/'.$$resources{$msg_id}{file};
                   2176:                 &angel_message($msg_id,\%contrib,$xmlfile);
                   2177:                 unless ($$resources{$msg_id}{file} eq '') {
                   2178:                     unlink($xmlfile);
                   2179:                 }
                   2180:                 my $symb = 'bulletin___'.$$timestamp[$i].'___adm/wrapper/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$i].'/bulletinboard';
                   2181:                 my $postresult = &addposting($symb,\%contrib,$cdom,$crs);
                   2182:             }
                   2183:         }
                   2184:     }
                   2185: }
                   2186: 
                   2187: # ---------------------------------------------------------------- Process ANGEL message board messages
                   2188: sub angel_message {
                   2189:     my ($msg_id,$contrib,$xmlfile) = @_;
                   2190:     my @state = ();
                   2191:     my $p = HTML::Parser->new
                   2192:     (
                   2193:        xml_mode => 1,
                   2194:        start_h =>
                   2195:        [sub {
                   2196:              my ($tagname, $attr) = @_;
                   2197:              push @state, $tagname;
                   2198:              },  "tagname, attr"],
                   2199:         text_h =>
                   2200:         [sub {
                   2201:              my ($text) = @_;
                   2202:              if ("@state" eq "html body table tr td div small span") {
                   2203:                   $$contrib{'plainname'} = $text;
                   2204:              } elsif ("@state" eq "html body div div") {
                   2205:                   $$contrib{'message'} .= '<br /><br />'.$text;
                   2206:              }
                   2207:            }, "dtext"],
                   2208:          end_h =>
                   2209:          [sub {
                   2210:                my ($tagname) = @_;
                   2211:                pop @state;
                   2212:             }, "tagname"],
                   2213:     );
                   2214:     $p->parse_file($xmlfile);
                   2215:     $p->eof;
                   2216: }
                   2217: 
                   2218: # ---------------------------------------------------------------- ANGEL content
                   2219: sub angel_content {
                   2220:     my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
                   2221:     my $xmlfile = $docroot.'/_assoc/'.$res.'/pg'.$res.'.htm';
                   2222:     my $filecount = 0;
                   2223:     my $firstline;
                   2224:     my $lastline;
                   2225:     my @buffer = ();
                   2226:     my @state;
                   2227:     @{$$settings{links}} = ();
                   2228:     my $p = HTML::Parser->new
                   2229:     (
                   2230:        xml_mode => 1,
                   2231:        start_h =>
                   2232:        [sub {
                   2233:              my ($tagname, $attr) = @_;
                   2234:              push @state, $tagname;
                   2235:             },  "tagname, attr"],
                   2236:        text_h =>
                   2237:        [sub {
                   2238:              my ($text) = @_;
                   2239:              if ("@state" eq "html body table tr td div small span") {
                   2240:                  $$settings{'subtitle'} = $text;
                   2241:              } elsif ("@state" eq "html body div div") {
                   2242:                  $$settings{'text'} = $text;
                   2243:              } elsif ("@state" eq "html body div div a") {
                   2244:                 push @{$$settings{'links'}}, $text;
                   2245:              }
                   2246:             }, "dtext"],
                   2247:        end_h =>
                   2248:        [sub {
                   2249:              my ($tagname) = @_;
                   2250:              pop @state;
                   2251:             }, "tagname"],
                   2252:     );
                   2253:     $p->parse_file($xmlfile);
                   2254:     $p->eof;
                   2255:     if ($type eq "PAGE") {
                   2256:         open(FILE,"<$xmlfile");
                   2257:         @buffer = <FILE>;
                   2258:         close(FILE);
                   2259:         chomp(@buffer);
                   2260:         $firstline = -1;
                   2261:         $lastline = 0;
                   2262:         for (my $i=0; $i<@buffer; $i++) {
                   2263:             if (($firstline == -1) && ($buffer[$i] =~ m/<div\sclass="normalDiv"><div\sclass="normalSpan">/)) {
                   2264:                 $firstline = $i;
                   2265:                 $buffer[$i] = substr($buffer[$i],index($buffer[$i],'"normalSpan"')+13);
                   2266:             }
                   2267:             if (($firstline > -1) && ($buffer[$i] =~ m-<p></p></div></div>-)) {
                   2268:                 $buffer[$i] = substr($buffer[$i],0,index($buffer[$i],'<p></p></div></div>'));
                   2269:                 $lastline = $i;
1.1       raeburn  2270:             }
                   2271:         }
                   2272:     }
1.2       raeburn  2273:     open(FILE,">$destdir/resfiles/$res.html");
                   2274:     push @{$resrcfiles}, "$res.html";
                   2275:     print FILE qq|<html>
                   2276: <head>
                   2277: <title>$title</title>
                   2278: </head>
                   2279: <body bgcolor='#ffffff'>
                   2280:     |;
                   2281:     unless ($title eq '') {
                   2282:         print FILE qq|<b>$title</b><br/>\n|;
                   2283:     }
                   2284:     unless ($$settings{subtitle} eq '') {
                   2285:         print FILE qq|$$settings{subtitle}<br/>\n|;
                   2286:     }
                   2287:     print FILE "<br/>\n";
                   2288:     if ($type eq "LINK") {
                   2289:         foreach my $link (@{$$settings{links}}) {
                   2290:             print FILE qq|<a href="$link">$link</a><br/>\n|; 
                   2291:         }
                   2292:     } elsif ($type eq "PAGE") {
                   2293:         if ($firstline > -1) {
                   2294:             for (my $i=$firstline; $i<=$lastline; $i++) {
                   2295:                 print FILE "$buffer[$i]\n";
                   2296:             }
                   2297:         }
                   2298:     }
                   2299:     print FILE qq|
                   2300:   </body>
                   2301:  </html>|;
                   2302:     close(FILE);
1.1       raeburn  2303: }
                   2304: 
                   2305: 1;
                   2306: __END__

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