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

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

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