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

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

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