[BACK]Return to imsprocessor.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / imspackages

Diff for /loncom/imspackages/imsprocessor.pm between versions 1.4 and 1.38

version 1.4, 2004/03/16 23:35:33 version 1.38, 2006/04/05 19:45:53
Line 1 Line 1
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   
 package Apache::imsprocessor;  package Apache::imsprocessor;
   
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncleanup;
   use LWP::UserAgent;
   use HTTP::Request::Common;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use strict;  use strict;
   
 sub ims_config {  sub ims_config {
     my ($areas,$cmsmap,$areaname) = @_;      my ($areas,$cmsmap,$areaname) = @_;
     @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users");      @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users","question");
     %{$$cmsmap{bb5}} = (      %{$$cmsmap{bb5}} = (
                 announce => 'resource/x-bb-announcement',                  announce => 'resource/x-bb-announcement',
                 board => 'resource/x-bb-discussionboard',                  board => 'resource/x-bb-discussionboard',
Line 18  sub ims_config { Line 44  sub ims_config {
                 survey => 'assessment/x-bb-survey',                  survey => 'assessment/x-bb-survey',
                 users => 'course/x-bb-user',                  users => 'course/x-bb-user',
                 );                  );
        %{$$cmsmap{bb6}} = (
                   announce => 'resource/x-bb-announcement',
                   board => 'resource/x-bb-discussionboard',
                   doc => 'resource/x-bb-document',
                   extlink => 'resource/x-bb-externallink',
                   pool => 'assessment/x-bb-qti-pool',
                   quiz => 'assessment/x-bb-qti-test',
                   staff => 'resource/x-bb-staffinfo',
                   survey => 'assessment/x-bb-survey',
                   users => 'course/x-bb-user',
                   );
       $$cmsmap{bb6}{conference} = 'resource/x-bb-conference';
     %{$$cmsmap{angel}} =  (      %{$$cmsmap{angel}} =  (
                 board => 'BOARD',                  board => 'BOARD',
                 extlink => 'LINK',                  extlink => 'LINK',
Line 26  sub ims_config { Line 63  sub ims_config {
                 quiz => 'QUIZ',                  quiz => 'QUIZ',
                 survey => 'FORM',                  survey => 'FORM',
                 );                  );
   
     @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');      @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
       %{$$cmsmap{webctce4}} = (
                   quiz => 'webctquiz',
                   survey => 'webctsurvey',
                   doc => 'webcontent'
                   );
       %{$$cmsmap{webctvista4}} = (
                   question => 'webct.question',
                   quiz => 'webct.assessment',
                   survey => 'webctsurvey',
                   doc => 'webcontent'
                   );
     %{$areaname} = (      %{$areaname} = (
                 announce => 'Announcements',                  announce => 'Announcements',
                 board => 'Discussion Boards',                  board => 'Discussion Boards',
Line 37  sub ims_config { Line 82  sub ims_config {
                 extlink => 'Links to external sites',                  extlink => 'Links to external sites',
                 pool => 'Question pools',                  pool => 'Question pools',
                 quiz => 'Quizzes',                  quiz => 'Quizzes',
                   question => 'Assessment Questions',
                 staff => 'Staff information',                  staff => 'Staff information',
                 survey => 'Surveys',                  survey => 'Surveys',
                 users => 'Enrollment',                  users => 'Enrollment',
                 );                  );
            
 }  }
     
 sub create_tempdir {  sub create_tempdir {
Line 70  sub uploadzip { Line 115  sub uploadzip {
     my ($context,$tempdir,$source) = @_;      my ($context,$tempdir,$source) = @_;
     my $fname;      my $fname;
     if ($context eq 'DOCS') {      if ($context eq 'DOCS') {
         $fname=$ENV{'form.uploadname.filename'};          $fname=$env{'form.uploadname.filename'};
 # Replace Windows backslashes by forward slashes  # Replace Windows backslashes by forward slashes
         $fname=~s/\\/\//g;          $fname=~s/\\/\//g;
 # Get rid of everything but the actual filename  # Get rid of everything but the actual filename
Line 82  sub uploadzip { Line 127  sub uploadzip {
 # See if there is anything left  # See if there is anything left
         unless ($fname) { return 'error: no uploaded file'; }          unless ($fname) { return 'error: no uploaded file'; }
 # Save the file  # Save the file
         chomp($ENV{'form.uploadname'});          chomp($env{'form.uploadname'});
         open(my $fh,'>'.$tempdir.'/'.$fname);          open(my $fh,'>'.$tempdir.'/'.$fname);
         print $fh $ENV{'form.uploadname'};          print $fh $env{'form.uploadname'};
         close($fh);          close($fh);
     } elsif ($context eq 'CSTR') {      } elsif ($context eq 'CSTR') {
         if ($source =~ m/\/([^\/]+)$/) {          if ($source =~ m/\/([^\/]+)$/) {
Line 99  sub uploadzip { Line 144  sub uploadzip {
 sub expand_zip {  sub expand_zip {
     my ($tempdir,$filename) = @_;      my ($tempdir,$filename) = @_;
     my $zipfile = "$tempdir/$filename";      my $zipfile = "$tempdir/$filename";
       if (!-e "$zipfile") {
           return 'no zip';
       }
     if ($filename =~ m|\.zip$|i) {      if ($filename =~ m|\.zip$|i) {
         open(OUTPUT, "unzip -o $zipfile -d $tempdir  2> /dev/null |");          open(OUTPUT, "unzip -o $zipfile -d $tempdir  2> /dev/null |");
         while (<OUTPUT>) {  
             print "$_<br />";  
         }  
         close(OUTPUT);          close(OUTPUT);
     } else {      } else {
         return 'nozip';          return 'nozip';
Line 115  sub expand_zip { Line 160  sub expand_zip {
 }  }
   
 sub process_manifest {  sub process_manifest {
     my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo) = @_;      my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo,$phase,$includedres,$includeditems) = @_;
     my %toc = (      my %toc = (
                 bb6 => 'organization',
               bb5 => 'tableofcontents',                bb5 => 'tableofcontents',
               angel => 'organization',                angel => 'organization',
                 webctce4 => 'organization',
                 webctvista4 => 'organization'
               );                );
     my %contents = ();  
     my @state = ();  
     my $itm = '';  
     my $identifier = '';  
     my @seq = "Top";      my @seq = "Top";
     my $lastitem;  
     %{$$items{'Top'}} = (      %{$$items{'Top'}} = (
                       contentscount => 0,                        contentscount => 0,
                       resnum => 'toplevel',                        resnum => 'toplevel',
Line 136  sub process_manifest { Line 179  sub process_manifest {
     
     if ($cms eq 'angel') {      if ($cms eq 'angel') {
         $$resources{'toplevel'}{type} = "FOLDER";          $$resources{'toplevel'}{type} = "FOLDER";
     } elsif ($cms eq 'bb5') {      } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
         $$resources{'toplevel'}{type} = 'resource/x-bb-document';          $$resources{'toplevel'}{type} = 'resource/x-bb-document';
       } else {
           $$resources{'toplevel'}{type} = 'webcontent';
     }      }
   
   
     unless (-e "$tempdir/imsmanifest.xml") {      unless (-e "$tempdir/imsmanifest.xml") {
         return 'nomanifest';          return 'nomanifest';
     }       }
   
     my $xmlfile = $tempdir.'/imsmanifest.xml';      my $xmlfile = $tempdir.'/imsmanifest.xml';
       &parse_manifest($cms,$phase,$tempdir,$xmlfile,\%toc,$includedres,
                       $includeditems,$items,$resources,$resinfo,$hrefs,\@seq);
       return 'ok' ;
   }
   
   sub parse_manifest {
       my ($cms,$phase,$tempdir,$xmlfile,$toc,$includedres,$includeditems,$items,
           $resources,$resinfo,$hrefs,$seq) = @_;
       my @state = ();
       my $itm = '';
       my %contents = ();
       my $identifier = '';
       my @allidentifiers = ();
       my $lastitem;
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
     (      (
        xml_mode => 1,         xml_mode => 1,
Line 153  sub process_manifest { Line 211  sub process_manifest {
            [sub {             [sub {
                 my ($tagname, $attr) = @_;                  my ($tagname, $attr) = @_;
                 push @state, $tagname;                  push @state, $tagname;
                 my $num = @state - 3;                  my $start = @state - 3;
                 my $start = $num;                  if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $$toc{$cms}) ) {
                 my $statestr = '';                      if ($state[-1] eq 'item') {
                 foreach (@state) {                          $itm = $attr->{identifier};
                     $statestr .= "$_ ";                          if ($$includeditems{$itm} || $phase ne 'build') {
                 }                              %{$$items{$itm}} = ();
                 if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {                              $$items{$itm}{contentscount} = 0;
                     my $searchstr = "manifest organizations $toc{$cms}";                              @{$$items{$itm}{contents}} = ();
                     while ($num > 0) {                              if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webctce4' || $cms eq 'webctvista4') {
                         $searchstr .= " item";                                  $$items{$itm}{resnum} = $attr->{identifierref};
                         $num --;                                   if ($cms eq 'bb5') {
                     }                                      $$items{$itm}{title} = $attr->{title};
                     if (("@state" eq $searchstr) && (@state > 3)) {                                  }
                         $itm = $attr->{identifier};                                            } elsif ($cms eq 'angel') {
                         %{$$items{$itm}} = ();                                  if ($attr->{identifierref} =~ m/^res(.+)$/) {
                         $$items{$itm}{contentscount} = 0;                                      $$items{$itm}{resnum} = $1;
                         if ($cms eq 'bb5') {                                  }
                             $$items{$itm}{resnum} = $attr->{identifierref};  
                             $$items{$itm}{title} = $attr->{title};  
                         } elsif ($cms eq 'angel') {  
                             if ($attr->{identifierref} =~ m/^res(.+)$/) {  
                                 $$items{$itm}{resnum} = $1;  
                             }                              }
                         }                              unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
                         unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {                                  %{$$resources{$$items{$itm}{resnum}}} = ();
                             %{$$resources{$$items{$itm}{resnum}}} = ();                              }
                         }                              $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
                         $$resources{$$items{$itm}{resnum}}{revitm} = $itm;                              if ($start > @{$seq}) {
                                   unless ($lastitem eq '') {
                         if ($start > @seq) {                                      push @{$seq}, $lastitem;
                             unless ($lastitem eq '') {                                      unless ( defined($contents{$$seq[-1]}) ) {
                                 push @seq, $lastitem;                                          @{$contents{$$seq[-1]}} = ();
                                 unless ( defined($contents{$seq[-1]}) ) {                                      }
                                     @{$contents{$seq[-1]}} = ();                                      push @{$contents{$$seq[-1]}},$itm;
                                       $$items{$itm}{parentseq} = $$seq[-1];
                                   }
                               } elsif ($start < @{$seq}) {
                                   my $diff = @{$seq} - $start;
                                   while ($diff > 0) {
                                       pop @{$seq};
                                       $diff --;
                                   }
                                   if (@{$seq}) {
                                       push @{$contents{$$seq[-1]}}, $itm;
                                 }                                  }
                                 push @{$contents{$seq[-1]}},$itm;                              } else {
                                 $$items{$itm}{parentseq} = $seq[-1];                                  push @{$contents{$$seq[-1]}}, $itm;
                             }                              }
                         }                              my $path;
                         elsif ($start < @seq) {                              if (@{$seq} > 1) {
                             my $diff = @seq - $start;                                  $path = join(',',@{$seq});
                             while ($diff > 0) {                              } elsif (@{$seq} > 0) {
                                 pop @seq;                                  $path = $$seq[0];
                                 $diff --;  
                             }                              }
                             if (@seq) {                              $$items{$itm}{filepath} = $path;
                                 push @{$contents{$seq[-1]}}, $itm;                              if ($cms eq 'bb5' || $cms eq 'bb6') {
                                   if ($$items{$itm}{filepath} eq 'Top') {
                                       $$items{$itm}{resnum} = $itm;
                                       $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
                                       $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
                                       $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
                                   }
                             }                              }
                         } else {                              $$items{$$seq[-1]}{contentscount} ++;
                             push @{$contents{$seq[-1]}}, $itm;                              $$resources{$$items{$itm}{resnum}}{seqref} = $seq;
                               $lastitem = $itm;
                         }                          }
                         my $path;                      }
                         if (@seq > 1) {                      if ($cms eq 'webctce4') {
                             $path = join(',',@seq);                          if (($state[-1] eq "webct:properties") && (@state > 4)) {
                         } elsif (@seq > 0) {                              $$items{$itm}{properties} = $attr->{identifierref};
                             $path = $seq[0];  
                         }  
                         $$items{$itm}{filepath} = $path;  
                         if ($cms eq 'bb5') {  
                             if ($$items{$itm}{filepath} eq 'Top') {  
                                 $$items{$itm}{resnum} = $itm;  
                                 $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';  
                                 $$resources{$$items{$itm}{resnum}}{revitm} = $itm;  
                                 $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';  
                             }  
                         }                          }
                         $$items{$seq[-1]}{contentscount} ++;  
                         $lastitem = $itm;  
                     }                      }
                 } elsif ("@state" eq "manifest resources resource" ) {                  } elsif ("@state" eq "manifest resources resource" ) {
                     $identifier = $attr->{identifier};                      $identifier = $attr->{identifier};
                     if ($cms eq 'bb5') {                                       push(@allidentifiers,$identifier);
                         $$resources{$identifier}{file} = $attr->{file};                      if ($$includedres{$identifier} || $phase ne 'build') { 
                         $$resources{$identifier}{type} = $attr->{type};                          if ($cms eq 'bb5' || $cms eq 'bb6') {
                     } elsif ($cms eq 'angel') {                              $$resources{$identifier}{file} = $attr->{file};
                         $identifier = substr($identifier,3);                              $$resources{$identifier}{type} = $attr->{type};
                         if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {                          } elsif ($cms eq 'webctce4') {
                             $$resources{$identifier}{file} = $1;                              $$resources{$identifier}{type} = $attr->{type};
                         }                                                  $$resources{$identifier}{file} = $attr->{href};
                           } elsif ($cms eq 'webctvista4') {
                               $$resources{$identifier}{type} = $attr->{type};
                               $$resources{$identifier}{'webct:coType'} = $attr->{'webct:coType'};
                           } elsif ($cms eq 'angel') {
                               $identifier = substr($identifier,3);
                               if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
                                   $$resources{$identifier}{file} = $1;
                               }
                           }
                           @{$$hrefs{$identifier}} = ();
                     }                      }
                     @{$$hrefs{$identifier}} = ();  
                 } elsif ("@state" eq "manifest resources resource file") {                  } elsif ("@state" eq "manifest resources resource file") {
                     if ($cms eq 'bb5') {                      if ($$includedres{$identifier} || $phase ne 'build') {
                         push @{$$hrefs{$identifier}},$attr->{href};                          if ($cms eq 'webctvista4') {
                     } elsif ($cms eq 'angel') {                              $$resources{$identifier}{file} = $attr->{href};
                         if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {                          }
                             push @{$$hrefs{$identifier}},$1;                          if ($cms eq 'bb5' || $cms eq 'bb6' || 
                         } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {                              $cms eq 'webctce4' || $cms eq 'webctvista4') {
                             $$resources{$identifier}{type} = $1;                              push @{$$hrefs{$identifier}},$attr->{href};
   
                               if ($$resources{$identifier}{type} eq 
                                   'webct.manifest') {
                                   my $manifestfile = $tempdir.'/'.$attr->{href};
                                   my $currseqref = [];
                                   if ($itm) {
                                       $currseqref =   
                                       $$resources{$$items{$itm}{resnum}}{seqref};
                                   }
                                   &parse_manifest($cms,$phase,$tempdir,$manifestfile,
                                                   $toc,$includedres,$includeditems,
                                                   $items,$resources,$resinfo,
                                                   $hrefs,$currseqref);
                               }
                           } elsif ($cms eq 'angel') {
                               if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
                                   push @{$$hrefs{$identifier}},$1;
                               } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
                                   $$resources{$identifier}{type} = $1;
                               }
                         }                           } 
                     }                      }
                   } elsif ("@state" eq "manifest webct:ContentObject") {
                       foreach my $ident (@allidentifiers) {
                           if ($$resources{$ident}{type} eq 'ims_qtiasiv1p2') {
                               $$resources{$ident}{type} = $attr->{'webct:coType'};
                           }
                       }
                 }                  }
            }, "tagname, attr"],             }, "tagname, attr"],
         text_h =>          text_h =>
             [sub {              [sub {
                 my ($text) = @_;                  my ($text) = @_;
                 if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq "organization" && $state[-1] eq "title") {                  if ("@state" eq "manifest metadata lom general title langstring") {
                     if ($cms eq 'angel') {                      $$items{'Top'}{title} = $text;
                         $$items{$itm}{title} = $text;                  }
                   if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $$toc{$cms} && $state[-1] eq "title") {
                       if ($$includeditems{$itm} || $phase ne 'build') {
                           if ($cms eq 'angel' || $cms eq 'bb6' || $cms eq 'webctvista4') {
                               $$items{$itm}{title} = $text;
                           }
                           if ($cms eq 'webctce4') {
                               $$items{$itm}{title} = $text;
                               $$items{$itm}{title} =~ s/(<[^>]*>)//g;
                           }
                     }                      }
                 }                  }
               }, "dtext"],                }, "dtext"],
Line 263  sub process_manifest { Line 364  sub process_manifest {
     );      );
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
   
     foreach my $itm (keys %contents) {      foreach my $itm (keys %contents) {
         @{$$items{$itm}{contents}} = @{$contents{$itm}};          @{$$items{$itm}{contents}} = @{$contents{$itm}};
     }      }
     return 'ok' ;  }
   
   sub get_imports {
       my ($includeditems,$items,$resources,$importareas,$itm) = @_;
       if (exists($$items{$itm}{resnum})) {
           if ($$importareas{$$resources{$$items{$itm}{resnum}}{type}}) {
               unless (exists($$includeditems{$itm})) {
                   $$includeditems{$itm} = 1;
               }
           }
       }
       if ($$items{$itm}{contentscount} > 0) {
           foreach my $child (@{$$items{$itm}{contents}}) {
               &get_imports($includeditems,$items,$resources,$importareas,$child);
           }
       }
   }
   
   sub get_parents {
       my ($includeditems,$items,$itm) = @_;
       my @pathitems = ();
       if ($$items{$itm}{filepath} =~ m/,/) {
          @pathitems = split/,/,$$items{$itm}{filepath};
       } else {
          $pathitems[0] = $$items{$itm}{filepath};
       }
       foreach (@pathitems) {
           $$includeditems{$_} = 1;
       }
 }  }
   
 sub target_resources {  sub target_resources {
Line 281  sub target_resources { Line 409  sub target_resources {
 }  }
   
 sub copy_resources {  sub copy_resources {
     my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$chome,$destdir,$timenow) = @_;      my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles) = @_;
     if ($context eq 'DOCS') {      if ($context eq 'DOCS') {
         foreach my $key (sort keys %{$hrefs}) {          foreach my $key (sort keys %{$hrefs}) {
             if (grep/^$key$/,@{$targets}) {              if (grep/^$key$/,@{$targets}) {
                 %{$$url{$key}} = ();                  %{$$url{$key}} = ();
                 foreach my $file (@{$$hrefs{$key}}) {                  foreach my $file (@{$$hrefs{$key}}) {
                     my $source = $tempdir.'/'.$key.'/'.$file;                      my $source = $tempdir.'/'.$key.'/'.$file;
                       if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
                           $source = $tempdir.'/'.$file;
                       }
                     my $filename = '';                      my $filename = '';
                     my $fpath = $timenow.'/resfiles/'.$key.'/';                      my $fpath = $timenow.'/resfiles/'.$key.'/';
                     if ($cms eq 'angel') {                      if ($cms eq 'angel') {
Line 296  sub copy_resources { Line 427  sub copy_resources {
                         }                          }
                     }                      }
                     $file =~ s-\\-/-g;                      $file =~ s-\\-/-g;
                     $file = $fpath.$file;                      my $copyfile = $file;
                     my $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$file,$source);                      if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
                           if ($file =~ m-/my_files/(.+)$-) {
                               $copyfile = $1;
                           }
                       }
                       unless ((($cms eq 'webctce4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) || (($cms eq 'webctvista4') && (grep/^$key$/,@{$assessmentfiles}) && $file =~ /\.xml$/))    {
                           $copyfile = $fpath.$copyfile;
                           my $fileresult;
                           if (-e $source) {
                               $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$copyfile,$source);
                           }
                       }
                 }                  }
             }              }
         }          }
Line 306  sub copy_resources { Line 448  sub copy_resources {
             mkdir("$destdir/resfiles",0770);              mkdir("$destdir/resfiles",0770);
         }          }
         foreach my $key (sort keys %{$hrefs}) {          foreach my $key (sort keys %{$hrefs}) {
             foreach my $file (@{$$hrefs{$key}}) {              if (grep/^$key$/,@{$targets}) {
                 $file =~ s-\\-/-g;                  foreach my $file (@{$$hrefs{$key}}) {
                 if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') ) {                      $file =~ s-\\-/-g;
                     if (!-e "$destdir/resfiles/$key") {                      if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6')) {
                         mkdir("$destdir/resfiles/$key",0770);                          if (!-e "$destdir/resfiles/$key") {
                     }                              mkdir("$destdir/resfiles/$key",0770);
                           }
                     my $filepath = $file;                          my $filepath = $file;
                     my $front = '';                          my $front = '';
                     while ($filepath =~ m-(\w+)/(.+)-) {                          while ($filepath =~ m-(\w+)/(.+)-) {
                         $front .= $1.'/';                              $front .= $1.'/';
                         $filepath = $2;                              $filepath = $2;
                         my $fulldir = "$destdir/resfiles/$key/$front";                              my $fulldir = "$destdir/resfiles/$key/$front";
                         chop($fulldir);                              chop($fulldir);
                         if (!-e "$fulldir") {                              if (!-e "$fulldir") {
                             mkdir("$fulldir",0770);                                  mkdir("$fulldir",0770);
                               }
                           }
                           if ($cms eq 'angel') {
                               rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
                           } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
                               rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
                           }
                       } elsif ($cms eq 'webctce4') {
                           if ($file =~ m-/my_files/(.+)$-) {
                               my $copyfile = $1;
                               if ($copyfile =~ m-^[^/]+/[^/]+-) {
                                   my @dirs = split/\//,$copyfile;
                                   my $path = "$destdir/resfiles";
                                   while (@dirs > 1) {
                                       $path .= '/'.$dirs[0];
                                       if (!-e "$path") {
                                           mkdir("$path",0755);
                                       }
                                       shift @dirs;
                                   }
                               }
                               if (-e "$tempdir/$file") {
                                   rename("$tempdir/$file","$destdir/resfiles/$copyfile");
                               }
                           } elsif ($file !~ m-/data/(.+)$-) {
                               &Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
                         }                          }
                     }  
                     if ($cms eq 'angel') {  
                         rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");  
                     } elsif ($cms eq 'bb5') {  
                         rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");  
                     }                      }
                 }                  }
             }              }
Line 335  sub copy_resources { Line 498  sub copy_resources {
     }      }
 }  }
   
 sub process_coursefile {  
     my ($crs,$cdom,$chome,$file,$source)=@_;  
     my $fetchresult = '';  
     my $fpath = '';  
     my $fname = $file;  
     ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/])$/);  
     $fpath=$cdom.'/'.$crs.'/'.$fpath;  
     my $filepath=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';  
     unless ($fpath eq '') {  
         my @parts=split(/\//,$fpath);  
         foreach my $part (@parts) {  
             $filepath.= '/'.$part;  
             if ((-e $filepath)!=1) {  
                 mkdir($filepath,0777);  
             }  
         }  
     }  
     if ($source eq '') {  
         $fetchresult eq 'no source file provided';  
     } else {  
         my $destination = $filepath.'/'.$fname;  
         rename($source,$destination);  
         $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome);  
         unless ($fetchresult eq 'ok') {  
             &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$fname.' to host '.$chome.': '.$fetchresult);  
         }  
     }  
     return $fetchresult;  
 }  
   
 sub process_resinfo {  sub process_resinfo {
     my ($cms,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles) = @_;      my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles,$randompicks) = @_;
     my $board_id = time;      my $board_id = time;
     my $board_count = 0;      my $board_count = 0;
       my $dbparse = 0;
     my $announce_handling = 'include';      my $announce_handling = 'include';
     my $longcrs = '';      my $longcrs = '';
       my %allassessments = ();
       my %allquestions = ();
       my %qzdbsettings = ();
       my %catinfo = ();
     if ($crs =~ m/^(\d)(\d)(\d)/) {      if ($crs =~ m/^(\d)(\d)(\d)/) {
         $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;          $longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
     }      }
       if ($context eq 'CSTR') {
           if (!-e "$destdir/resfiles") {
               mkdir("$destdir/resfiles",0770);
           }
       }
     if ($cms eq 'angel') {      if ($cms eq 'angel') {
         my $currboard = '';          my $currboard = '';
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort keys %{$resources}) {
             if (grep/^$key$/,@{$targets}) {
             if ($$resources{$key}{type} eq "BOARD") {              if ($$resources{$key}{type} eq "BOARD") {
                 push @{$boards}, $key;                  push @{$boards}, $key;
                 $$boardnum{$$resources{$key}{revitm}} = $board_count;                  $$boardnum{$$resources{$key}{revitm}} = $board_count;
Line 401  sub process_resinfo { Line 545  sub process_resinfo {
             } elsif ($$resources{$key}{type} eq "DROPBOX") {              } elsif ($$resources{$key}{type} eq "DROPBOX") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
             }              }
             }
         }          }
     } elsif ($cms eq 'bb5') {      } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort keys %{$resources}) {
             if (grep/^$key$/,@{$targets}) {
             if ($$resources{$key}{type} eq "resource/x-bb-document") {              if ($$resources{$key}{type} eq "resource/x-bb-document") {
                 unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {                  unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
                     %{$$resinfo{$key}} = ();                      %{$$resinfo{$key}} = ();
                     &process_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles);                      &process_content($cms,$key,$context,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles,$packages,$hrefs);
                 }                  }
             } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {              } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_staff($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);                  &process_staff($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
             } elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") {              } elsif ($$resources{$key}{type} eq "resource/x-bb-externallink") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_link($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);                  &process_link($key,$docroot,$destdir,\%{$$resinfo{$key}},$resrcfiles);
             } elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") {              } elsif ($$resources{$key}{type} eq "resource/x-bb-discussionboard") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 unless ($db_handling eq 'ignore') {                  unless ($db_handling eq 'ignore') {
Line 424  sub process_resinfo { Line 570  sub process_resinfo {
                     $board_id ++;                      $board_id ++;
                     $board_count ++;                      $board_count ++;
                 }                  }
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {              } elsif ($$resources{$key}{type} =~/assessment\/x\-bb\-(qti\-)?pool/) {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);                  &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {                  push @{$pools}, $key;
               } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?quiz/) {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);                  &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                 push @{$quizzes}, $key;                  push @{$quizzes}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {              } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?survey/) {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname);                  &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                 push @{$surveys}, $key;                  push @{$surveys}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {              } elsif ($$resources{$key}{type} eq "assessment/x-bb-group") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
Line 451  sub process_resinfo { Line 598  sub process_resinfo {
                     &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);                      &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
                 }                  }
             }              }
             }
         }          }
         if (@{$announcements}) {          if (@{$announcements}) {
             $$items{'Top'}{'contentscount'} ++;              $$items{'Top'}{'contentscount'} ++;
Line 463  sub process_resinfo { Line 611  sub process_resinfo {
         }          }
         if (@{$surveys}) {          if (@{$surveys}) {
             $$items{'Top'}{'contentscount'} ++;              $$items{'Top'}{'contentscount'} ++;
                   }
           if (@{$pools}) {
               $$items{'Top'}{'contentscount'} ++;
           }
       } elsif ($cms eq 'webctce4') {
           foreach my $key (sort keys %{$resources}) {
               if (grep/^$key$/,@{$targets}) {
                   if ($$resources{$key}{type} eq "webcontent") {
                       %{$$resinfo{$key}} = ();
                       &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
                   } elsif ($$resources{$key}{type} eq "webctquiz") {
                       &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                   }
               }
           }
       } elsif ($cms eq 'webctvista4') {
           foreach my $key (sort keys %{$resources}) {
               if (grep/^$key$/,@{$targets}) {
                   %{$$resinfo{$key}} = ();
                   if ($$resources{$key}{type} eq 'webct.question') {
                       $allquestions{$key} = 1;
                   } elsif ($$resources{$key}{type} eq 'webct.assessment') {
                       $allassessments{$key} = 1;
                   }
               }
           }
           if (keys(%allassessments) > 0) {
               foreach my $key (sort(keys(%allassessments))) {
                   &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
               }
           } elsif (keys(%allquestions) > 0) {
               my %catinfo = ();
               my @allids = ();
               my @allquestids = ();
               my %allanswers = ();
               my %allchoices = ();
               my $containerdir;
               my $newdir;
               my $cid;
               my $randompickflag = 0;
               if ($context eq 'DOCS') {
                   $cid = $env{'request.course.id'};
               }
               my $destresdir = $destdir;
               if ($context eq 'CSTR') {
                   $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
               } elsif ($context eq 'DOCS') {
                   $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
               }
               foreach my $res (sort(keys(%allquestions))) {
                   my $parent = $allquestions{$res};
                   &parse_webctvista4_question($res,$docroot,$resources,$hrefs,\%qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,\%catinfo);
               }
               &build_category_sequences($destdir,\%catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$crs,\%qzdbsettings);
               &write_webct4_questions($cms,\@allquestids,$context,\%qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$crs,$destdir,\%catinfo);
         }          }
     }      }
   
     $$total{'board'} = $board_count;      $$total{'board'} = $board_count;
     $$total{'quiz'} = @{$quizzes};      $$total{'quiz'} = @{$quizzes};
     $$total{'surv'} = @{$surveys};      $$total{'surv'} = @{$surveys};
       $$total{'pool'} = @{$pools};
 }  }
   
 sub build_structure {  sub build_structure {
     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) = @_;      my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems,$randompicks) = @_;
     my %flag = ();      my %flag = ();
     my %count = ();      my %count = ();
     my %pagecontents = ();      my %pagecontents = ();
     my %seqtext = ();      my %seqtext = ();
     my $topnum = 0;      my $topnum = 0;
       my $topspecials = @$announcements + @$boards + @$quizzes + @$surveys + @$pools;
   
     if (!-e "$destdir") {      if (!-e "$destdir") {
         mkdir("$destdir",0755);          mkdir("$destdir",0755);
Line 510  sub build_structure { Line 714  sub build_structure {
     }      }
   
     foreach my $key (sort keys %{$items}) {      foreach my $key (sort keys %{$items}) {
         if ($$includeditems{$key}) {
         %{$flag{$key}} = (          %{$flag{$key}} = (
                           page => 0,                            page => 0,
                           seq => 0,                            seq => 0,
Line 530  sub build_structure { Line 735  sub build_structure {
         my $curr_id = 1;          my $curr_id = 1;
         my $resnum = $$items{$key}{resnum};          my $resnum = $$items{$key}{resnum};
         my $type = $$resources{$resnum}{type};          my $type = $$resources{$resnum}{type};
         if (($cms eq 'angel' && $type eq "FOLDER") || ($cms eq 'bb5' && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) ) {          my $contentscount = $$items{$key}{'contentscount'}; 
             unless ($cms eq 'bb5' && $key eq 'Top') {          if (($cms eq 'angel' && $type eq "FOLDER") || (($cms eq 'bb5' || $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) || ($cms eq 'webctce4' &&  $contentscount > 0)) {
               unless (($cms eq 'bb5') && $key eq 'Top') {
                 $seqtext{$key} = "<map>\n";                  $seqtext{$key} = "<map>\n";
             }              }
             if ($$items{$key}{contentscount} == 0) {              if ($contentscount == 0) {
                 $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>          if ($key eq 'Top') {
                       unless ($topspecials) {
                           $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
   <link from="$curr_id" to="$next_id" index="$curr_id"></link>
   <resource id="$next_id" src="" type="finish"></resource>\n|;
                       }
                   } else {
                       $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
 <link from="$curr_id" to="$next_id" index="$curr_id"></link>  <link from="$curr_id" to="$next_id" index="$curr_id"></link>
 <resource id="$next_id" src="" type="finish"></resource>\n|;  <resource id="$next_id" src="" type="finish"></resource>\n|;
                   }
             } else {              } else {
                 my $contcount = @{$$items{$key}{contents}};                  my $contcount = 0;
                   if (defined($$items{$key}{contents})) { 
                       $contcount = @{$$items{$key}{contents}};
                   } else {
                       &Apache::lonnet::logthis("IMS Import error for item: $key- contents count = $contentscount, but identity of contents not defined.");
                   }
                 my $contitem = $$items{$key}{contents}[0];                  my $contitem = $$items{$key}{contents}[0];
                 my $res = $$items{$contitem}{resnum};                  my $contitemcount = $$items{$contitem}{contentscount}; 
                 my $type = $$resources{$res}{type};                  my ($res,$itm,$type,$file);
                   if (exists($$items{$contitem}{resnum})) {
                       $res = $$items{$contitem}{resnum};
                       $itm = $$resources{$res}{revitm};
                       $type = $$resources{$res}{type};
                       $file = $$resources{$res}{file};
                   }
                 my $title = $$items{$contitem}{title};                  my $title = $$items{$contitem}{title};
                 $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);                  my $packageflag = 0;
                   if (grep/^$res$/,@{$packages}) {
                       $packageflag = 1;
                   }
                   $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
                 unless ($flag{$key}{page} == 1) {                  unless ($flag{$key}{page} == 1) {
                     $seqtext{$key} .= qq|<resource id="$curr_id" src="$src" title="$title"|;                      if ($$randompicks{$contitem}) {
                     unless ($cms eq 'bb5' && $key eq 'Top' && @{$announcements}) {                          $seqtext{$key} .= qq|
                         $seqtext{$key} .= qq| type="start"|;  <param to="$curr_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n|;
                     }                      }
                       $seqtext{$key} .= qq|<resource id="$curr_id" src="$src" title="$title" type="start"|;
                     unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {                      unless ($flag{$key}{seq} || $flag{$key}{board} || $flag{$key}{file}) {
                         $flag{$key}{page} = 1;                          $flag{$key}{page} = 1;
                     }                      }
Line 560  sub build_structure { Line 790  sub build_structure {
                 }                  }
                 if ($contcount == 1) {                  if ($contcount == 1) {
                     $seqtext{$key} .= qq|></resource>                      $seqtext{$key} .= qq|></resource>
 <link from="$curr_id" to="$next_id" index="$curr_id"></link>  <link from="$curr_id" to="$next_id" index="$curr_id"></link>|;
                       if ($key eq 'Top') {
                           unless ($topspecials) {
                               $seqtext{$key} .= qq|
 <resource id="$next_id" src="" type="finish"></resource>\n|;  <resource id="$next_id" src="" type="finish"></resource>\n|;
                           }
                       } else {
                           $seqtext{$key} .= qq|
   <resource id="$next_id" src="" type="finish"></resource>\n|;
                       }
                 } else {                  } else {
                     if ($contcount > 2 ) {                      if ($contcount > 2 ) {
                         for (my $i=1; $i<$contcount-1; $i++) {                          for (my $i=1; $i<$contcount-1; $i++) {
                             my $contitem = $$items{$key}{contents}[$i];                              my $contitem = $$items{$key}{contents}[$i];
                               my $contitemcount = $$items{$contitem}{contentscount};
                             my $res = $$items{$contitem}{resnum};                              my $res = $$items{$contitem}{resnum};
                             my $type = $$resources{$res}{type};                              my $type = $$resources{$res}{type};
                             my $title = $$items{$contitem}{title};                                my $file = $$resources{$res}{file};
                             $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);                              my $title = $$items{$contitem}{title};
                               my $packageflag = 0;
                               if (grep/^$res$/,@{$packages}) {
                                   $packageflag = 1;
                               }
                               $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
                             unless ($flag{$key}{page} == 1) {                              unless ($flag{$key}{page} == 1) {
                                 $seqtext{$key} .= qq|></resource>                                  $seqtext{$key} .= qq|></resource>
 <link from="$curr_id" to="$next_id" index="$curr_id"></link>  <link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
                                   if ($$randompicks{$contitem}) {
                                       $seqtext{$key} .= qq|
   <param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>|;
                                   }
                                   $seqtext{$key} .= qq|
 <resource id="$next_id" src="$src" title="$title"|;  <resource id="$next_id" src="$src" title="$title"|;
                                 $curr_id ++;                                  $curr_id ++;
                                 $next_id ++;                                  $next_id ++;
Line 587  sub build_structure { Line 836  sub build_structure {
                         }                          }
                     }                      }
                     my $contitem = $$items{$key}{contents}[-1];                      my $contitem = $$items{$key}{contents}[-1];
                       my $contitemcount = $$items{$contitem}{contentscount};
                     my $res = $$items{$contitem}{resnum};                      my $res = $$items{$contitem}{resnum};
                     my $type = $$resources{$res}{type};                      my $type = $$resources{$res}{type};
                       my $file = $$resources{$res}{file};
                     my $title = $$items{$contitem}{title};                      my $title = $$items{$contitem}{title};
                       my $packageflag = 0;
                       if (grep/^$res$/,@{$packages}) {
                           $packageflag = 1;
                       }
                       $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem});
   
                     $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom);  
                     if ($flag{$key}{page}) {                      if ($flag{$key}{page}) {
                         if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {                          if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
                             $seqtext{$key} .= qq|></resource>                              $seqtext{$key} .= qq|></resource>
Line 600  sub build_structure { Line 855  sub build_structure {
                         }                          }
                     } else {                      } else {
                         $seqtext{$key} .= qq|></resource>                          $seqtext{$key} .= qq|></resource>
 <link from="$curr_id" to="$next_id" index="$curr_id"></link>  <link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
                           if ($$randompicks{$contitem}) {
                               $seqtext{$key} .= qq|
   <param to="$next_id" type="int_pos" name="parameter_randompick" value="$$randompicks{$contitem}"></param>\n|;
                           }
                           $seqtext{$key} .= qq|
 <resource id="$next_id" src="$src" title="$title" |;  <resource id="$next_id" src="$src" title="$title" |;
                         if ($key eq 'Top') {                          if ($key eq 'Top') {
                             push @{$topurls}, $src;                              push @{$topurls}, $src;
Line 613  sub build_structure { Line 873  sub build_structure {
                         $curr_id ++;                          $curr_id ++;
                         $next_id ++;                          $next_id ++;
                         $seqtext{$key} .= qq|></resource>                          $seqtext{$key} .= qq|></resource>
 <link from="$curr_id" to="$next_id index="$curr_id"></link>\n|;  <link from="$curr_id" to="$next_id" index="$curr_id"></link>\n|;
                     }                       } 
                 }                  }
             }              }
             unless ($cms eq 'bb5' && $key eq 'Top') {              unless (($cms eq 'bb5') && $key eq 'Top') {
                 $seqtext{$key} .= "</map>\n";                  $seqtext{$key} .= "</map>\n";
                 open(LOCFILE,">$destdir/sequences/$key.sequence");                  open(LOCFILE,">$destdir/sequences/$key.sequence");
                 print LOCFILE $seqtext{$key};                  print LOCFILE $seqtext{$key};
Line 628  sub build_structure { Line 888  sub build_structure {
             $$total{page} += $count{$key}{page};              $$total{page} += $count{$key}{page};
         }          }
         $$total{seq} += $count{$key}{seq};          $$total{seq} += $count{$key}{seq};
         }
     }      }
     $topnum += ($count{'Top'}{page} + $count{'Top'}{seq});      $topnum += ($count{'Top'}{page} + $count{'Top'}{seq});
   
     if ($cms eq 'bb5') {      if ($cms eq 'bb5' || $cms eq 'bb6') {
         if (@{$announcements} > 0) {          if (@{$announcements} > 0) {
             &process_specials($context,'announcements',$announcements,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);              &process_specials($context,'announcements',$announcements,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
         }          }
Line 644  sub build_structure { Line 905  sub build_structure {
         if (@{$surveys} > 0)  {          if (@{$surveys} > 0)  {
             &process_specials($context,'surveys',$surveys,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);              &process_specials($context,'surveys',$surveys,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
         }          }
           if (@{$pools} > 0)  {
               &process_specials($context,'pools',$pools,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
           }
         $seqtext{'Top'} .= "</map>\n";          $seqtext{'Top'} .= "</map>\n";
         open(TOPFILE,">$destdir/sequences/Top.sequence");          open(TOPFILE,">$destdir/sequences/Top.sequence");
         print TOPFILE $seqtext{'Top'};          print TOPFILE $seqtext{'Top'};
Line 654  sub build_structure { Line 917  sub build_structure {
   
     my $filestem;      my $filestem;
     if ($context eq 'DOCS') {      if ($context eq 'DOCS') {
         $filestem = "/uploaded/$cdom/$crs";          $filestem = "/uploaded/$cdom/$crs/$timenow";
     } elsif ($context eq 'CSTR') {      } elsif ($context eq 'CSTR') {
         $filestem = "/res/$udom/$uname/$newdir";          $filestem = "/res/$udom/$uname/$newdir";
     }      }
Line 662  sub build_structure { Line 925  sub build_structure {
     foreach my $key (sort keys %pagecontents) {      foreach my $key (sort keys %pagecontents) {
         for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {          for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
             my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';              my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
               my $resource = "$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html";
               my $res = $$items{$pagecontents{$key}[$i][0]}{resnum};
               my $resource = $filestem.'/resfiles/'.$res.'.html';
               if (grep/^$res$/,@{$packages}) {
                   $resource =  $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point
               }
             open(PAGEFILE,">$filename");              open(PAGEFILE,">$filename");
             print PAGEFILE qq|<map>              print PAGEFILE qq|<map>
 <resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>  <resource src="$resource" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>
 <link to="2" index="1" from="1">\n|;  <link to="2" index="1" from="1">\n|;
             if (@{$pagecontents{$key}[$i]} == 1) {              if (@{$pagecontents{$key}[$i]} == 1) {
                 print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|;                  print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|;
             } elsif (@{$pagecontents{$key}[$i]} == 2)  {              } elsif (@{$pagecontents{$key}[$i]} == 2)  {
                 print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][1]}{resnum}.html" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|;                  my $res = $$items{$pagecontents{$key}[$i][1]}{resnum};
                   my $resource = $filestem.'/resfiles/'.$res.'.html';
                   if (grep/^$res$/,@{$packages}) {
                       $resource =  $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point
                   }
                   print PAGEFILE qq|<resource src="$resource" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|;
             } else {              } else {
                 for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {                  for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
                     my $curr_id = $j+1;                      my $curr_id = $j+1;
                     my $next_id = $j+2;                      my $next_id = $j+2;
                     my $resource = $filestem.'/resfiles/'.$$items{$pagecontents{$key}[$i][$j]}{resnum}.'.html';                      my $res = $$items{$pagecontents{$key}[$i][$j]}{resnum};
                       my $resource = $filestem.'/resfiles/'.$res.'.html';
                       if (grep/^$res$/,@{$packages}) {
                           $resource =  $filestem.'/resfiles/'.$res.'./index.html'; # entry_point
                       }
                     print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$$items{$pagecontents{$key}[$i][$j]}{title}"></resource>                      print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$$items{$pagecontents{$key}[$i][$j]}{title}"></resource>
 <link to="$next_id" index="$curr_id" from="$curr_id">\n|;  <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
                 }                  }
                 my $final_id = @{$pagecontents{$key}[$i]};                  my $final_id = @{$pagecontents{$key}[$i]};
                 print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][-1]}{resnum}.html" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;                  my $res = $$items{$pagecontents{$key}[$i][-1]}{resnum};
                   my $resource = $filestem.'/resfiles/'.$res.'.html';
                   if (grep/^$res$/,@{$packages}) {
                       $resource =  $filestem.'/resfiles/'.$res.'./index.html'; # entry_point
                   }
                   print PAGEFILE qq|<resource src="$resource" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;
             }              }
             print PAGEFILE "</map>";              print PAGEFILE "</map>";
             close(PAGEFILE);              close(PAGEFILE);
Line 689  sub build_structure { Line 972  sub build_structure {
 }  }
   
 sub make_structure {  sub make_structure {
     my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom) = @_;      my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick) = @_;
     my $src ='';      my $src ='';
     if (($cms eq 'angel' && $type eq 'FOLDER') || ($cms eq 'bb5' && ($$resinfo{$res}{'isfolder'} eq 'true')  || ($key eq 'Top')) ) {      if (($cms eq 'angel' && $type eq 'FOLDER') || (($cms eq 'bb5' || $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') || $key eq 'Top')) || ($cms eq 'webctce4' && $contitemcount > 0)) {
         $src = $srcstem.'/sequences/'.$contitem.'.sequence';          $src = $srcstem.'/sequences/'.$contitem.'.sequence';
         $$flag{$key}{page} = 0;          $$flag{$key}{page} = 0;
         $$flag{$key}{seq} = 1;          $$flag{$key}{seq} = 1;
         $$count{$key}{seq} ++;          $$count{$key}{seq} ++;
       } elsif ($cms eq 'webctce4' && $randompick) {
           $src = $srcstem.'/sequences/'.$res.'.sequence';
           $$flag{$key}{page} = 0;
           $$flag{$key}{seq} = 1;
           $$count{$key}{seq} ++;
     } elsif ($cms eq 'angel' && $type eq 'BOARD') {      } elsif ($cms eq 'angel' && $type eq 'BOARD') {
         $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';           $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard'; 
         $$flag{$key}{page} = 0;          $$flag{$key}{page} = 0;
Line 712  sub make_structure { Line 1000  sub make_structure {
     } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) )  {      } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) )  {
         if ($$flag{$key}{page}) {          if ($$flag{$key}{page}) {
             if ($$count{$key}{page} == -1) {              if ($$count{$key}{page} == -1) {
                 print STDERR "Array index is -1, we shouldnt be here, key is $key, type is $type\n";                  &Apache::lonnet::logthis("IMS Angel import error in array index for page: value = -1, resource is $key, type is $type.");
             } else {               } else { 
                 push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;                  push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
             }              }
Line 722  sub make_structure { Line 1010  sub make_structure {
             @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");              @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
             $$flag{$key}{seq} = 0;              $$flag{$key}{seq} = 0;
         }          }
     } elsif ($cms eq 'bb5') {      } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
         if ($$flag{$key}{page}) {          if ($$flag{$key}{page}) {
             push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;              push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
         } else {          } else {
               if ($contcount == 1) {
                   if ($packageflag) {
                       $src = $srcstem.'/resfiles/'.$res.'/index.html'; # Needs to be entry point
                   } else {
                       $src = $srcstem.'/resfiles/'.$res.'.html';
                   }
               } else {
                   $$count{$key}{page} ++;
                   $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';
                   @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");
               }
               $$flag{$key}{seq} = 0;
           }
       } elsif ($cms eq 'webctce4') {
           if ($type eq 'webctquiz') {
               $src =  $srcstem.'/pages/'.$res.'.page';
             $$count{$key}{page} ++;              $$count{$key}{page} ++;
             $src = $srcstem.'/pages/'.$key.'_'.$$count{$key}{page}.'.page';  
             @{$$pagecontents{$key}[$$count{$key}{page}]} = ("$contitem");  
             $$flag{$key}{seq} = 0;              $$flag{$key}{seq} = 0;
           } else {
               if (grep/^$file$/,@{$$hrefs{$res}}) {
                   my $filename;
                   if ($file =~ m-/([^/]+)$-) {
                       $filename = $1;
                   }
                   $src =  $srcstem.'/resfiles/'.$res.'/'.$filename;
               } else {
                   foreach my $file (@{$$hrefs{$res}}) {
                       my $filename;
                       if ($file =~ m-/([^/]+)$-) {
                           $filename = $1;
                       }
                       $src = $srcstem.'/resfiles/'.$res.'/'.$filename;
                   }
               }
               $$flag{$key}{page} = 0;
               $$flag{$key}{file} = 1;
         }          }
     }      }
     return $src;      return $src;
Line 753  sub process_specials { Line 1073  sub process_specials {
                   quizzes => 'quizzes',                    quizzes => 'quizzes',
                   surveys => 'surveys',                    surveys => 'surveys',
                   announcements => 'announcements',                    announcements => 'announcements',
                     pools => 'pools'
                   );                    );
     my %seqtitles = (      my %seqtitles = (
                   boards => 'Course Bulletin Boards',                    boards => 'Course Bulletin Boards',
                   quizzes => 'Course Quizzes',                    quizzes => 'Course Quizzes',
                   surveys => 'Course Surveys',                    surveys => 'Course Surveys',
                   announcements => 'Course Announcements',                    announcements => 'Course Announcements',
                     pools => 'Course Question Pools'
                    );                     );
     $$topnum ++;      $$topnum ++;
   
Line 800  sub process_specials { Line 1122  sub process_specials {
         $specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";          $specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";
     } elsif ($type eq 'announcements') {      } elsif ($type eq 'announcements') {
         $specialsrc = "$seqstem/resfiles/$$specials[0].html";          $specialsrc = "$seqstem/resfiles/$$specials[0].html";
       } elsif ($type eq 'pools') {
           $specialsrc = "$seqstem/sequences/$$specials[0].sequence";
     } else {      } else {
         $specialsrc = "$seqstem/pages/$$specials[0].page";          $specialsrc = "$seqstem/pages/$$specials[0].page";
     }      }
Line 849  sub process_user { Line 1173  sub process_user {
      [sub {       [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          push @state, $tagname;
         if (@state eq "USERS USER") {          if ("@state" eq "USERS USER") {
             $userid = $attr->{value};              $userid = $attr->{value};
             %{$$settings{$userid}} = ();              %{$$settings{$userid}} = ();
             @{$$settings{$userid}{links}} = ();              @{$$settings{$userid}{links}} = ();
         } elsif (@state eq "USERS USER LOGINID") {            } elsif ("@state" eq "USERS USER LOGINID") {  
             $$settings{$userid}{loginid} = $attr->{value};              $$settings{$userid}{loginid} = $attr->{value};
         } elsif (@state eq "USERS USER PASSPHRASE") {            } elsif ("@state" eq "USERS USER PASSPHRASE") {  
             $$settings{$userid}{passphrase} = $attr->{value};              $$settings{$userid}{passphrase} = $attr->{value};
         } elsif ("@state" eq "USERS USER STUDENTID" ) {          } elsif ("@state" eq "USERS USER STUDENTID" ) {
             $$settings{$userid}{studentid} = $attr->{value};              $$settings{$userid}{studentid} = $attr->{value};
Line 893  sub process_user { Line 1217  sub process_user {
      end_h =>       end_h =>
      [sub {       [sub {
         my ($tagname) = @_;          my ($tagname) = @_;
         if (@state eq "USERS USER") {          if ("@state" eq "USERS USER") {
             $linknum = 0;              $linknum = 0;
         }          }
         pop @state;          pop @state;
Line 930  sub process_group { Line 1254  sub process_group {
      [sub {       [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          push @state, $tagname;
         if (@state eq "GROUPS GROUP") {          if ("@state" eq "GROUPS GROUP") {
             $grp = $attr->{id};              $grp = $attr->{id};
         }                  }        
         if (@state eq "GROUPS GROUP TITLE") {          if ("@state" eq "GROUPS GROUP TITLE") {
             $$settings{$grp}{title} = $attr->{value};              $$settings{$grp}{title} = $attr->{value};
         } elsif (@state eq "GROUPS GROUP FLAGS ISAVAILABLE") {            } elsif ("@state" eq "GROUPS GROUP FLAGS ISAVAILABLE") {  
             $$settings{$grp}{isavailable} = $attr->{value};              $$settings{$grp}{isavailable} = $attr->{value};
         } elsif (@state eq "GROUPS GROUP FLAGS HASCHATROOM") {            } elsif ("@state" eq "GROUPS GROUP FLAGS HASCHATROOM") {  
             $$settings{$grp}{chat} = $attr->{value};              $$settings{$grp}{chat} = $attr->{value};
         } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {          } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
             $$settings{$grp}{discussion} = $attr->{value};              $$settings{$grp}{discussion} = $attr->{value};
Line 968  sub process_group { Line 1292  sub process_group {
   
 # ---------------------------------------------------------------- Process Blackboard Staff  # ---------------------------------------------------------------- Process Blackboard Staff
 sub process_staff {  sub process_staff {
   my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;    my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
   my $xmlfile = $docroot.'/'.$res.".dat";    my $xmlfile = $docroot.'/'.$res.".dat";
   my $filecount = 0;    my $filecount = 0;
   my @state;    my @state;
   %{$$settings{name}} = ();    %{$$settings{name}} = ();
   %{$$settings{office}} = ();      %{$$settings{office}} = ();
   
   my $p = HTML::Parser->new    my $p = HTML::Parser->new
     (      (
Line 982  sub process_staff { Line 1306  sub process_staff {
      [sub {       [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          push @state, $tagname;
         if (@state eq "STAFFINFO TITLE") {          if ("@state" eq "STAFFINFO TITLE") {
             $$settings{title} = $attr->{value};              $$settings{title} = $attr->{value};
         } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {          } elsif ("@state" eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
             $$settings{textcolor} = $attr->{value};              $$settings{textcolor} = $attr->{value};
         } elsif (@state eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {          } elsif ("@state" eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
             $$settings{ishtml} = $attr->{value};              $$settings{ishtml} = $attr->{value};
         } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {          } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
             $$settings{isavailable} = $attr->{value};              $$settings{isavailable} = $attr->{value};
Line 1126  sub process_staff { Line 1450  sub process_staff {
      |;       |;
      if ( defined($$settings{image}) ) {       if ( defined($$settings{image}) ) {
          $staffentry .= qq|           $staffentry .= qq|
       <img src="$dirname/resfiles/$res/$$settings{image}">        <img src="$res/$$settings{image}">
          |;           |;
      }       }
      $staffentry .= qq|       $staffentry .= qq|
Line 1149  $staffentry Line 1473  $staffentry
   
 # ---------------------------------------------------------------- Process Blackboard Links  # ---------------------------------------------------------------- Process Blackboard Links
 sub process_link {  sub process_link {
     my ($res,$docroot,$dirname,$destdir,$settings,$resrcfiles) = @_;      my ($res,$docroot,$destdir,$settings,$resrcfiles) = @_;
     my $xmlfile = $docroot.'/'.$res.".dat";      my $xmlfile = $docroot.'/'.$res.".dat";
     my @state = ();      my @state = ();
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
Line 1159  sub process_link { Line 1483  sub process_link {
         [sub {          [sub {
             my ($tagname, $attr) = @_;              my ($tagname, $attr) = @_;
             push @state, $tagname;              push @state, $tagname;
             if (@state eq "EXTERNALLINK TITLE") {              if ("@state" eq "EXTERNALLINK TITLE") {
                 $$settings{title} = $attr->{value};                  $$settings{title} = $attr->{value};
             } elsif (@state eq "EXTERNALLINK TEXTCOLOR") {                } elsif ("@state" eq "EXTERNALLINK TEXTCOLOR") {  
                 $$settings{textcolor} = $attr->{value};                  $$settings{textcolor} = $attr->{value};
             } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {                } elsif ("@state" eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {  
                 $$settings{ishtml} = $attr->{value};                                                 $$settings{ishtml} = $attr->{value};
             } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {              } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {
                 $$settings{isavailable} = $attr->{value};                  $$settings{isavailable} = $attr->{value};
             } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {              } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {
Line 1174  sub process_link { Line 1498  sub process_link {
             } elsif ("@state" eq "EXTERNALLINK POSITION" ) {              } elsif ("@state" eq "EXTERNALLINK POSITION" ) {
                 $$settings{position} = $attr->{value};                  $$settings{position} = $attr->{value};
             } elsif ("@state" eq "EXTERNALLINK URL" ) {              } elsif ("@state" eq "EXTERNALLINK URL" ) {
               $$settings{url} = $attr->{value};                  $$settings{url} = $attr->{value};
             }              }
         }, "tagname, attr"],          }, "tagname, attr"],
         text_h =>          text_h =>
Line 1438  sub addposting { Line 1762  sub addposting {
     }      }
     return $status;      return $status;
 }  }
 # ---------------------------------------------------------------- Process Blackboard Assessments - pools, quizzes, surveys  
 sub process_assessment {  sub parse_bb5_assessment {
     my ($res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname) = @_;      my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
     my $xmlfile = $docroot.'/'.$res.".dat";      my $xmlfile = $docroot.'/'.$res.".dat";
 #  print "XML file is $xmlfile\n";  
     my @state = ();      my @state = ();
     my @allids = ();  
     my %allanswers = ();  
     my %allchoices = ();  
     my $resdir = '';  
     if ($docroot =~ m|public_html/(.+)$|) {  
         $resdir = $1;  
     }  
     my $id; # the current question ID      my $id; # the current question ID
     my $answer_id; # the current answer ID      my $answer_id; # the current answer ID
     my %toptag = ( pool => 'POOL',      my %toptag = ( pool => 'POOL',
Line 1496  sub process_assessment { Line 1812  sub process_assessment {
         }              }    
         if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {            if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {  
             $id = $attr->{id};              $id = $attr->{id};
             unless ($container eq 'pool') {              push @{$allids}, $id;
                 push @allids, $id;  
             }  
             %{$$settings{$id}} = ();              %{$$settings{$id}} = ();
             @{$allanswers{$id}} = ();              @{$$allanswers{$id}} = ();
             $$settings{$id}{class} = $attr->{class};              $$settings{$id}{class} = $attr->{class};
             unless ($container eq "pool") {              unless ($container eq "pool") {
                 $$settings{$id}{points} = $attr->{points};                  $$settings{$id}{points} = $attr->{points};
Line 1510  sub process_assessment { Line 1824  sub process_assessment {
             $id = $attr->{id};              $id = $attr->{id};
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {          } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
             if ($state[4] eq "ISHTML") {              if ($state[4] eq "ISHTML") {
                 $$settings{$id}{html} = $attr->{value};                  $$settings{$id}{ishtml} = $attr->{value};
             } elsif ($state[4] eq "ISNEWLINELITERAL") {              } elsif ($state[4] eq "ISNEWLINELITERAL") {
                 $$settings{$id}{newline} = $attr->{value};                  $$settings{$id}{newline} = $attr->{value};
             }              }
Line 1522  sub process_assessment { Line 1836  sub process_assessment {
             $$settings{$id}{name} = $attr->{name};              $$settings{$id}{name} = $attr->{name};
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {          } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
             $answer_id = $attr->{id};              $answer_id = $attr->{id};
             push @{$allanswers{$id}},$answer_id;              push @{$$allanswers{$id}},$answer_id;
             %{$$settings{$id}{$answer_id}} = ();              %{$$settings{$id}{$answer_id}} = ();
             $$settings{$id}{$answer_id}{position} = $attr->{position};              $$settings{$id}{$answer_id}{position} = $attr->{position};
             if ($$settings{$id}{class} eq 'QUESTION_MATCH') {              if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
Line 1531  sub process_assessment { Line 1845  sub process_assessment {
             }              }
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {          } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
             $answer_id = $attr->{id};              $answer_id = $attr->{id};
             push @{$allchoices{$id}},$answer_id;               push @{$$allchoices{$id}},$answer_id; 
             %{$$settings{$id}{$answer_id}} = ();              %{$$settings{$id}{$answer_id}} = ();
             $$settings{$id}{$answer_id}{position} = $attr->{position};              $$settings{$id}{$answer_id}{position} = $attr->{position};
             $$settings{$id}{$answer_id}{placement} = $attr->{placement};              $$settings{$id}{$answer_id}{placement} = $attr->{placement};
Line 1566  sub process_assessment { Line 1880  sub process_assessment {
      text_h =>       text_h =>
      [sub {       [sub {
         my ($text) = @_;          my ($text) = @_;
           $text =~ s/^\s+//g;
           $text =~ s/\s+$//g;
         unless ($container eq "pool") {                  unless ($container eq "pool") {        
             if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {              if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
                 $$settings{description} = $text;                  $$settings{description} = $text;
Line 1573  sub process_assessment { Line 1889  sub process_assessment {
                 $$settings{instructions}{text} = $text;                  $$settings{instructions}{text} = $text;
             }              }
         }          }
         if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "TEXT") ) {          if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[-1] eq "TEXT") ) {
               unless ($text eq '') { 
                   $$settings{$id}{text} = $text;
               }
           } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[-1] eq "TEXT") ) {
               unless ($text eq '') {
                   $$settings{$id}{$answer_id}{text} = $text;
               }
           } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[-1] eq "TEXT") ) {
               unless ($text eq '') {
                   $$settings{$id}{$answer_id}{text} = $text;
               }
           } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[-1] eq "FEEDBACK_WHEN_CORRECT") ) {
               unless ($text eq '') {
                   $$settings{$id}{feedback_corr} = $text;
               }
           } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[-1] eq "FEEDBACK_WHEN_INCORRECT") ) {
               unless ($text eq '') {
                   $$settings{$id}{feedback_incorr} = $text;
               }
           }
         }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->marked_sections(1);
       $p->parse_file($xmlfile);
       $p->eof;
   }
   
   sub parse_bb6_assessment {
       my ($res,$docroot,$container,$settings,$allids) = @_;
       my $xmlfile = $docroot.'/'.$res.".dat";
       my @state = ();
       my $id; # the current question ID
       my $response; # the current response ID
       my $foil; # the current foil ID
       my $numchoice; # the current right match choice;
       my $labelcount; # the current count of choices for a matching item.
       my $curr_shuffle;
       my $curr_class; # the current question type
       my $curr_matchitem;
       my $curr_block_type; # the current block type
       my $curr_flow; # the current flow class attribute
       my $curr_flow_mat; # the current flow_mat class attribute
       my $curr_feedback_type; # the current feedback type
       my $numorder; # counter for ordering type questions
   
       my $itemfrag = "questestinterop assessment section item";
       my $presfrag = "$itemfrag presentation flow flow";
       my $blockflow = 'flow';
       my $responselid;
       my $instructionfrag = "questestinterop assessment presentation_material flow_mat material";
       my $feedbackfrag = "$itemfrag itemfeedback";
       my $feedback_tag = '';
       my $responselid;
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
           if ("@state" eq "questestinterop assessment") {
               $$settings{title} = $attr->{title};
           }
           if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
               $$settings{description}{texttype} = $attr->{type};
           }
           if ("@state" eq $presfrag) {
               if ($attr->{class} eq 'QUESTION_BLOCK') {
                   $curr_block_type = 'question';
               } elsif ($attr->{class} eq 'RESPONSE_BLOCK') {
                   $curr_block_type = 'response';
                   if ($curr_class eq 'Matching') {
                       $responselid = 'flow response_lid';
                   } else {
                       $responselid = 'response_lid';
                   }
               } elsif (($attr->{class} eq 'RIGHT_MATCH_BLOCK')) {
                   $numchoice = 0;
                   $curr_block_type = 'rightmatch';
               }
           }
           if ("@state" eq "$presfrag flow") {
               if (($curr_block_type =~ /^rightmatch/)  && ($attr->{class} eq 'Block')) {
                   $curr_block_type = 'rightmatch'.$numchoice;
                   $numchoice ++;
               }
           }
           if ($state[-1] eq 'flow') {
               $curr_flow = $attr->{class};
           }
           if ($state[-1] eq 'flow_mat') {
               $curr_flow_mat = $attr->{class};
           }
           if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
               $$settings{$id}{$curr_block_type}{texttype} = $attr->{texttype};
           }
           if ("@state" eq "$presfrag $blockflow material matapplication") {
               $$settings{$id}{$curr_block_type}{image} = $attr->{uri};
               $$settings{$id}{$curr_block_type}{style} = $attr->{embedded};
               $$settings{$id}{$curr_block_type}{label} = $attr->{label};
           }
           if ("@state" eq "$presfrag $blockflow material mattext") {
               $$settings{$id}{$curr_block_type}{link} = $attr->{uri};
           }
           if ("@state" eq "$presfrag $responselid") {
               $response = $attr->{ident};
               $labelcount = 0; 
               if ($curr_class eq 'Matching') {
                   push(@{$$settings{$id}{answers}},$response);
                   %{$$settings{$id}{$response}} = ();
                   foreach my $key (keys(%{$$settings{$id}{$curr_block_type}})) {
                       $$settings{$id}{$response}{$key} = $$settings{$id}{$curr_block_type}{$key};
                   }
                   %{$$settings{$id}{$curr_block_type}} = ();
               }
           }
           if ("@state" eq "$presfrag $responselid render_choice") {
               $curr_shuffle = $attr->{shuffle};
           }
           if ("@state" eq "$presfrag $responselid render_choice flow_label response_label") {
               $foil = $attr->{ident};
               %{$$settings{$id}{$foil}} = ();
               $$settings{$id}{$foil}{randomize} = $curr_shuffle;
               unless ($curr_class eq 'Essay'){
                   if ($curr_class eq 'Matching') {
                       push(@{$$settings{$id}{$response}{items}},$foil);
                       $$settings{$id}{$foil}{order} = $labelcount;
                       $labelcount ++;
                   } else {
                       push(@{$$settings{$id}{answers}},$foil);
                       @{$$settings{$id}{correctanswer}} = ();
                   }
               }
           }
           if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material matapplication") {
               $$settings{$id}{$foil}{filetype} = $attr->{embedded};
               $$settings{$id}{$foil}{label} = $attr->{label};
               $$settings{$id}{$foil}{uri} = $attr->{uri};
           }
           if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
               $$settings{$id}{$foil}{link} = $attr->{uri};
           }
           if ("@state" eq "questestinterop assessment section item resprocessing") {
               if ($curr_class eq 'Matching') {
                   $$settings{$id}{allchoices} = $numchoice;
               }
           }
           if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
               if ($curr_class eq 'Matching') { 
                   $curr_matchitem = $attr->{respident};
               }
           }
           if ("@state" eq $feedbackfrag) {
               $curr_feedback_type = $attr->{ident};
               $feedback_tag = "";
           }
           if ("@state" eq "$feedbackfrag solution") {
               $curr_feedback_type = 'solution';
               $feedback_tag = "solution solutionmaterial";
           }
           if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material matapplication") {
               $$settings{$id}{$curr_feedback_type.'feedback'}{filetype} = $attr->{'embedded'};
               $$settings{$id}{$curr_feedback_type.'feedback'}{label} = $attr->{label};
               $$settings{$id}{$curr_feedback_type.'feedback'}{uri} = $attr->{uri};
           }
           if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mattext") {
               $$settings{$id}{$curr_feedback_type.'feedback'}{link} = $attr->{uri};
           }
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
           $text =~ s/^\s+//g;
           $text =~ s/\s+$//g;
           if ("@state" eq "questestinterop assessment rubric flow_mat material mat_extension mat_formattedtext") {
               $$settings{description}{text} = $text;
           }
           if ("@state" eq "questestinterop assessment rubric flow_mat material mattext") {
               $$settings{description}{text} = $text;
           }
           if ("@state" eq "$instructionfrag mat_extension mat_formattedtext") {
               $$settings{instructions}{text} = $text;
           }
           if ("@state" eq "$instructionfrag mattext") {
               $$settings{instructions}{text} = $text;
           }
           if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_asi_object_id") {
               $id = $text;
               push @{$allids}, $id;
               %{$$settings{$id}} = ();
               @{$$settings{$id}{answers}} = ();
               %{$$settings{$id}{question}} = ();
               %{$$settings{$id}{correctfeedback}} = ();
               %{$$settings{$id}{incorrectfeedback}} = ();
               %{$$settings{$id}{solutionfeedback}} = ();
           }
           if ("@state" eq "questestinterop assessment section item itemmetadata bbmd_questiontype") {
               $$settings{$id}{class} = $text;
               $curr_class = $text;
               if ($curr_class eq 'Matching') {
                   $blockflow = 'flow flow';
               } else {
                   $blockflow = 'flow';
               } 
           }
           if ("@state" eq "$presfrag $blockflow material mat_extension mat_formattedtext") {
               $$settings{$id}{$curr_block_type}{text} = $text;
           }
           if ("@state" eq "$presfrag $blockflow material mattext") {
               if ($curr_flow eq 'LINK_BLOCK') { 
                   $$settings{$id}{$curr_block_type}{linkname} = $text;
               } elsif ($curr_flow eq 'FORMATTED_TEXT_BLOCK') {
                   $$settings{$id}{$curr_block_type}{text} = $text;
               }
           }
           if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mat_extension mat_formattedtext") {
               $$settings{$id}{$foil}{text} = $text;
           }
           if ("@state" eq "$presfrag $responselid render_choice flow_label response_label flow_mat material mattext") {
               if ($curr_flow_mat eq 'LINK_BLOCK') {
                   $$settings{$id}{$foil}{linkname} = $text;
               } else {
                   $$settings{$id}{$foil}{text} = $text;
               } 
           }
           if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar varequal") {
               if ($curr_class eq 'Matching') {
                   $$settings{$id}{$curr_matchitem}{correctanswer} = $text;
               } else {
                   push(@{$$settings{$id}{correctanswer}},$text);
               }
           }
           if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar") {
               $numorder = 0;
           }
           if ("@state" eq "questestinterop assessment section item resprocessing respcondition conditionvar and varequal") {
               push(@{$$settings{$id}{correctanswer}},$text);
               if ($curr_class eq 'Ordering') {
                   $numorder ++;
                   $$settings{$id}{$text}{order} = $numorder;
               }
           }
           if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mat_extension mat_formattedtext") {
               $$settings{$id}{$curr_feedback_type.'feedback'}{text} = $text;
           }
           if ("@state" eq "$feedbackfrag $feedback_tag flow_mat flow_mat material mattext") {
               $$settings{$id}{$curr_feedback_type.'feedback'}{linkname} = $text;
           }
        }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->marked_sections(1);
       $p->parse_file($xmlfile);
       $p->eof;
       return;
   }
   
   sub parse_webctvista4_assessment {
       my ($res,$docroot,$href,$allids,$qzparams) = @_;
       my $xmlfile = $docroot.'/'.$href; #assessment file
       my @state = ();
       my $id; # the current question ID
       my $fieldlabel; # the current qti metadata field label
       my $outcome_id; # the current question ID for outcomes conditions
       my $pname; # the current outcomes parameter name
       my $numids = 0;
       %{$$qzparams{$res}} = ();
       %{$$qzparams{$res}{weight}} = ();
   
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
           my @seq = ();
           if ("@state" eq "questestinterop assessment section itemref") {
               $id = $attr->{linkrefid};
               push(@{$allids},$id);
               $numids ++;
           }
           if ("@state" eq "questestinterop assessment section selection_ordering order") {
              $$qzparams{$res}{order_type} = $attr->{order_type};
           }
   
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
           if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldlabel") {
               $fieldlabel = $text;
           }
           if ("@state" eq "questestinterop assessment qtimetadata qtimetadatafield fieldentry") {
               $$qzparams{$res}{$fieldlabel} = $text;
           }
           if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition outcomes_metadata") {
               $outcome_id = $text;
           }
           if ("@state" eq "questestinterop assessment section outcomes_processing objects_condition objects_parameter") {
               if ($pname eq 'qmd_weighting') {
                   $$qzparams{$res}{weight}{$outcome_id} = $text;
               }
           }
           if ("@state" eq "questestinterop assessment section selection_ordering selection selection_number") {
               $$qzparams{$res}{numpick} = $text;
           }
         }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->parse_file($xmlfile);
       $p->eof;
       unless(defined($$qzparams{$res}{numpick})) {
           $$qzparams{$res}{numpick} = $numids;
       }
   }
   
   sub parse_webctvista4_question {
       my ($res,$docroot,$resources,$hrefs,$settings,$allquestids,$allanswers,$allchoices,$parent,$catinfo) = @_;
       my $xmlfile = $docroot.'/'.$$resources{$res}{file};
       my %classtypes = (
                         WCT_Calculated => 'numerical',
                         WCT_TrueFalse => 'multiplechoice',
                         WCT_ShortAnswer => 'shortanswer',
                         WCT_Paragraph => 'paragraph',
                         WCT_MultipleChoice => 'multiplechoice',
                         WCT_Matching => 'match',
                         WCT_JumbledSentence => 'jumbled',
                         WCT_FillInTheBlank => 'string',
                         WCT_Combination => 'combination'
       );
       my @state = ();
       my $fieldlabel;
       my %questiondata;
       my $id; # the current question ID
       my $list; # the current list ID for multiple choice questions 
       my $numid; # the current answer ID for numerical questions
       my $grp; # the current group ID for matching questions
       my $label; # the current reponse label for string questions
       my $str_id; # the current string ID for string questions
       my $unitid; # the current unit ID for numerical questions
       my $answer_id;  # the current answer ID 
       my $fdbk; # the current feedback ID
       my $currvar; # the current variable for numerical problems
       my $fibtype; # the current fill-in-blank type for numerical or string
       my $prompt;
       my $rows;
       my $columns;
       my $maxchars;
       my %setvar = (
                      varname => '',
                      action => '',
                    );
       my $currtexttype;
       my $jumble_item;
       my $numbox = 0;
       my %str_answers = ();
       my $textlabel;
       my $currindex;
       my %varinfo = ();
       my $formula;
       my $jumbnum = 0;
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
           if ("@state" eq "questestinterop item") {
               $id = $attr->{ident};
               push(@{$allquestids},$id);
               %{$$settings{$id}} = ();
               %{$varinfo{$id}} = ();
               @{$$allchoices{$id}} = ();
               @{$$settings{$id}{grps}} = ();
               @{$$settings{$id}{lists}} = ();
               @{$$settings{$id}{feedback}} = ();
               @{$$settings{$id}{str}} = ();
               %{$$settings{$id}{strings}} = ();
               @{$$settings{$id}{numids}} = ();
               %{$$allanswers{$id}} = ();
               $$settings{$id}{title} = $attr->{title};
           }
           if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {
               $currvar = $attr->{'webct:name'};
               %{$varinfo{$id}{$currvar}} = ();
               $varinfo{$id}{$currvar}{min} = $attr->{'webct:min'};
               $varinfo{$id}{$currvar}{max} = $attr->{'webct:max'};
               $varinfo{$id}{$currvar}{precision} = $attr->{'webct:precision'};
           }
           if ("@state" eq "questestinterop item presentation flow response_num") {
               $numid = $attr->{ident};
               push(@{$$settings{$id}{numids}},$numid);
               %{$$settings{$id}{$numid}} = ();
               %{$$settings{$id}{$numid}{vars}} = ();
               @{$$settings{$id}{$numid}{units}} = ();
               $$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
               $$settings{$id}{$numid}{formula} = $formula;
               foreach my $var (keys(%{$varinfo{$id}})) {
                   %{$$settings{$id}{$numid}{vars}{$var}} = %{$varinfo{$id}{$var}};
               }
           }
           if ("@state" eq "questestinterop item presentation flow material mat_extension webct:variable") {
               $$settings{$id}{text} .= '['.$attr->{'webct:name'}.']';
           }
           if ("@state" eq "questestinterop item presentation flow material matimage") {
               $$settings{$id}{image} = $attr->{uri};
           }
   
           if ("@state" eq "questestinterop item presentation flow material mattext")  {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{texttype} = $currtexttype;
               if ($$settings{$id}{class} eq 'combination') {
                   if (exists($attr->{label})) {
                       $textlabel = $attr->{label};
                   } else {
                       $textlabel = '';
                   }
               }
           }
           if ("@state" eq "questestinterop item presentation flow response_lid") {
               $list = $attr->{ident};
               push(@{$$settings{$id}{lists}},$list);
               %{$$settings{$id}{$list}} = ();
               @{$$allanswers{$id}{$list}} = ();
               @{$$settings{$id}{$list}{correctanswer}} = ();
               @{$$settings{$id}{$list}{jumbledtext}} = ();
               @{$$settings{$id}{$list}{jumbledtype}} = ();
               @{$$settings{$id}{$list}{jumbled}} = ();
               $$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
           }
   # Jumbled sentence
           if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object")  {
               $$settings{$id}{$list}{orientation} = $attr->{orientation};
           }
           if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext")  {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$list}{texttype} = $currtexttype;
           }
           if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label")  {
               $jumble_item = $attr->{ident};
           }
           if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext")  {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$list}{$jumble_item}{texttype} = $currtexttype;
           }
           if ("@state" eq "questestinterop item resprocessing respcondition") { # Jumbled
               if ($$settings{$id}{class} eq 'jumbled') {
                   $jumbnum ++;
                   @{$$settings{$id}{$list}{jumbled}[$jumbnum]} = (); 
               }
           }
   
           if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
               $currindex = $attr->{index};
           }
           if ("@state" eq "questestinterop item presentation flow response_lid render_choice") {
               $$settings{$id}{$list}{randomize} = $attr->{shuffle};
           }
   # Multiple Choice, True/False and Combination
           if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label") {
               $answer_id = $attr->{ident};
               push(@{$$allanswers{$id}{$list}},$answer_id);
               %{$$settings{$id}{$list}{$answer_id}} = ();
           }
   # True/False
           if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
           }
   
   # Multiple Choice and Combination
           if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$list}{$answer_id}{texttype} = $currtexttype;
           }
   
   # String, Shortanswer or Paragraph
           if (($$settings{$id}{class} eq 'string') || 
               ($$settings{$id}{class} eq 'shortanswer') ||
               ($$settings{$id}{class} eq 'paragraph')) { 
               if ("@state" eq "questestinterop item presentation flow response_str") {
                   $str_id = $attr->{ident};
                   %{$$settings{$id}{$str_id}} = ();
                   push(@{$$settings{$id}{str}},$str_id);
                   $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
                   @{$$settings{$id}{$str_id}{labels}} = ();
                   %{$$settings{$id}{$str_id}{comparison}} = ();
               }
           }
           if ("@state" eq "questestinterop item presentation flow response_str material mattext") { # string
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$str_id}{texttype} = $currtexttype;
           }
           if ("@state" eq "questestinterop item presentation flow response_str render_fib") {
               $fibtype = $attr->{fibtype};
               $prompt = $attr->{prompt};
               $rows = $attr->{rows};
               $columns = $attr->{columns};
               $maxchars = $attr->{maxchars};
           }
           if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label") {
               push(@{$$settings{$id}{$str_id}{labels}},$label);
               @{$$settings{$id}{strings}{$str_id}} = ();
               %{$$settings{$id}{$str_id}{$label}} = ();
               $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
               if ($$settings{$id}{class} eq 'string') {
                   $$settings{$id}{text} .= '[blank]';
               }
           }
           if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
               $textlabel = $attr->{label}; 
           }
   # Matching
           if ("@state" eq "questestinterop item presentation flow flow response_grp") {
               $grp = $attr->{ident};
               push(@{$$settings{$id}{grps}},$grp);
               %{$$settings{$id}{$grp}} = ();
               @{$$allanswers{$id}{$grp}} = ();
               @{$$settings{$id}{$grp}{correctanswer}} = ();
               $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
           }
           if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext") {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$grp}{texttype} = $currtexttype;
           }
           if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label") {
               $answer_id = $attr->{ident};
               push(@{$$allanswers{$id}{$grp}},$answer_id);
               %{$$settings{$id}{$grp}{$answer_id}} = ();
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$grp}{$answer_id}{texttype} =  $currtexttype;
           }
   # Multiple choice or combination or string or match 
           if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
               if (($$settings{$id}{class} eq 'multiplechoice') || 
                   ($$settings{$id}{class} eq 'combination')) {
                   $list = $attr->{respident};
               } elsif (($$settings{$id}{class} eq 'string') ||
                        ($$settings{$id}{class} eq 'shortanswer')) {
                   $label = $attr->{respident};
               } elsif ($$settings{$id}{class} eq 'match') {
                   $grp = $attr->{respident};
               }
           }
           if ("@state" eq "questestinterop item resprocessing") {
               if (($$settings{$id}{class} eq 'string') ||
                   ($$settings{$id}{class} eq 'shortanswer')) {
                   foreach my $str_id (@{$$settings{$id}{str}}) {
                       @{$str_answers{$str_id}} = ();
                   }
               }
           }
           if ("@state" eq "questestinterop item resprocessing respcondition") {
               if (($$settings{$id}{class} eq 'string') ||
                   ($$settings{$id}{class} eq 'shortanswer')) { 
                   $numbox ++;
               }
           }
           if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
               foreach my $key (keys(%{$attr})) {
                   $setvar{$key} = $attr->{$key};
               }
           }
           if (($$settings{$id}{class} eq 'string') ||
               ($$settings{$id}{class} eq 'shortanswer')) {
               if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) {
                   $str_id = $attr->{respident};
                   $$settings{$id}{$str_id}{case} = $attr->{case};
               }
           }
           if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varsubset") {
               $list = $attr->{respident};
           }
   # Numerical
           if ("@state" eq "questestinterop item resprocessing itemproc_extension webct:calculated_answer") {
               $numid = $attr->{respident};
               $$settings{$id}{$numid}{toltype} = $attr->{'webct:toleranceType'};
               $$settings{$id}{$numid}{tolerance} = $attr->{'webct:tolerance'};
           }
           if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
               $unitid = $attr->{respident};
               %{$$settings{$id}{$numid}{$unitid}} = ();
               push(@{$$settings{$id}{$numid}{units}},$unitid);
               $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
           }
   # Feedback
           if ("@state" eq "questestinterop item respcondition displayfeedback") {
               $fdbk = $attr->{linkrefid};
               push(@{$$settings{$id}{feedback}},$fdbk);
               $$settings{$id}{$fdbk} = ();
               $$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
           }
           if ("@state" eq "questestinterop item itemfeedback") {
               $fdbk = $attr->{ident};
               push(@{$$settings{$id}{feedback}},$fdbk);
               $$settings{$id}{$fdbk}{view} = $attr->{view};
           }
           if ("@state" eq "questestinterop item itemfeedback material mattext") {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$fdbk}{texttype} = $currtexttype;
           }
           if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
               $currtexttype = lc($attr->{texttype});
               $$settings{$id}{$fdbk}{texttype} = $currtexttype;
           }
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
           if ($currtexttype eq '/text/html') {
               $text =~ s#(&lt;img\ssrc=")([^"]+)"&gt;#$1../resfiles/$2#g;
           }
           if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldlabel") {
               $fieldlabel = $text;
           }
           if ("@state" eq "questestinterop item itemmetadata qtimetadata qtimetadatafield fieldentry") {
               $questiondata{$fieldlabel} = $text;
               if ($fieldlabel eq 'wct_questiontype') {
                   $$settings{$id}{class} = $classtypes{$text};
               } elsif ($fieldlabel eq 'wct_questioncategory') {
                   $$settings{$id}{category} = $text;
                   unless(exists($$catinfo{$text})) {
                       %{$$catinfo{$text}} = ();
                       $$catinfo{$text}{title} = $text;
                   }
                   push(@{$$catinfo{$text}{contents}},$id);
               }
           }
           if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:formula") {
               $formula = $text;
           }
           if ("@state" eq "questestinterop item presentation flow response_str material mattext") {
               $$settings{$id}{$str_id}{text} = $text;
           }
           if ("@state" eq "questestinterop item presentation flow response_str render_fib response_label material mattext") { # Paragraph
               if ($textlabel eq 'PRE_FILL_ANSWER') {
                   $$settings{$id}{$str_id}{$label}{$textlabel} = $text;
               }
           }
   # Matching
           if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mattext") {
               $$settings{$id}{$list}{$answer_id}{text} .= $text;
           }
   # Multiple choice, True/False, Combination
           if ("@state" eq "questestinterop item presentation flow response_lid render_choice flow_label response_label material mat_extension webct:localizable_mattext") {
               $$settings{$id}{$list}{$answer_id}{text} = $text;
           }
           if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object material mattext")  {
               push(@{$$settings{$id}{$list}{jumbledtext}},$text);
               push(@{$$settings{$id}{$list}{jumbledtype}},'No');
           }
           if ("@state" eq "questestinterop item presentation flow response_lid render_extension ims_render_object response_label material mattext")  {
               $$settings{$id}{$list}{$jumble_item}{text} = $text;
               push(@{$$settings{$id}{$list}{jumbledtext}},$text);
               push(@{$$settings{$id}{$list}{jumbledtype}},'Yes');
           }
           if ("@state" eq "questestinterop item presentation flow material mattext")  {
               $$settings{$id}{text} .= $text;
               if ($$settings{$id}{class} eq 'combination') {
                   if ($textlabel =~ /^wct_question_label_\d+$/) {
                       $$settings{$id}{text} .= '<br />';
                   }
                   if ($textlabel =~ /^wct_cmc_single_answer\d+$/) {
                       $$settings{$id}{text} .= '<br />';
                   }
               }
           }
   # Matching
           if ("@state" eq "questestinterop item presentation flow flow response_grp material mattext")  {
               $$settings{$id}{$grp}{text} = $text;
               unless ($text eq '') {
                   push(@{$$allchoices{$id}},$grp);
               }
           }
           if ("@state" eq "questestinterop item presentation flow flow response_grp render_choice flow_label response_label material mattext") {
               $$settings{$id}{$grp}{$answer_id}{text} = $text;
           }
   # Numerical
           if ("@state" eq "questestinterop item resprocessing itemproc_extension unit_eval conditionvar varequal") {
               $$settings{$id}{$numid}{$unitid}{text} = $text;
           }
           if ("@state" eq "questestinterop item resprocessing respcondition conditionvar varequal") {
               if (($$settings{$id}{class} eq 'string') ||
                   ($$settings{$id}{class} eq 'shortanswer')) {
                   unless (grep/^$text$/,@{$str_answers{$str_id}}) {
                       push(@{$str_answers{$str_id}},$text);
                       $$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
                   }
               } else {
                   $answer_id = $text;
               }
           }
           if (("@state" eq "questestinterop item resprocessing respcondition conditionvar or varsubset") || ("@state" eq "questestinterop item resprocessing respcondition conditionvar varsubset")) { # string
               if (($$settings{$id}{class} eq 'string') ||
                   ($$settings{$id}{class} eq 'shortanswer')) {
                   unless (grep/^$text$/,@{$str_answers{$str_id}}) {
                       push(@{$str_answers{$str_id}},$text);
                       $$settings{$id}{$str_id}{comparison}{$text} = $questiondata{'wct_comparison_type'.$numbox};
                   }
               }
           }
   
           if ("@state" eq "questestinterop item resprocessing respcondition conditionvar and varequal") { # Jumbled
               $$settings{$id}{$list}{jumbled}[$jumbnum][$currindex] = $text;
           }
           if ("@state" eq "questestinterop item resprocessing respcondition setvar") {
               if ($setvar{varname} eq "SCORE") { # Multiple Choice, String or Match
                   if ($text =~ m/^[\d\.]+$/) {
                       if ($text > 0) {
                           if (($$settings{$id}{class} eq 'multiplechoice') ||
                               ($$settings{$id}{class} eq 'combination')) {
                               push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
                           } elsif (($$settings{$id}{class} eq 'string') ||
                                    ($$settings{$id}{class} eq 'shortanswer')) {
                               foreach my $answer (@{$str_answers{$str_id}}) {
                                   unless (grep/^$answer$/,@{$$settings{$id}{strings}{$str_id}}) {
                                       push(@{$$settings{$id}{strings}{$str_id}},$answer);
                                   }
                               }
                           } elsif ($$settings{$id}{class} eq 'match') {
                               push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
                           }
                       }
                   }
               }
           }
           if ("@state" eq "questestinterop item itemfeedback material mattext") {
               $$settings{$id}{$fdbk}{text} = $text;
           }
           if ("@state" eq "questestinterop item itemfeedback solution solutionmaterial material mattext") {
               $$settings{$id}{$fdbk}{text} = $text;
           }
         }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->parse_file($xmlfile);
       $p->eof;
   }
   
   sub parse_webct4_assessment {
       my ($res,$docroot,$href,$container,$allids) = @_;
       my $xmlfile = $docroot.'/'.$href; #quiz file
       my @state = ();
       my $id; # the current question ID
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
           my $depth = 0;
           my @seq = ();
           if ("@state" eq "questestinterop assessment section itemref") {
               $id = $attr->{linkrefid}; 
               push(@{$allids},$id);
           }
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
         }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->parse_file($xmlfile);
       $p->eof;
   }
   
   sub parse_webct4_quizprops {
       my ($res,$docroot,$href,$container,$qzparams) = @_;
       my $xmlfile = $docroot.'/'.$href; #properties file
       my @state = ();
       %{$$qzparams{$res}} = ();
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
           if ($state[0] eq 'properties' && $state[1] eq 'delivery')  {
               if ($state[2] eq 'time_available') {
                   $$qzparams{$res}{opendate} = $text;
               } elsif ($state[2] eq 'time_due') {
                   $$qzparams{$res}{duedate} = $text;
               } elsif ($state[3] eq 'max_attempt') {
                   $$qzparams{$res}{tries} = $text;
               } elsif ($state[3] eq 'post_submission') {
                   $$qzparams{$res}{posts} = $text;
               } elsif ($state[3] eq 'method') {
                   $$qzparams{$res}{method} = $text;
               }
           } elsif ($state[0] eq 'properties' && $state[1] eq 'processing')  {
               if ($state[2] eq 'scores' && $state[3] eq 'score') {
                   $$qzparams{$res}{weight} = $text;
               } elsif ($state[2] eq 'selection' && $state[3] eq 'select') {
                   $$qzparams{$res}{numpick} = $text;
               }
           } elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
               if ($state[2] eq 'display_answer') {
                   $$qzparams{$res}{showanswer} = $text;
               }
           } 
         }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->parse_file($xmlfile);
       $p->eof;
   }
   
   sub parse_webct4_questionDB {
       my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
       $href =~ s#[^/]+$##;
       my $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file
       my @state = ();
       my $category; # the current category ID
       my $id; # the current question ID
       my $list; # the current list ID for multiple choice questions
       my $numid; # the current answer ID for numerical questions
       my $grp; # the current group ID for matching questions
       my $label; # the current reponse label for string questions 
       my $str_id; # the current string ID for string questions
       my $unitid; # the current unit ID for numerical questions
       my $answer_id; # the current answer ID
       my $fdbk; # the current feedback ID
       my $currvar; # the current variable for numerical problems
       my $fibtype; # the current fill-in-blank type for numerical or string
       my $prompt;
       my $boxnum; 
       my %setvar = (
                      varname => '',
                      action => '',
                    );
       my $currtexttype;
       my $currimagtype;  
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
           if ("@state" eq "questestinterop section") {
               $category = $attr->{ident};
               %{$$catinfo{$category}} = ();
               $$catinfo{$category}{title} = $attr->{title};   
           }
           if ("@state" eq "questestinterop section item") {
               $id = $attr->{ident};
               push @{$allids}, $id;
               push(@{$$catinfo{$category}{contents}},$id);
               %{$$settings{$id}} = ();
               @{$$allchoices{$id}} = ();
               @{$$settings{$id}{grps}} = ();
               @{$$settings{$id}{lists}} = ();
               @{$$settings{$id}{feedback}} = ();
               @{$$settings{$id}{str}} = ();
               %{$$settings{$id}{strings}} = ();
               @{$$settings{$id}{numids}} = ();
               @{$$settings{$id}{boxes}} = ();
               %{$$allanswers{$id}} = ();
               $$settings{$id}{title} = $attr->{title};
               $$settings{$id}{category} = $category;
               $boxnum = 0;
           }
   
           if ("@state" eq "questestinterop section item presentation material mattext") {
               $$settings{$id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation material matimage") {
               $$settings{$id}{imagtype} = $attr->{imagtype};
               $currimagtype = $attr->{imagtype};
               $$settings{$id}{uri} = $attr->{uri};
           }
   
   # Matching
           if ("@state" eq "questestinterop section item presentation response_grp") {
               $$settings{$id}{class} = 'match';
               $grp = $attr->{ident};
               push(@{$$settings{$id}{grps}},$grp);
               %{$$settings{$id}{$grp}} = ();
               @{$$settings{$id}{$grp}{correctanswer}} = ();
               $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
           }
           if ("@state" eq "questestinterop section item presentation response_grp material mattext") { 
               $$settings{$id}{$grp}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label") {
               $answer_id = $attr->{ident};
               push(@{$$allanswers{$id}{$grp}},$answer_id);
               %{$$settings{$id}{$grp}{$answer_id}} = ();
               $$settings{$id}{$grp}{$answer_id}{texttype} =  $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
   
   # Multiple choice
   
           if ("@state" eq "questestinterop section item presentation flow material mattext") {
               $$settings{$id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid") {
               $$settings{$id}{class} = 'multiplechoice';
               $list = $attr->{ident};
               push(@{$$settings{$id}{lists}},$list);
               %{$$settings{$id}{$list}} = ();
               @{$$allanswers{$id}{$list}} = ();
               @{$$settings{$id}{$list}{correctanswer}} = ();
               $$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice") {
               $$settings{$id}{$list}{randomize} = $attr->{shuffle};
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label") {
               $answer_id = $attr->{ident};
               push(@{$$allanswers{$id}{$list}},$answer_id);
               %{$$settings{$id}{$list}{$answer_id}} = ();
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
               $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
   
   # Numerical
           if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
               $$settings{$id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation response_num") {
               $$settings{$id}{class} = 'numerical';
               $numid = $attr->{ident};
               push(@{$$settings{$id}{numids}},$numid);
               %{$$settings{$id}{$numid}} = ();
               %{$$settings{$id}{$numid}{vars}} = ();
               @{$$settings{$id}{$numid}{units}} = ();
               $$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {            
               $currvar = $attr->{name};
               %{$$settings{$id}{$numid}{vars}{$currvar}} = ();
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
               $currvar = $attr->{name};
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
               $currvar = $attr->{name};
           }
           if ("@state" eq "questestinterop section item presentation response_num render_fib") {
               $fibtype = $attr->{fibtype};
               $prompt = $attr->{prompt};
           }
           if ("@state" eq "questestinterop section item presentation response_num render_fib response_label") {
               $$settings{$id}{$numid}{label} = $attr->{ident};
           }
   
   # String or Numerical
           if ("@state" eq "questestinterop section item presentation response_str") {
               $str_id = $attr->{ident};
               push(@{$$settings{$id}{str}},$str_id);
               @{$$settings{$id}{boxes}[$boxnum]} = ();
               $boxnum ++;
               %{$$settings{$id}{$str_id}} = ();
               @{$$settings{$id}{$str_id}{labels}} = ();
               $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
           }
   
           if ("@state" eq "questestinterop section item presentation response_str render_fib") {
               $fibtype = $attr->{fibtype};
               $prompt = $attr->{prompt};
           }    
           if ("@state" eq "questestinterop section item presentation response_str render_fib response_label") {
               $label = $attr->{ident};
               push(@{$$settings{$id}{$str_id}{labels}},$label);
               @{$$settings{$id}{strings}{$label}} = ();
               %{$$settings{$id}{$str_id}{$label}} = ();
               $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
           }
   
   # Numerical
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anspresentation") {
               $$settings{$id}{$numid}{digits} = $attr->{digits};
               $$settings{$id}{$numid}{format} = $attr->{format};
           }
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
               $$settings{$id}{$numid}{toltype} = $attr->{type};
           }
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
               $unitid = $attr->{ident};
               %{$$settings{$id}{$numid}{$unitid}} = ();
               push(@{$$settings{$id}{$numid}{units}},$unitid);
               $$settings{$id}{$numid}{$unitid}{value} = $attr->{value}; 
               $$settings{$id}{$numid}{$unitid}{space} = $attr->{space};
               $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
           }
   
   # Matching 
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
               if ($$settings{$id}{class} eq 'match') {
                   unless ($attr->{respident} eq 'WebCT_Incorrect') {
                       $grp = $attr->{respident};
                   }
   # String
               } else {
                   $label = $attr->{respident};
                   $$settings{$id}{$label}{case} = $attr->{case};   
               } 
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
               $setvar{varname} = $attr->{varname};
               if ($setvar{varname} eq 'WebCT_Correct') {
                   push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
               }
           }
   
   # String
           if ("@state" eq "questestinterop section item resprocessing") {
               $boxnum = -1;
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition") {            $boxnum ++;
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") {
               $$settings{$id}{class} = 'string';
               $label = $attr->{respident};
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar not") {
               $$settings{$id}{class} = 'paragraph';
           }
    
   
   # Feedback
    
           if ("@state" eq "questestinterop section item respcondition displayfeedback") {
               $fdbk = $attr->{linkrefid};
               push(@{$$settings{$id}{feedback}},$fdbk);
               $$settings{$id}{$fdbk} = ();
               $$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
           }
           if ("@state" eq "questestinterop section item itemfeedback") {
               $fdbk = $attr->{ident};
               $$settings{$id}{$fdbk}{view} = $attr->{view};
           }
           if ("@state" eq "questestinterop section item itemfeedback material mattext") {
               $$settings{$id}{$fdbk}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
           if ($currtexttype eq '/text/html') {
               $text =~ s#(&lt;img\ssrc=")([^"]+)"&gt;#$1../resfiles/$2#g;
           }
           if ("@state" eq "questestinterop section item itemmetadata qmd_itemtype") {
               $$settings{$id}{itemtype} = $text;
               if ($text eq 'String') {
                   $$settings{$id}{class} = 'string';
               }
           }
   
           if ("@state" eq "questestinterop section item presentation material mattext") {
             $$settings{$id}{text} = $text;              $$settings{$id}{text} = $text;
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) {          }
             $$settings{$id}{$answer_id}{text} = $text;  # Matching
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) {          if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
             $$settings{$id}{$answer_id}{text} = $text;                          $$settings{$id}{$grp}{text} = $text;
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) {              unless ($text eq '') {
             $$settings{$id}{feedback_corr} = $text;                  push(@{$$allchoices{$id}},$grp);
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) {              }
             $$settings{$id}{feedback_incorr} = $text;                 }
           if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label material mattext") {
               $$settings{$id}{$grp}{$answer_id}{text} = $text;
           }
   
   # Multiple choice
   
           if ("@state" eq "questestinterop section item presentation flow material mattext") {
               $$settings{$id}{text} = $text;
           }
   
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
               $$settings{$id}{$list}{$answer_id}{text} = $text;
           }
   
   # Numerical
           if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
               $$settings{$id}{text} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
                $$settings{$id}{$numid}{vars}{$currvar}{min} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
                $$settings{$id}{$numid}{vars}{$currvar}{max} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
                $$settings{$id}{$numid}{vars}{$currvar}{dec} = $text;
           }
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_formula") {
               $$settings{$id}{$numid}{formula} = $text;
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
               if ($$settings{$id}{class} eq 'string') {
                   unless (grep/^$text$/,@{$$settings{$id}{strings}{$label}}) {
                       push(@{$$settings{$id}{strings}{$label}},$text);
                   }
                   unless (grep/^$text$/,@{$$settings{$id}{boxes}[$boxnum]}) {
                       push(@{$$settings{$id}{boxes}[$boxnum]},$text);
                   }
               } else {
                   $answer_id = $text;
               }
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") { # String
               unless (grep/^$text$/,@{$$settings{$id}{strings}{$label}}) {
                   push(@{$$settings{$id}{strings}{$label}},$text);
               }
               unless (grep/^$text$/,@{$$settings{$id}{boxes}[$boxnum]}) {
                   push(@{$$settings{$id}{boxes}[$boxnum]},$text);
               }
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
               if ($setvar{varname} eq "answerValue") { # Multiple Choice
                   if ($text =~ m/^\d+$/) {
                       if ($text > 0) {
                           push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);   
                       }
                   }
               }
           }
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
               $$settings{$id}{$numid}{tolerance} = $text;
           }
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
               $$settings{$id}{$numid}{$unitid}{text} = $text;
           }
   
           if ("@state" eq "questestinterop section item itemfeedback material mattext") {
               $$settings{$id}{$fdbk}{text} = $text;
         }          }
       }, "dtext"],        }, "dtext"],
      end_h =>       end_h =>
Line 1594  sub process_assessment { Line 3077  sub process_assessment {
     $p->unbroken_text(1);      $p->unbroken_text(1);
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
       my $boxcount;
       foreach my $id (keys %{$settings}) {
           if ($$settings{$id}{class} eq 'string') {
               $boxcount = 0;
               if (@{$$settings{$id}{boxes}} > 1) {
                   foreach my $str_id (@{$$settings{$id}{str}}) {
                       foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
                           @{$$settings{$id}{strings}{$label}} = @{$$settings{$id}{boxes}[$boxcount]};
                           $boxcount ++;
                       }
                   }
               }
           }
       }
   }
   
     my $dirtitle = $$settings{'title'};  sub process_assessment {
     $dirtitle =~ s/\W//g;      my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs,$allquestions) = @_;
     $dirtitle .= '_'.$res;      my @allids = ();
     if (!-e "$destdir/problems/$dirtitle") {      my @allquestids = ();
         mkdir("$destdir/problems/$dirtitle",0755);      my %allanswers = ();
       my %allchoices = ();
       my %qzparams = ();
       my %alldbanswers = ();
       my %alldbchoices = ();
       my @alldbquestids = ();
       my $containerdir;
       my $newdir;
       my $randompickflag = 0;
       my ($cid,$cdom,$cnum);
       if ($context eq 'DOCS') {
           $cid = $env{'request.course.id'};
           ($cdom,$cnum) = split/_/,$cid;
     }      }
     my $newdir = "$destdir/problems/$dirtitle";      my $destresdir = $destdir;
     my $pagedir = "$destdir/pages";      if ($context eq 'CSTR') {
           $destresdir =~ s|/home/$uname/public_html/|/res/$udom/$uname/|;
       } elsif ($context eq 'DOCS') {
           $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
       }
       if ($cms eq 'bb5') {
           &parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
       } elsif ($cms eq 'bb6') {
           &parse_bb6_assessment($res,$docroot,$container,$settings,\@allids);
       } elsif ($cms eq 'webctce4') {
           unless($$dbparse) {
               &parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
               &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
               &write_webct4_questions($cms,\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
               $$dbparse = 1;
           }
           &parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
           &parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
           if (exists($qzparams{$res}{numpick})) { 
               if ($qzparams{$res}{numpick} < @allids) {
                   $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
                   $randompickflag = 1;
               }
           }
       } elsif ($cms eq 'webctvista4') {
           unless($$dbparse) {
               foreach my $res (sort keys %{$allquestions}) {
                   my $parent = $$allquestions{$res};
                   &parse_webctvista4_question($res,$docroot,$resources,$hrefs,$settings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);
               }
               &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
               $$dbparse = 1;
           }
           &parse_webctvista4_assessment($res,$docroot,$hrefs,\@allids,\%qzparams);
           if ($qzparams{$res}{numpick} < @allids) {
               $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
               $randompickflag = 1;
           }
       }
       my $dirtitle;
       unless ($cms eq 'webctce4') {
           $dirtitle = $$settings{'title'};
           $dirtitle =~ s/\W//g;
           $dirtitle .= '_'.$res;
           if (!-e "$destdir/problems") {
               mkdir("$destdir/problems",0755);
           }
           if (!-e "$destdir/problems/$dirtitle") {
               mkdir("$destdir/problems/$dirtitle",0755);
           }
           $newdir = "$destdir/problems/$dirtitle";
       }
   
       if ($cms eq 'webctce4') {
           &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
       } else {
           &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$settings);
       }
       if ($cms eq 'bb5') {
           &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
       } elsif ($cms eq 'bb6') {
           &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot);
       } elsif ($cms eq 'webctvista4') {
           &write_webct4_questions($cms,\@allquestids,$context,$settings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
       }
   }
   
   sub build_category_sequences {
       my ($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings) = @_;
       if (!-e "$destdir/sequences") {
           mkdir("$destdir/sequences",0755);
       }
       my $numcats = scalar(keys %{$catinfo});
     my $curr_id = 0;      my $curr_id = 0;
     my $next_id = 1;      my $next_id = 1;
     unless ($container eq 'pool') {      my $fh;
         open(PAGEFILE,">$pagedir/$res.page");      open($fh,">$destdir/sequences/question_database.sequence");
         print PAGEFILE qq|<map>      push @{$sequencesfiles},'question_database.sequence';
 |;      foreach my $category (sort keys %{$catinfo}) {
         $$total{page} ++;           my $seqname = $$catinfo{$category}{title}.'_'.$category;
         print PAGEFILE qq|<resource id="1" src="/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[0].problem" type="start"></resource>|;          $seqname =~ s/\s/_/g;
         if (@allids == 1) {          $seqname =~ s/\W//g;
             print PAGEFILE qq|          push(@{$sequencesfiles},$seqname.'.sequence');
           my $catsrc = "$destresdir/sequences/$seqname.sequence";
           if ($curr_id == 0) {
               print $fh qq|<resource id="1" src="$catsrc" type="start" title="$$catinfo{$category}{title}"></resource>|;
           }
           if ($numcats == 1) {
               print $fh qq|
 <link from="1" to="2" index="1"></link>  <link from="1" to="2" index="1"></link>
 <resource id="2" src="" type="finish">\n|;  <resource id="2" src="" type="finish">\n|;
         } else {          } else {
             for (my $j=1; $j<@allids; $j++) {              $curr_id = $next_id;
                 $curr_id = $j;              $next_id = $curr_id + 1;
                 $next_id = $curr_id + 1;              $catsrc = "$destresdir/sequences/$seqname.sequence";
                 print PAGEFILE qq|              print $fh qq|
 <link from="$curr_id" to="$next_id" index="$curr_id"></link>  <link from="$curr_id" to="$next_id" index="$curr_id"></link>
 <resource id="$next_id" src="/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[$j].problem"|;  <resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
                 if ($next_id == @allids) {              if ($next_id == $numcats) {
                     print PAGEFILE qq| type="finish"></resource>\n|;                  print $fh qq| type="finish"></resource>\n|;
               } else {
                   print $fh qq|></resource>\n|;
               }
           }
           print $fh qq|</map>|;
           if (!-e "$destdir/problems") {
               mkdir("$destdir/problems",0755);
           }
           if (!-e "$destdir/problems/$seqname") {
               mkdir("$destdir/problems/$seqname",0755);
           }
           $$newdir = "$destdir/problems/$seqname";
           my $dbcontainerdir;
           &build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
       }
       close($fh);
   }
   
   sub build_problem_container {
       my ($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,$allids,$udom,$uname,$dirname,$containerdir,$cid,$cdom,$cnum,$catinfo,$settings) = @_;
       my $seqdir = "$destdir/sequences";
       my $pagedir = "$destdir/pages";
       my $curr_id = 0;
       my $next_id = 1;
       my $fh;
       if ($container eq 'pool' || $randompickflag || $container eq 'database') {
           $$containerdir = $seqdir.'/'.$res.'.sequence';
           if (!-e "$seqdir") {
               mkdir("$seqdir",0770);
           }
           open($fh,">$$containerdir");
           $$total{seq} ++;
           push @{$sequencesfiles},$res.'.sequence';
       } else {
           $$containerdir = $pagedir.'/'.$res.'.page';
           if (!-e "$destdir/pages") {
               mkdir("$destdir/pages",0770);
           }
           open($fh,">$$containerdir");
           $$total{page} ++;
           push @{$pagesfiles},$res.'.page';
       }
       print $fh qq|<map>
   |;
       my %probtitle = ();
       my $probsrc = "/res/lib/templates/simpleproblem.problem";
       if ($context eq 'CSTR') {
           foreach my $id (@{$allids}) {
               if (($cms eq 'webctce4') || ($cms eq 'webctvista4')) {
                   $probtitle{$id} = $$settings{$id}{title};
               } else {
                   $probtitle{$id} = $$settings{title};
               }
               $probtitle{$id} =~ s/\s/_/g;
               $probtitle{$id} =~ s/\W//g;
               $probtitle{$id} .= '_'.$id;
           }
           if ($cms eq 'webctce4' && $container ne 'database') {
               my $catid = $$settings{$$allids[0]}{category};
               my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
               $probdir =~ s/\s/_/g;
               $probdir =~ s/\W//g;
               $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
           } else {
               $probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
           }
       }
       print $fh qq|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>|;
       if (@{$allids} == 1) {
           print $fh qq|
   <link from="1" to="2" index="1"></link>
   <resource id="2" src="" type="finish">\n|;
       } else {
           for (my $j=1; $j<@{$allids}; $j++) {
               my $qntitle = $j+1;
               while (length($qntitle) <4) {
                   $qntitle = '0'.$qntitle;
               }
               $curr_id = $j;
               $next_id = $curr_id + 1;
               if ($context eq 'CSTR') {
                   if ($cms eq 'webctce4' && $container ne 'database') {
                       my $catid = $$settings{$$allids[$j]}{category};
                       my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
                       $probdir =~ s/\s/_/g;
                       $probdir =~ s/\W//g;
                       $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
                 } else {                  } else {
                     print PAGEFILE qq|></resource>|;                      $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
                 }                  }
             }              }
               print $fh qq|
   <link from="$curr_id" to="$next_id" index="$curr_id"></link>
   <resource id="$next_id" src="$probsrc" title="question_$qntitle"|;
               if ($next_id == @{$allids}) {
                   print $fh qq| type="finish"></resource>\n|;
               } else {
                   print $fh qq|></resource>|;
               }
         }          }
         print PAGEFILE qq|</map>|;  
         close(PAGEFILE);  
     }      }
     foreach my $id (@allids) {      print $fh qq|</map>|;
         my $output = qq|<problem>      close($fh);
   }
   
   sub write_bb5_questions {
       my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
       my $qnum = 0;
       my $pathstart;
       if ($context eq 'CSTR') {
           $pathstart = '../..';
       } else {
           $pathstart = $dirname;
       }
       foreach my $id (@{$allids}) {
           if ($$settings{$id}{ishtml} eq 'true') {
               $$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
           }
           if ($$settings{$id}{text} =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
               if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
                   $$settings{$id}{text} =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
               }
           }
           $$settings{$id}{text} =~ s#(<img src=[^>]+)/*>#$1 />#gi;
           $$settings{$id}{text} =~ s#<br>#<br />#g;
           $qnum ++;
           my $output;
           my $permcontainer = $containerdir;
           $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
           my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
           my %resourcedata = ();
           for (my $i=0; $i<10; $i++) {
               my $iter = $i+1;
               $resourcedata{$symb.'text'.$iter} = "";
               $resourcedata{$symb.'value'.$iter} = "unused";
               $resourcedata{$symb.'position'.$iter} = "random";
           }
           $resourcedata{$symb.'randomize'} = 'yes';
           $resourcedata{$symb.'maxfoils'} = 10;
           if ($context eq 'CSTR') {
               $output = qq|<problem>
 |;  |;
           }
         $$total{prob} ++;          $$total{prob} ++;
         if ($$settings{$id}{class} eq "QUESTION_ESSAY") {          if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
             $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />              if ($context eq 'CSTR') {
                   $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
  <essayresponse>   <essayresponse>
  <textfield></textfield>   <textfield></textfield>
  </essayresponse>   </essayresponse>
  <postanswerdate>   <postanswerdate>
  $$settings{$id}{feedbackcorr}    $$settings{$id}{feedbackcorr} 
  </postanswerdate>   </postanswerdate>
 |;  |;
                } else {
    $resourcedata{$symb.'questiontext'} = $$settings{$id}{text};
                    $resourcedata{$symb.'hiddenparts'} = '!essay';
                    $resourcedata{$symb.'questiontype'} = 'essay';
                }
         } else {          } else {
             $output .= qq|<startouttext />$$settings{$id}{text}\n|;              if ($context eq 'CSTR') {
             if ( defined($$settings{$id}{image}) ) {                   $output .= qq|<startouttext />$$settings{$id}{text}\n|;
               } else {
                   $resourcedata{$symb.'questiontext'} = $$settings{$id}{text};
               }
               my ($image,$imglink,$url);
               if ( defined($$settings{$id}{image}) ) {
                 if ( $$settings{$id}{style} eq 'embed' ) {                  if ( $$settings{$id}{style} eq 'embed' ) {
                     $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{image}" /><br />|;                      $image = qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{image}" /><br />|;
                 } else {                  } else {
                     $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;                      $imglink = qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
                 }                  }
             }              }
             if ( defined($$settings{$id}{url}) ) {              if ( defined($$settings{$id}{url}) ) {
                 $output .= qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;                  $url = qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
               }
               if ($context eq 'CSTR') {
                   $output .= $image.$imglink.$url.'
   <endouttext />';
               } else {
                   $resourcedata{$symb.'questiontext'} .= $image.$imglink.$url;
             }              }
             $output .= qq|  
 <endouttext />|;  
             if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {              if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 $output .= qq|                  if ($context eq 'CSTR') {
                       $output .= qq|
  <radiobuttonresponse max="$numfoils" randomize="yes">   <radiobuttonresponse max="$numfoils" randomize="yes">
   <foilgroup>    <foilgroup>
 |;  |;
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  } else {
                       $resourcedata{$symb.'hiddenparts'} = '!radio';
                       $resourcedata{$symb.'questiontype'} = 'radio';
                       $resourcedata{$symb.'maxfoils'} = $numfoils;
                   }
                   for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                       my $iter = $k+1;
                     $output .= "   <foil name=\"foil".$k."\" value=\"";                      $output .= "   <foil name=\"foil".$k."\" value=\"";
                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {                      if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                         $output .= "true\" location=\"";                          $output .= "true\" location=\"";
                           $resourcedata{$symb.'value'.$iter} = "true";
                     } else {                      } else {
                         $output .= "false\" location=\"";                          $output .= "false\" location=\"";
                           $resourcedata{$symb.'value'.$iter} = "false";
                     }                      }
                     if (lc ($allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {                      if (lc ($$allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
                         $output .= "bottom\"";                          $output .= "bottom\"";
                           $resourcedata{$symb.'position'.$iter} = "bottom";
                     } else {                      } else {
                         $output .= "random\"";                          $output .= "random\"";
                     }                      }
                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};                      $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text};
                     if ( defined($$settings{$id}{$allanswers{$id}[$k]}{image}) ) {                      $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                         if ( $$settings{$id}{$allanswers{$id}[$k]}{style} eq 'embed' ) {                      my ($ans_image,$ans_link);
                             $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" /><br />|;                      if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {
                           if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {
                               $ans_image .= qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" /><br />|;
                         } else {                          } else {
                             $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;                              $ans_link .= qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
                         }                          }
                     }                      }
                     $output .= qq|<endouttext /></foil>\n|;                      $output .= $ans_image.$ans_link.'<endouttext /></foil>'."\n";
                       $resourcedata{$symb.'text'.$iter} .= $ans_image.$ans_link;
                 }                  }
                 chomp($output);                  if ($context eq 'CSTR') {
                 $output .= qq|                      chomp($output);
                       $output .= qq|
   </foilgroup>    </foilgroup>
  </radiobuttonresponse>   </radiobuttonresponse>
 |;  |;
                   }
             } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {              } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 $output .= qq|                  if ($context eq 'CSTR') {
                       $output .= qq|
    <radiobuttonresponse max="$numfoils" randomize="yes">     <radiobuttonresponse max="$numfoils" randomize="yes">
     <foilgroup>      <foilgroup>
 |;  |;
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  } else {
                       $resourcedata{$symb.'maxfoils'} = $numfoils;
                       $resourcedata{$symb.'hiddenparts'} = '!radio';
                       $resourcedata{$symb.'questiontype'} = 'radio';
                   }
                   for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                       my $iter = $k+1;
                     $output .= "   <foil name=\"foil".$k."\" value=\"";                      $output .= "   <foil name=\"foil".$k."\" value=\"";
                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {                      if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                         $output .= "true\" location=\"random\"";                          $output .= "true\" location=\"random\"";
                           $resourcedata{$symb.'value'.$iter} = "true";
                     } else {                      } else {
                         $output .= "false\" location=\"random\"";                          $output .= "false\" location=\"random\"";
                           $resourcedata{$symb.'value'.$iter} = "false";
                     }                      }
                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";                      $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                       $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                 }                  }
                 chomp($output);                  if ($context eq 'CSTR') {
                 $output .= qq|                      chomp($output);
                       $output .= qq|
     </foilgroup>      </foilgroup>
    </radiobuttonresponse>     </radiobuttonresponse>
 |;  |;
                   }
             } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {              } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 $output .= qq|                  if ($context eq 'CSTR') {
                       $output .= qq|
    <optionresponse max="$numfoils" randomize="yes">     <optionresponse max="$numfoils" randomize="yes">
     <foilgroup options="('True','False')">      <foilgroup options="('True','False')">
 |;  |;
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  } else {
                       $resourcedata{$symb.'newopt'} = '';
                       $resourcedata{$symb.'delopt'} = '';
                       $resourcedata{$symb.'options'} = "('True','False')";
                       $resourcedata{$symb.'hiddenparts'} = '!option';
                       $resourcedata{$symb.'questiontype'} = 'option';
                       $resourcedata{$symb.'maxfoils'} = $numfoils;
                   }
                   for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                       my $iter = $k+1;
                     $output .= "   <foil name=\"foil".$k."\" value=\"";                      $output .= "   <foil name=\"foil".$k."\" value=\"";
                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {                      if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                         $output .= "True\"";                          $output .= "True\"";
                           $resourcedata{$symb.'value'.$iter} = "True";
                     } else {                      } else {
                         $output .= "False\"";                          $output .= "False\"";
                           $resourcedata{$symb.'value'.$iter} = "False";
                     }                      }
                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";                      $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                       $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                 }                  }
                 chomp($output);                  if ($context eq 'CSTR') {  
                 $output .= qq|                      chomp($output);
                       $output .= qq|
     </foilgroup>      </foilgroup>
    </optionresponse>     </optionresponse>
 |;  |;
                   }
             } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {              } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 $output .= qq|                  my @allorder = ();
                   if ($context eq 'CSTR') {
                       $output .= qq|
    <rankresponse max="$numfoils" randomize="yes">     <rankresponse max="$numfoils" randomize="yes">
     <foilgroup>      <foilgroup>
 |;  |;
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  } else {
                     $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";                      $resourcedata{$symb.'newopt'} = '';
                       $resourcedata{$symb.'delopt'} = '';
                       $resourcedata{$symb.'hiddenparts'} = '!option';
                       $resourcedata{$symb.'questiontype'} = 'option';
                       $resourcedata{$symb.'maxfoils'} = $numfoils;
                 }                  }
                 chomp($output);                  for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                 $output .= qq|                      if ($context eq 'CSTR') {
                           $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                       } else {
                           my $iter = $k+1;
                           $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                           if (!grep/^$$settings{$id}{$$allanswers{$id}[$k]}{order}$/,@allorder) {
                               push @allorder, $$settings{$id}{$$allanswers{$id}[$k]}{order};
                           }
                       }
                   }
                   if ($context eq 'CSTR') {
                       chomp($output);
                       $output .= qq|
     </foilgroup>      </foilgroup>
    </rankresponse>     </rankresponse>
 |;  |;
                   } else {
                       @allorder = sort {$a <=> $b} @allorder;
                       $resourcedata{$symb.'options'} = "('".join("','",@allorder)."')";
                   }
             } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {              } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
                 my $numerical = 1;                  my $numerical = 1;
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  if ($context eq 'DOCS') {
                     if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {                      $numerical = 0;
                         $numerical = 0;                  } else {
                       for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                           if ($$settings{$id}{$$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
                               $numerical = 0;
                           }
                     }                      }
                 }                  }
                 if ($numerical) {                  if ($numerical) {
                     my $numans;                      my $numans;
                     my $tol;                      my $tol;
                     if (@{$allanswers{$id}} == 1) {                      if (@{$$allanswers{$id}} == 1) {
                         $tol = 5;                          $tol = 5;
                         $numans = $$settings{$id}{$allanswers{$id}[0]}{text};                          $numans = $$settings{$id}{$$allanswers{$id}[0]}{text};
                     } else {                      } else {
                         my $min = $$settings{$id}{$allanswers{$id}[0]}{text};                          my $min = $$settings{$id}{$$allanswers{$id}[0]}{text};
                         my $max = $$settings{$id}{$allanswers{$id}[0]}{text};                          my $max = $$settings{$id}{$$allanswers{$id}[0]}{text};
                         for (my $k=1; $k<@{$allanswers{$id}}; $k++) {                          for (my $k=1; $k<@{$$allanswers{$id}}; $k++) {
                             if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {                              if ($$settings{$id}{$$allanswers{$id}[$k]}{text} <= $min) {
                                 $min = $$settings{$id}{$allanswers{$id}[$k]}{text};                                  $min = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                             }                              }
                             if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {                              if ($$settings{$id}{$$allanswers{$id}[$k]}{text} >= $max) {
                                 $max = $$settings{$id}{$allanswers{$id}[$k]}{text};                                  $max = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                             }                              }
                         }                          }
                         $numans = ($max + $min)/2;                          $numans = ($max + $min)/2;
                         $tol = 100*($max - $min)/($numans*2);                          $tol = 100*($max - $min)/($numans*2);
                     }                      }
                     $output .= qq|                      if ($context eq 'CSTR') {
                           $output .= qq|
 <numericalresponse answer="$numans">  <numericalresponse answer="$numans">
         <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />          <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
         <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"          <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
Line 1781  sub process_assessment { Line 3585  sub process_assessment {
         <textline />          <textline />
 </numericalresponse>  </numericalresponse>
 |;  |;
                       }
                   } else {
                       if ($context eq 'DOCS') {
                           $resourcedata{$symb.'hiddenparts'} = '!string';
                           $resourcedata{$symb.'questiontype'} = 'string';
                           $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
                           $resourcedata{$symb.'hiddenparts'} = '!string';
                           $resourcedata{$symb.'stringtype'} = 'ci';
                           $resourcedata{$symb.'stringanswer'} = $$settings{$id}{$$allanswers{$id}[0]}{text};
                       } else {
                           if (@{$$allanswers{$id}} == 1) {
                               $output .= qq|
   <stringresponse answer="$$settings{$id}{$$allanswers{$id}[0]}{text}" type="ci">
   <textline>
   </textline>
   </stringresponse>
   |;
                           } else {
                               my @answertext = ();
                               for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                                   $$settings{$id}{$$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
                                   push @answertext, $$settings{$id}{$$allanswers{$id}[$k]}{text};
                               }
                               my $regexpans = join('|',@answertext);
                               $regexpans = '/^('.$regexpans.')\b/';
                               $output .= qq|
   <stringresponse answer="$regexpans" type="re">
   <textline>
   </textline>
   </stringresponse>
   |;
                           }
                       } 
                   }
               } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
                   my @allmatchers = ();
                   my %matchtext = ();
                   if ($context eq 'CSTR') {
                       $output .= qq|
   <matchresponse max="10" randomize="yes">
       <foilgroup>
           <itemgroup>
   |;
                   } else {
                       $resourcedata{$symb.'newopt'} = '';
                       $resourcedata{$symb.'delopt'} = '';
                       $resourcedata{$symb.'hiddenparts'} = '!option';
                       $resourcedata{$symb.'questiontype'} = 'option';
                       $resourcedata{$symb.'maxfoils'} =  @{$$allanswers{$id}};
                   }
                   for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
                       if ($context eq 'CSTR') {
                           $output .= qq|
   <item name="$$allchoices{$id}[$k]">
   <startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
   </item>
                       |;
                       } else {
                           if (!grep/^$$settings{$id}{$$allchoices{$id}[$k]}{text}$/,@allmatchers) {
                               push @allmatchers, $$settings{$id}{$$allchoices{$id}[$k]}{text};
                               $matchtext{$$allchoices{$id}[$k]} = $$settings{$id}{$$allchoices{$id}[$k]}{text};
                           }
                       }
                   }
                   if ($context eq 'CSTR') {
                       $output .= qq|
           </itemgroup>
   |;
                   }
                   for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                       if ($context eq 'CSTR') {
                           $output .= qq|
           <foil location="random" value="$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}" name="$$allanswers{$id}[$k]">
            <startouttext />$$settings{$id}{$$allanswers{$id}[$k]}{text}<endouttext />
           </foil>
   |;
                       } else {
                           my $iter = $k+1;
                           $resourcedata{$symb.'value'.$iter} = $matchtext{$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}};
                           $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                       }
                   }
                   if ($context eq 'CSTR') {
                       $output .= qq|
       </foilgroup>
   </matchresponse>
   |;
                   } else {
                       $resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
                   }
               }
           }
           if ($context eq 'CSTR') {
               $output .= qq|</problem>
   |;
               my $title = $$settings{title};
               $title =~ s/\s/_/g;
               $title =~ s/\W//g;
               $title .= '_'.$id;
               open(PROB,">:utf8", "$newdir/$title.problem");
               print PROB $output;
               close PROB;
           } else {
   # put %resourcedata;
               my $reply=&Apache::lonnet::cput
                   ('resourcedata',\%resourcedata,$cdom,$cnum);
           }
       }
   }
   
   sub write_webct4_questions {
       my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo) = @_;
       my $qnum = 0;
       foreach my $id (@{$alldbquestids}) {
           $qnum ++;
           my $output;
           my $permcontainer = $destdir.'/sequences/'.$id.'.sequence';
           my $allfeedback;
           my $questionimage;
           foreach my $fdbk (@{$$settings{$id}{feedback}}) {
               my $feedback =  $$settings{$id}{$fdbk}{text};
               if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {
                   $feedback = &HTML::Entities::decode($feedback);
               }
               $allfeedback .= $feedback;
           }
           if ($$settings{$id}{texttype} eq 'text/html') {
               if ($$settings{$id}{text}) {
                   $$settings{$id}{text} = &text_cleanup($$settings{$id}{text});
               }
           } 
           if ($$settings{$id}{class} eq 'numerical') {
               foreach my $numid (@{$$settings{$id}{numids}}) {
                   foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
                       if ($cms eq 'webct4ce') {
                           $$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
                       } elsif ($cms eq 'webctvista4') {
                           $$settings{$id}{text} =~ s/\[($var)\]/\$$1 /g;
                       }
                   }
               }
           }
           $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
           my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
           my %resourcedata = ();
           for (my $i=0; $i<10; $i++) {
               my $iter = $i+1;
               $resourcedata{$symb.'text'.$iter} = "";
               $resourcedata{$symb.'value'.$iter} = "unused";
               $resourcedata{$symb.'position'.$iter} = "random";
           }
           $resourcedata{$symb.'randomize'} = 'yes';
           $resourcedata{$symb.'maxfoils'} = 10;
           if ($context eq 'CSTR') {
               unless ($$settings{$id}{class} eq 'numerical') {
                   $output = qq|<problem>
   |;
               }
           }
           $$total{prob} ++;
           if (exists($$settings{$id}{uri})) {
               if ($cms eq 'webct4ce') {
                   if ($$settings{$id}{imagtype} =~ /^image\//) {
                       $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
                 } else {                  } else {
                     if (@{$allanswers{$id}} == 1) {                      $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
                   }
               } elsif ($cms eq 'webctvista4') {
                   if ($$settings{$id}{uri} =~ /(gif|jpg|png)$/i) {
                       $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
                       $questionimage =~ s#(//+)#/#g;
                   } else {
                       $questionimage = '<a href="'.$$settings{$id}{uri}.'" target="exturi" >'.$$settings{$id}{uri}.'</a>';
                   }
               }
           }
           if ($$settings{$id}{class} eq "paragraph") {
               my $pre_fill_answer = $$settings{$id}{PARA}{PARA}{PRE_FILL_ANSWER};
               if ($context eq 'CSTR') {
                   $output .= qq|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />
    <essayresponse>
    <textfield>$pre_fill_answer</textfield>
    </essayresponse>
    <postanswerdate>
     $allfeedback
    </postanswerdate>
   |;
               } else {
                   $resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
                   $resourcedata{$symb.'hiddenparts'} = '!essay';
                   $resourcedata{$symb.'questiontype'} = 'essay';
               }
           } elsif ($$settings{$id}{class} eq 'jumbled') {
               if ($context eq 'CSTR') {
                   my %foiloptions = ();
                   foreach my $list (@{$$settings{$id}{lists}}) {
                       @{$foiloptions{$list}} = ();
                       my $numalternates = @{$$settings{$id}{$list}{jumbled}} - 1;
                       my $loopstop = 2; #Hard coded for now, so only one permutation of answers is correct; <or> functionality is needed to support the case where multiple permutations are correct.  
                       for (my $i=1; $i<$loopstop; $i++) {  
                           $foiloptions{$list}[$i]  = '(';
                           for (my $j=@{$$settings{$id}{$list}{jumbled}[$i]}-1; $j>0; $j--) {
                               my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$j];
                               $foiloptions{$list}[$i] .= "'".$$settings{$id}{$list}{$jumble_item}{text}."',";
                           }
                           $foiloptions{$list}[$i] =~ s/,$//;
                           $foiloptions{$list}[$i] .= ')';
                           my $jnum = 0; 
                           for (my $k=0; $k<@{$$settings{$id}{$list}{jumbledtype}}; $k++) {
                               if ($$settings{$id}{$list}{jumbledtype}[$k] eq 'No') {
                                   $output .= qq|
   <startouttext />
   $$settings{$id}{$list}{jumbledtext}[$k]
   <endouttext />|;
                               } elsif ($$settings{$id}{$list}{jumbledtype}[$k] eq 'Yes') {
                                   $jnum ++;
                                   my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$jnum];
                                   $output .= qq|
   <optionresponse max="1" randomize="yes" TeXlayout="horizontal">
       <foilgroup options="$foiloptions{$list}[$i]">
           <foil location="random" value="$$settings{$id}{$list}{$jumble_item}{text}" name="$jumble_item"></foil>
       </foilgroup>
   </optionresponse>
   |;
                               }
                           }
                       }
                       if ($numalternates > 0) { # for now alternates are stored in an instructorcomment.  In the future these alternates could be moved into the main response area once <or> functionality is available.
                           $output .= '<instructorcomment>(Not shown to students) '."\n".'The following alternates were imported from the corresponding WebCT Vista 4 jumbled sentence question, but are not included in the LON-CAPA version, because this style of question does not currently support multiple correct solutions.'."\n";
                           for (my $i=2; $i<@{$$settings{$id}{$list}{jumbled}}; $i++) {
                               my $altid = $i-1;
                               my $jnum = 0;
                               $output .= $altid.'. '; 
                               for (my $k=0; $k<@{$$settings{$id}{$list}{jumbledtype}}; $k++) {
                                   if ($$settings{$id}{$list}{jumbledtype}[$k] eq 'No') {
                                       $output .= "$$settings{$id}{$list}{jumbledtext}[$k]" ;
                                   } elsif ($$settings{$id}{$list}{jumbledtype}[$k] eq 'Yes') {
                                       $jnum ++;
                                       my $jumble_item = $$settings{$id}{$list}{jumbled}[$i][$jnum];
                                       $output .= '['.$$settings{$id}{$list}{$jumble_item}{text}.']';
                                   }
                               }
                               $output .= " \n";
                           }
                           $output .= '</instructorcomment>';
                       }  
                   }
               }
           } else {
               if ($context eq 'CSTR') {
                   $output .= qq|<startouttext /><p>$$settings{$id}{text}</p>$questionimage<endouttext />\n|;
               } else {
                   $resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
               }
               if (($$settings{$id}{class} eq 'multiplechoice') || 
                   ($$settings{$id}{class} eq 'combination')) {
                   foreach my $list (@{$$settings{$id}{lists}}) {
                       my $numfoils = @{$$allanswers{$id}{$list}};
                       if ($$settings{$id}{$list}{rcardinality} eq 'Single') {
                           if ($context eq 'CSTR') {
                               $output .= qq|
    <radiobuttonresponse max="$numfoils" randomize="$$settings{$id}{$list}{randomize}">
     <foilgroup>
   |;
                           } else {
                               $resourcedata{$symb.'hiddenparts'} = '!radio';
                               $resourcedata{$symb.'questiontype'} = 'radio';
                               $resourcedata{$symb.'maxfoils'} = $numfoils;
                           }
                           for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
                               my $iter = $k+1;
                               $output .= "   <foil name=\"foil".$k."\" value=\"";
                               if (grep/^$$allanswers{$id}{$list}[$k]$/,@{$$settings{$id}{$list}{correctanswer}}) {
                                   $output .= "true\" location=\"";
                                   $resourcedata{$symb.'value'.$iter} = "true";
                               } else {
                                   $output .= "false\" location=\"";
                                   $resourcedata{$symb.'value'.$iter} = "false";
                               }
                               if (lc ($$allanswers{$id}{$list}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
                                   $output .= "bottom\"";
                                   $resourcedata{$symb.'position'.$iter} = "bottom";
                               } else {
                                   $output .= "random\"";
                               }
                               if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~  s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~  s#</?p>##g;
   
                               }
                               $output .= "\><startouttext />".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
                               $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
                               $output .= '<endouttext /></foil>'."\n";
                           }
                           if ($context eq 'CSTR') {
                               chomp($output);
                               $output .= qq|
     </foilgroup>
    </radiobuttonresponse>
   |;
                           }
                       } else {
                           if ($context eq 'CSTR') {
                               $output .= qq|
      <optionresponse max="$numfoils" randomize="yes">
       <foilgroup options="('True','False')">
   |;
                           } else {
                               $resourcedata{$symb.'newopt'} = '';
                               $resourcedata{$symb.'delopt'} = '';
                               $resourcedata{$symb.'options'} = "('True','False')";
                               $resourcedata{$symb.'hiddenparts'} = '!option';
                               $resourcedata{$symb.'questiontype'} = 'option';
                               $resourcedata{$symb.'maxfoils'} = $numfoils;
                           }
                           for (my $k=0; $k<@{$$allanswers{$id}{$list}}; $k++) {
                               my $iter = $k+1;
                               $output .= "   <foil name=\"foil".$k."\" value=\"";
                               if (grep/^$$allanswers{$id}{$list}[$k]$/,@{$$settings{$id}{$list}{correctanswer}}) {
                                   $output .= "True\"";
                                   $resourcedata{$symb.'value'.$iter} = "True";
                               } else {
                                   $output .= "False\"";
                                   $resourcedata{$symb.'value'.$iter} = "False";
                               }
                               if ($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{texttype} eq 'text/html') {
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text});
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~  s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
                                   $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text} =~  s#</?p>##g;
                               }
                               $output .= "\><startouttext />".$$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text}."<br /><endouttext /></foil>\n";
                               $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$list}{$$allanswers{$id}{$list}[$k]}{text};
                           }
                           if ($context eq 'CSTR') {
                               chomp($output);
                               $output .= qq|
       </foilgroup>
      </optionresponse>
   |;
                           }
                       }
                   }
               } elsif ($$settings{$id}{class} eq 'match') {
                   my %allmatchers = ();
                   my @allmatch = ();
                   my %matchtext = ();
                   my $anscount = 0;
                   my %ansnum = ();
                   my $maxfoils = 0;
                   my $test_for_html = 0; 
                   foreach my $grp (@{$$allchoices{$id}}) {
                       $maxfoils += @{$$settings{$id}{$grp}{correctanswer}};
                       foreach my $answer_id (@{$$allanswers{$id}{$grp}}) {
                           if ($$settings{$id}{$grp}{$answer_id}{texttype} eq '/text/html') {
                                
                               $$settings{$id}{$grp}{$answer_id}{text} = &HTML::Entities::decode($$settings{$id}{$grp}{$answer_id}{text});
                               $test_for_html = &test_for_html($$settings{$id}{$grp}{$answer_id}{text});
                               $$settings{$id}{$grp}{$answer_id}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$grp}{$answer_id}{text});
                               $$settings{$id}{$grp}{$answer_id}{text} =~  s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
                               $$settings{$id}{$grp}{$answer_id}{text} =~  s#</?p>##g;
                           }
                           unless (exists($allmatchers{$$settings{$id}{$grp}{$answer_id}{text}})) {
                               $allmatchers{$$settings{$id}{$grp}{$answer_id}{text}} = $anscount;
                               $allmatch[$anscount] = $$settings{$id}{$grp}{$answer_id}{text};
                               $anscount ++;
                               
                           }
                           if (grep/^$answer_id$/,@{$$settings{$id}{$grp}{correctanswer}}) {
                               push(@{$ansnum{$grp}},$allmatchers{$$settings{$id}{$grp}{$answer_id}{text}});
                           }
                       }
                       if ($context eq 'DOCS') {
                           $matchtext{$ansnum{$grp}[0]} = $allmatch[$ansnum{$grp}[0]-1];
                       }
                   }
                   my $allmatchlist = "('".join("','",@allmatch)."')";
                   if ($context eq 'CSTR') {
                       if ($test_for_html) {
                           $output .= qq|
   <matchresponse max="$maxfoils" randomize="yes">
       <foilgroup>
           <itemgroup>
   |;
                       } else {
                           $output .= qq|
   <optionresponse max="10" randomize="yes">
       <foilgroup options="$allmatchlist">
   |;
                       }
                   } else {
                       $resourcedata{$symb.'newopt'} = '';
                       $resourcedata{$symb.'delopt'} = '';
                       $resourcedata{$symb.'hiddenparts'} = '!option';
                       $resourcedata{$symb.'questiontype'} = 'option';
                       $resourcedata{$symb.'maxfoils'} =  $maxfoils;
                   }
                   my $iter = 0;
                   foreach my $match (@allmatch) {  
                       $iter ++;
                       if ($context eq 'CSTR') {
                           if ($test_for_html) {
                               $output .= qq|
   <item name="ans_$iter">
   <startouttext />$match<endouttext />
   </item>
   |;
                           }
                       }
                   }
                   if ($context eq 'CSTR') {
                       if ($test_for_html) {
                           $output .= qq|
           </itemgroup>
   |;
                       }
                   }
                   $iter = 0;
                   for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
                       if ($$settings{$id}{$$allchoices{$id}[$k]}{texttype} eq 'text/html') {
                           $$settings{$id}{$$allchoices{$id}[$k]}{text} = &HTML::Entities::decode($$settings{$id}{$$allchoices{$id}[$k]}{text});
                           $$settings{$id}{$$allchoices{$id}[$k]}{text} = &Apache::loncleanup::htmlclean($$settings{$id}{$$allchoices{$id}[$k]}{text});
                           $$settings{$id}{$$allchoices{$id}[$k]}{text} =~  s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
                           $$settings{$id}{$$allchoices{$id}[$k]}{text} =~  s#</?p>##g;
                       }
                       foreach my $ans (@{$ansnum{$$allchoices{$id}[$k]}}) {
                           $iter ++;
                           my $ans_id = $ans + 1;
                           if ($context eq 'CSTR') {
                               my $value;
                               if ($test_for_html) {
                                   $value = 'ans_'.$ans_id;
                               } else {
                                   $value = $allmatch[$ans];
                               }
                               $output .= qq|
           <foil location="random" value="$value" name="foil_$iter">
            <startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
           </foil>
                              
   |;
                           }
                       }
                       if ($context eq 'DOCS') {
                           $resourcedata{$symb.'value'.$iter} = $matchtext{$ansnum{$$allchoices{$id}[$k]}[0]};
                           $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allchoices{$id}[0]}{text};
                       }
                   }
                   if ($context eq 'CSTR') {
                       $output .= qq|
       </foilgroup>
   |;
                       if ($test_for_html) {
                           $output .= qq|
   </matchresponse>
   |;
                       } else {
                         $output .= qq|                          $output .= qq|
 <stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">  </optionresponse>
   |;
                       }
                   } else {
                       $resourcedata{$symb.'options'} = "('".join("','",@allmatch)."')";
                   }
               } elsif (($$settings{$id}{class} eq 'string') || 
                        ($$settings{$id}{class} eq 'shortanswer')) {
                   my $labelnum = 0;
                   my @str_labels = ();
                   if ($cms eq 'webct4ce') {
                       foreach my $str_id (@{$$settings{$id}{str}}) {
                           foreach my $label (@{$$settings{$id}{$str_id}{labels}}) {
                               push(@str_labels,$label);
                           }
                       }
                   } elsif ($cms eq 'webctvista4') {
                       @str_labels = @{$$settings{$id}{str}};
                   }
                   foreach my $label (@str_labels) {
                       $labelnum ++;
                       my $numerical = 1;
                       if ($context eq 'DOCS') {
                           $numerical = 0;
                       } else {
                           for (my $i=0; $i<@{$$settings{$id}{strings}{$label}}; $i++) {
                               $$settings{$id}{strings}{$label}[$i] =~ s/^\s+//;
                               $$settings{$id}{strings}{$label}[$i] =~ s/\s+$//; 
                               if ($$settings{$id}{strings}{$label}[$i] =~ m/([^\-\d\.]|\.\.)/) {
                                   $numerical = 0;
                               }
                           }
                       }
                       if ($numerical) {
                           my $numans;
                           my $tol;
                           if (@{$$settings{$id}{strings}{$label}} == 1) {
                               $tol = '5%';
                               $numans = $$settings{$id}{strings}{$label}[0];
                           } else {
                               my $min = $$settings{$id}{strings}{$label}[0];
                               my $max = $$settings{$id}{strings}{$label}[0];
                               for (my $k=1; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
                                   if ($$settings{$id}{strings}{$label}[$k] <= $min) {
                                       $min = $$settings{$id}{strings}{$label}[$k];
                                   }
                                   if ($$settings{$id}{strings}{$label}[$k] >= $max) {
                                       $max = $$settings{$id}{strings}{$label}[$k];
                                   }
                               }
                               $numans = ($max + $min)/2;
                               if ($numans == 0) {
                                   my $dev = abs($max - $numans);
                                   if (abs($numans - $min) > $dev) {
                                       $dev = abs($numans - $min);
                                   }
                                   $tol = $dev;
                               } else {
                                   $tol = 100*($max - $min)/($numans*2);
                                   $tol .= '%';
                               }
                           }
                           if ($context eq 'CSTR') {
                               if (@{$$settings{$id}{str}} > 1) {
                                   $output .= qq|
   <startouttext />$labelnum.<endouttext />
   |;
                               }
                               $output .= qq|
   <numericalresponse answer="$numans">
           <responseparam type="tolerance" default="$tol" name="tol" description="Numerical Tolerance" />
           <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
   />
           <textline />
   </numericalresponse>
   <startouttext /><br /><endouttext />
   |;
                           }
                       } else {
                           if ($context eq 'DOCS') {
                               $resourcedata{$symb.'hiddenparts'} = '!string';
                               $resourcedata{$symb.'questiontype'} = 'string';
                               $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}{strings}{$label}};
                               $resourcedata{$symb.'hiddenparts'} = '!string';
                               if ($$settings{$id}{$label}{case} eq "No") {
                                   $resourcedata{$symb.'stringtype'} = 'ci';
                               } elsif ($$settings{$id}{$label}{case} eq "Yes") {
                                   $resourcedata{$symb.'stringtype'} = 'cs';
                               }
                               $resourcedata{$symb.'stringanswer'} = $$settings{$id}{strings}{$label}[0];
                           } else {
                               if (@{$$settings{$id}{str}} > 1) {
                                   $output .= qq|
   <startouttext />$labelnum.<endouttext />
   |;
                               }
                               if (@{$$settings{$id}{strings}{$label}} == 1) {
                                   my $casetype;
                                   if ($$settings{$id}{$label}{case} eq "No") {
                                       $casetype = 'ci';
                                   } elsif ($$settings{$id}{$label}{case} eq "Yes") {
                                       $casetype = 'cs';
                                   }
                                   $output .= qq|
   <stringresponse answer="$$settings{$id}{strings}{$label}[0]" type="$casetype">
 <textline>  <textline>
 </textline>  </textline>
 </stringresponse>  </stringresponse>
   <startouttext /><br /><endouttext />
 |;  |;
                               } else {
                                   my @answertext = ();
                                   for (my $k=0; $k<@{$$settings{$id}{strings}{$label}}; $k++) {
                                       $$settings{$id}{strings}{$label}[$k] =~ s/\|/\|/g;
                                       push @answertext, $$settings{$id}{strings}{$label}[$k];
                                   }
                                   my $regexpans = join('|',@answertext);
                                   $regexpans = '/^('.$regexpans.')\b/';
                                   $output .= qq|
   <stringresponse answer="$regexpans" type="re">
   <textline>
   </textline>
   </stringresponse>
   <startouttext /><br /><endouttext />
   |;
                               }
                           }
                       }
                   }
               } elsif ($$settings{$id}{class} eq 'numerical') {
                   my %mathfns = (
                       'abs' => 'abs',
                       'acos' => 'acos',
                       'asin' => 'asin',
                       'atan' => 'atan',
                       'ceil' => 'ceil',
                       'cos' => 'cos',
                       'exp' => 'exp',
                       'fact' => 'factorial',
                       'floor' => 'floor',
                       'int' => 'int',
                       'ln' => 'log',
                       'log' => 'log',
                       'max' => 'max',
                       'min' => 'min',
                       'round' => 'roundto',
                       'sin' => 'sin',
                       'sqrt' => 'sqrt',
                       'tan' => 'tan',
                   );
                   my $scriptblock = qq|
   <script type="loncapa/perl">
   |;
                   foreach my $numid (@{$$settings{$id}{numids}}) {
                       my $formula = $$settings{$id}{$numid}{formula};
                       my $pattern = join('|',(sort (keys (%mathfns))));
                       $formula =~ s/($pattern)/\&$mathfns{$1}/g;
                       foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {
                           my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};
                           my $increment = '0.';
                           if ($decnum == 0) {
                               $increment = 1; 
                           } else {
                               my $deccount = $decnum;
                               while ($deccount > 1) {
                                   $increment.= '0';
                                   $deccount --;
                               }
                               $increment .= '1';
                           }
                           if ($cms eq 'webct4ce') { 
                               $formula =~ s/{($var)}/(\$$1)/g;
                           } elsif ($cms eq 'webctvista4') {
                               $formula =~ s/\[($var)\]/(\$$1)/g;
                           }
                           $scriptblock .= qq|
   \$$var=&random($$settings{$id}{$numid}{vars}{$var}{min},$$settings{$id}{$numid}{vars}{$var}{max},$increment);
   |;
                       }
                       $scriptblock .= qq|
   \$answervar = $formula;
   </script>
   |;
                       if ($context eq 'CSTR') {
                           $output = "<problem>\n".$scriptblock.$output;
                           my $ansformat = '';
                           my $sigfig = '0,15';
                           if ($$settings{$id}{$numid}{format} eq 'sig') {
                               $sigfig = $$settings{$id}{$numid}{digits}.','.$$settings{$id}{$numid}{digits};
                           } elsif ($$settings{$id}{$numid}{format} eq 'dec') {
                               $ansformat = $$settings{$id}{$numid}{digits}.'f';
                           }
                           if ($ansformat) {
                               $ansformat = 'format="'.$ansformat.'"';
                           }
                           my $tolerance = $$settings{$id}{$numid}{tolerance};
                           if (lc($$settings{$id}{$numid}{toltype}) eq 'percent') {
                               $tolerance .= '%';
                           }
                           my $unit = '';
                           foreach my $unitid (@{$$settings{$id}{$numid}{units}}) {
                               $unit .=  $$settings{$id}{$numid}{$unitid}{text};
                           }
                           my $unitentry = '';
                           if ($unit ne '') {
                               $unitentry =  'unit="'.$unit.'"';
                           }
                           $output .= qq|
   <numericalresponse $unitentry $ansformat  answer="\$answervar">
           <responseparam type="tolerance" default="$tolerance" name="tol" description="Numerical Tolerance" />
           <responseparam name="sig" type="int_range" default="$sigfig" description="Significant Figures"
   />
           <textline />
   </numericalresponse>
   |;
                       }
                   }
               }
           }
           if ($context eq 'CSTR') {
               my $catid = $$settings{$id}{category};
               my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
               $probdir =~ s/\s/_/g;
               $probdir =~ s/\W//g;
               if (!-e "$destdir/problems/$probdir") {
                   mkdir("$destdir/problems/$probdir",0755);
               }
               $output .= qq|</problem>
   |;
               my $title = $$settings{$id}{title};
               $title =~ s/\s/_/g;
               $title =~ s/\W//g;
               $title .= '_'.$id; 
               open(PROB,">:utf8", "$destdir/problems/$probdir/$title.problem");
               print PROB $output;
               close PROB;
           } else {
   # put %resourcedata;
               my $reply=&Apache::lonnet::cput
                   ('resourcedata',\%resourcedata,$cdom,$cnum);
           }
       }
   }
   
   sub text_cleanup {
       my ($text) = @_;
       $text =~ s/(\&)(nbsp|gt|lt)(?!;)/$1$2;$3/gi;
       $text = &Apache::loncleanup::htmlclean($text);
       $text =~ s#(<img src=["']?)([^>]+?)(/?>)#$1../../resfiles/$2 />#gi;
       $text =~ s#<([bh])r>#<$1r />#g;
       $text =~ s#<p>#<br /><br />#g;
       $text =~ s#</p>##g;
       return $text;
   }
   
   sub test_for_html {
       my ($source) = @_; 
       my @tags = ();
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname) = @_;
           push @tags, $tagname;
        }, "tagname"],
       );
       $p->parse($source);
       $p->eof;
       return length(@tags); 
   } 
   
   sub write_bb6_questions {
       my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
       my $qnum = 0;
       foreach my $id (@{$allids}) {
           my $questiontext = $$settings{$id}{question}{text};
           my $question_texttype = $$settings{$id}{question}{texttype};
           &process_html(\$questiontext,'bb6',$question_texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
           $qnum ++;
           my $output;
           my $permcontainer = $containerdir;
           $permcontainer =~ s#/home/httpd/html/userfiles#uploaded#;
           my $symb = $cid.'.'.$permcontainer.'___'.$qnum.'___lib/templates/simpleproblem.problem.0.';
           my %resourcedata = ();
           for (my $i=0; $i<10; $i++) {
               my $iter = $i+1;
               $resourcedata{$symb.'text'.$iter} = "";
               $resourcedata{$symb.'value'.$iter} = "unused";
               $resourcedata{$symb.'position'.$iter} = "random";
           }
           $resourcedata{$symb.'randomize'} = 'yes';
           $resourcedata{$symb.'maxfoils'} = 10;
           if ($context eq 'CSTR') {
               $output = qq|<problem>
   |;
           }
           $$total{prob} ++;
           $questiontext .= &add_images_links('question',$context,$settings,$id,$dirname,$res);
           if ($$settings{$id}{class} eq "Essay") {
               if ($context eq 'CSTR') {
                   $output .= qq|<startouttext />$questiontext<endouttext />
    <essayresponse>
    <textfield></textfield>
    </essayresponse>
   |;
                } else {
                    $resourcedata{$symb.'questiontext'} = $questiontext;
                    $resourcedata{$symb.'hiddenparts'} = '!essay';
                    $resourcedata{$symb.'questiontype'} = 'essay';
                }
           } else {
               if ($context eq 'CSTR') {
                   $output .= qq|<startouttext />$questiontext\n<endouttext />|;
               } else {
                   $resourcedata{$symb.'questiontext'} = $questiontext;
               }
               my $numfoils = @{$$settings{$id}{answers}};
               if (($$settings{$id}{class} eq 'Multiple Choice') || 
                   ($$settings{$id}{class} eq 'True/False')) {
                   if ($context eq 'CSTR') {
                       $output .= qq|
    <radiobuttonresponse max="$numfoils" randomize="yes">
     <foilgroup>
   |;
                   } else {
                       $resourcedata{$symb.'hiddenparts'} = '!radio';
                       $resourcedata{$symb.'questiontype'} = 'radio';
                       $resourcedata{$symb.'maxfoils'} = $numfoils;
                   }
                   for (my $k=0; $k<$numfoils; $k++) {
                       my $iter = $k+1;
                       my $answer_id = $$settings{$id}{answers}[$k];
                       my $answer_text = $$settings{$id}{$answer_id}{text};
                       my $texttype = $$settings{$id}{$answer_id}{texttype};
                       &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
                       $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res); 
                       $output .= "   <foil name=\"foil".$k."\" value=\"";
                       if (grep/^$answer_id$/,@{$$settings{$id}{correctanswer}}) {
                           $output .= "true\" location=\"";
                           $resourcedata{$symb.'value'.$iter} = "true";
                       } else {
                           $output .= "false\" location=\"";
                           $resourcedata{$symb.'value'.$iter} = "false";
                       }
                       if (lc ($$settings{$id}{$answer_id}{text}) =~ m/^\s?([Aa]ll)|([Nn]one)\s(of\s)?the\sabove\.?/) {
                           $output .= "bottom\"";
                           $resourcedata{$symb.'position'.$iter} = "bottom";
                       } else {
                           $output .= "random\"";
                       }
                       $output .= '\><startouttext />'.$answer_text.
                                  '<endouttext /></foil>'."\n";
                       $resourcedata{$symb.'text'.$iter} = $answer_text;
                   }
                   if ($context eq 'CSTR') {
                       chomp($output);
                       $output .= qq|
       </foilgroup>
       <hintgroup showoncorrect="no">
        <radiobuttonhint>
        </radiobuttonhint>
        <hintpart on="default">
         <startouttext/><endouttext />
        </hintpart>
       </hintgroup>
      </radiobuttonresponse>
   |;
                   }
               } elsif ($$settings{$id}{class} eq 'Multiple Answer') {
                   if ($context eq 'CSTR') {
                       $output .= qq|
      <optionresponse max="$numfoils" randomize="yes">
       <foilgroup options="('True','False')">
   |;
                   } else {
                       $resourcedata{$symb.'newopt'} = '';
                       $resourcedata{$symb.'delopt'} = '';
                       $resourcedata{$symb.'options'} = "('True','False')";
                       $resourcedata{$symb.'hiddenparts'} = '!option';
                       $resourcedata{$symb.'questiontype'} = 'option';
                       $resourcedata{$symb.'maxfoils'} = $numfoils;
                   }
                   for (my $k=0; $k<$numfoils; $k++) {
                       my $iter = $k+1;
                       my $answer_id = $$settings{$id}{answers}[$k];
                       my $answer_text = $$settings{$id}{$answer_id}{text};
                       my $texttype = $$settings{$id}{$answer_id}{texttype};
                       &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
                       $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
   
                       $output .= "   <foil name=\"foil".$k."\" value=\"";
                       if (grep/^$answer_id$/,@{$$settings{$id}{correctanswer}}) {
                           $output .= "True\"";
                           $resourcedata{$symb.'value'.$iter} = "True";
                     } else {                      } else {
                         my @answertext = ();                          $output .= "False\"";
                         for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                          $resourcedata{$symb.'value'.$iter} = "False";
                             $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;                      }
                             push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};                      $output .= "\><startouttext />".$answer_text."<endouttext /></foil>\n";
                       $resourcedata{$symb.'text'.$iter} = $answer_text;
                   }
                   if ($context eq 'CSTR') {
                       chomp($output);
                       $output .= qq|
       </foilgroup>
       <hintgroup showoncorrect="no">
        <optionhint>
        </optionhint>
        <hintpart on="default">
         <startouttext/><endouttext />
        </hintpart>
       </hintgroup>
      </optionresponse>
   |;
                   }
               } elsif ($$settings{$id}{class} eq 'Ordering') {
                   my @allorder = ();
                   if ($context eq 'CSTR') {
                       $output .= qq|
      <rankresponse max="$numfoils" randomize="yes">
       <foilgroup>
   |;
                   } else {
                       $resourcedata{$symb.'newopt'} = '';
                       $resourcedata{$symb.'delopt'} = '';
                       $resourcedata{$symb.'hiddenparts'} = '!option';
                       $resourcedata{$symb.'questiontype'} = 'option';
                       $resourcedata{$symb.'maxfoils'} = $numfoils;
                   }
                   for (my $k=0; $k<$numfoils; $k++) {
                       my $answer_id = $$settings{$id}{answers}[$k];
                       my $answer_text = $$settings{$id}{$answer_id}{text};
                       my $texttype = $$settings{$id}{$answer_id}{texttype};
                       &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
                       $answer_text .= &add_images_links('response',$context,$settings,$id,$dirname,$res);
                       my $iter = $k+1;
                       if ($context eq 'CSTR') {
                           $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$answer_id}{order}."\"><startouttext />".$answer_text."<endouttext /></foil>\n";
                       } else {
                           $resourcedata{$symb.'text'.$iter} = $answer_text;
                           $resourcedata{$symb.'value'.$iter} = $$settings{$id}{$answer_id}{order};
                           if (!grep/^$$settings{$id}{$answer_id}{order}$/,@allorder) {
                               push(@allorder,$$settings{$id}{$answer_id}{order}); 
                         }                          }
                         my $regexpans = join('|',@answertext);                      }
                         $regexpans = '/^('.$regexpans.')\b/';                  }
                   if ($context eq 'CSTR') {
                       chomp($output);
                       $output .= qq|
       </foilgroup>
      </rankresponse>
   |;
                   } else {
                       @allorder = sort {$a <=> $b} @allorder;
                       $resourcedata{$symb.'options'} = "('".join("','",@allorder)."')";
                   }
               } elsif ($$settings{$id}{class} eq 'Fill in the Blank') {
                   my $numerical = 1;
                   if ($context eq 'DOCS') {
                       $numerical = 0;
                   } else {
                       for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
                           if ($$settings{$id}{correctanswer}[$k] =~ m/([^\d\.]|\.\.)/) {
                               $numerical = 0;
                           }
                       }
                   }
                   if ($numerical) {
                       my $numans;
                       my $tol;
                       if (@{$$settings{$id}{correctanswer}} == 1) {
                           $tol = 5;
                           $numans = $$settings{$id}{correctanswer}[0];
                       } else {
                           my $min = $$settings{$id}{correctanswer}[0];;
                           my $max = $min;
                           for (my $k=1; $k<@{$$settings{$id}{correctanswer}}; $k++) {
                               if ($$settings{$id}{correctanswer}[$k] <= $min) {
                                   $min = $$settings{$id}{correctanswer}[$k];
                               }
                               if ($$settings{$id}{correctanswer}[$k] >= $max) {
                                   $max = $$settings{$id}{correctanswer}[$k];
                               }
                           }
                           $numans = ($max + $min)/2;
                           $tol = 100*($max - $min)/($numans*2);
                           $tol = 5;
                       }
                       if ($context eq 'CSTR') {
                         $output .= qq|                          $output .= qq|
   <numericalresponse answer="$numans">
           <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
           <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
   />
           <textline />
   </numericalresponse>
   <hintgroup showoncorrect="no">
    <numericalhint>
    </numericalhint>
    <hintpart on="default">
       <startouttext/><endouttext />
    </hintpart>
   </hintgroup>
   |;
                       }
                   } else {
                       if ($context eq 'DOCS') {
                           $resourcedata{$symb.'hiddenparts'} = '!string';
                           $resourcedata{$symb.'questiontype'} = 'string';
                           $resourcedata{$symb.'maxfoils'} = 1;
                           $resourcedata{$symb.'hiddenparts'} = '!string';
                           $resourcedata{$symb.'stringtype'} = 'ci';
                           $resourcedata{$symb.'stringanswer'} = $$settings{$id}{correctanswer}[0];
                       } else {
                           if (@{$$settings{$id}{correctanswer}} == 1) {
                               $output .= qq|
   <stringresponse answer="$$settings{$id}{correctanswer}[0];" type="ci">
   <textline>
   </textline>
   </stringresponse>
   <hintgroup showoncorrect="no">
   <stringhint type="cs">
   </stringhint>
   <hintpart on="default">
     <startouttext/><endouttext />
   </hintpart>
   </hintgroup>
   |;
                           } else {
                               my @answertext = ();
                               for (my $k=0; $k<@{$$settings{$id}{correctanswer}}; $k++) {
                                   my $answer_text = $$settings{$id}{correctanswer}[$k];
                                   $answer_text =~ s/\|/\|/g;
                                   push @answertext, $answer_text;
                               }
                               my $regexpans = join('|',@answertext);
                               $regexpans = '/^('.$regexpans.')\b/';
                               $output .= qq|
 <stringresponse answer="$regexpans" type="re">  <stringresponse answer="$regexpans" type="re">
 <textline>  <textline>
 </textline>  </textline>
 </stringresponse>  </stringresponse>
   <hintgroup showoncorrect="no">
    <stringhint type="cs">
    </stringhint>
    <hintpart on="default">
       <startouttext/><endouttext />
    </hintpart>
   </hintgroup>
 |;  |;
                           }
                     }                      }
                 }                  }
             } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {              } elsif ($$settings{$id}{class} eq "Matching") {
                 $output .= qq|                  my @allmatchers = ();
                   my %matchtext = ();
                   if ($context eq 'CSTR') {
                       $output .= qq|
 <matchresponse max="10" randomize="yes">  <matchresponse max="10" randomize="yes">
     <foilgroup>      <foilgroup>
         <itemgroup>          <itemgroup>
 |;  |;
                 for (my $k=0; $k<@{$allchoices{$id}}; $k++) {                  } else {
                     $output .= qq|                      $resourcedata{$symb.'newopt'} = '';
 <item name="$allchoices{$id}[$k]">                      $resourcedata{$symb.'delopt'} = '';
 <startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />                      $resourcedata{$symb.'hiddenparts'} = '!option';
                       $resourcedata{$symb.'questiontype'} = 'option';
                       $resourcedata{$symb.'maxfoils'} =  $numfoils;
                   }
                   for (my $k=0; $k<$$settings{$id}{allchoices}; $k++) {
                       my $choice_id = 'rightmatch'.$k;
                       my $choice_text = $$settings{$id}{$choice_id}{text};
                       my $texttype = $$settings{$id}{$choice_id}{texttype};
                       my $choice_plaintext = &remove_html($choice_text);
                       &process_html(\$choice_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
                       $choice_text .= &add_images_links($choice_id,$context,$settings,$id,$dirname,$res);
                       push(@allmatchers,$choice_plaintext);
                       if ($context eq 'CSTR') {
                           $output .= qq|
   <item name="$choice_id">
   <startouttext />$choice_text<endouttext />
 </item>  </item>
                     |;                      |;
                       }
                 }                  }
                 $output .= qq|                  if ($context eq 'CSTR') {
                       $output .= qq|
         </itemgroup>          </itemgroup>
 |;  |;
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  }
                     $output .= qq|                  for (my $k=0; $k<$numfoils; $k++) {
         <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">                      my $answer_id = $$settings{$id}{answers}[$k];
          <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />                      my $answer_text = $$settings{$id}{$answer_id}{text};
                       my $texttype = $$settings{$id}{$answer_id}{texttype};
                       &process_html(\$answer_text,'bb6',$texttype,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir);
                       $answer_text .= &add_images_links($answer_id,$context,$settings,$id,$dirname,$res);
                       if ($context eq 'CSTR') {
                           $output .= '
           <foil location="random" value="rightmatch'.$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}.'" name="'.$answer_id.'">
            <startouttext />'.$answer_text.'<endouttext />
         </foil>          </foil>
 |;  ';
                       } else {
                           my $iter = $k+1;
                           $resourcedata{$symb.'value'.$iter} = "$allmatchers[$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}]";
                           $resourcedata{$symb.'text'.$iter} = $answer_text;
                       }
                 }                  }
                 $output .= qq|                  if ($context eq 'CSTR') {
                       $output .= qq|
     </foilgroup>      </foilgroup>
 </matchresponse>  </matchresponse>
 |;  |;
                   } else {
                       $resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
                   }
             }              }
         }          }
         $output .= qq|</problem>          if ($context eq 'CSTR') {
               
               $output .= qq|
    <postanswerdate>
     $$settings{$id}{solutionfeedback}{text}
    </postanswerdate>
   </problem>
 |;  |;
         open(PROB,">$newdir/$id.problem");              my $title = $$settings{title};
         print PROB $output;              $title =~ s/\s/_/g;
         close PROB;              $title =~ s/\W//g;
               $title .= '_'.$id;
               open(PROB,">:utf8", "$newdir/$title.problem");
               print PROB $output;
               close PROB;
           } else {
   # put %resourcedata;
               my $reply=&Apache::lonnet::cput
                   ('resourcedata',\%resourcedata,$cdom,$cnum);
           }
       }
   }
   
   sub retrieve_image {
       my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
       my $contents;
       my $url = $urlpath.$filename;
       my $ua=new LWP::UserAgent;
       my $request=new HTTP::Request('GET',$url);
       my $response=$ua->request($request);
       if ($response->is_success) { 
           $contents = $response->content;
           if (!-e "$docroot/$res") {
               mkdir("$docroot/$res",0755);
           }
           if (!-e "$docroot/$res/webimages") {
               mkdir("$docroot/$res/webimages",0755);
           }
           open(my $fh,">$docroot/$res/webimages/$filename");
           print $fh $contents;
           close($fh);
           if ($context eq 'DOCS') {
               my $copyfile = $dirname.'/'.$filename;
               my $source = "$docroot/$res/webimages/$filename";
               my $fileresult;
               if (-e $source) {
                   $fileresult = &Apache::lonnet::process_coursefile('copy',$cname,$cdom,$copyfile,$source);
               }
               return $fileresult;
           } elsif ($context eq 'CSTR') {
               if (!-e "$destdir/resfiles/$res") {
                   mkdir("$destdir/resfiles/$res",0755);
               }
               if (!-e "$destdir/resfiles/$res/webimages") {
                   mkdir("$destdir/resfiles/$res/webimages",0755);
               }
               rename("$docroot/$res/webimages/$filename","$destdir/resfiles/$res/webimages/$filename");
               return 'ok';
           }
       } else {
           return -1;
     }      }
 }  }
   
Line 1859  sub process_announce { Line 4745  sub process_announce {
         if ("@state" eq "ANNOUNCEMENT TITLE") {          if ("@state" eq "ANNOUNCEMENT TITLE") {
             $$settings{title} = $attr->{value};              $$settings{title} = $attr->{value};
             $$settings{startassessment} = ();              $$settings{startassessment} = ();
         } elsif (@state eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {            } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {  
             $$settings{ishtml} = $attr->{value};                        $$settings{ishtml} = $attr->{value};          
         } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {          } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
             $$settings{isnewline} = $attr->{value};              $$settings{isnewline} = $attr->{value};
Line 1932  $$settings{text} Line 4818  $$settings{text}
   
 # ---------------------------------------------------------------- Process Blackboard Content  # ---------------------------------------------------------------- Process Blackboard Content
 sub process_content {  sub process_content {
     my ($res,$docroot,$destdir,$settings,$dom,$user,$resrcfiles) = @_;      my ($cms,$res,$context,$docroot,$destdir,$settings,$dom,$user,$resrcfiles,$packages,$hrefs) = @_;
     my $xmlfile = $docroot.'/'.$res.".dat";      my $xmlfile = $docroot.'/'.$res.".dat";
     my $destresdir = $destdir;      my $destresdir = $destdir;
     $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;      if ($context eq 'CSTR') {
           $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
       } elsif ($context eq 'DOCS') {
           $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
       }
       my $filetag = '';
       if ($cms eq 'bb5') {
           $filetag = 'FILEREF';
       } elsif ($cms eq 'bb6') {
           $filetag = 'FILE';
       }
     my $filecount = 0;      my $filecount = 0;
     my @allrelfiles = ();      my @allrelfiles = ();
     my @state;      my @state;
Line 1947  sub process_content { Line 4843  sub process_content {
       [sub {        [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          push @state, $tagname;
         if (@state eq "CONTENT MAINDATA") {          if ("@state" eq "CONTENT ") {
             %{$$settings{maindata}} = ();              %{$$settings{maindata}} = ();
         } elsif (@state eq "CONTENT MAINDATA TEXTCOLOR") {          } elsif ("@state" eq "CONTENT TITLECOLOR") {
               $$settings{titlecolor} =  $attr->{value};
           } elsif ("@state" eq "CONTENT MAINDATA TEXTCOLOR") {
             $$settings{maindata}{color} = $attr->{value};              $$settings{maindata}{color} = $attr->{value};
         } elsif (@state eq "CONTENT MAINDATA FLAGS ISHTML") {            } elsif ("@state" eq "CONTENT MAINDATA FLAGS ISHTML") {  
             $$settings{maindata}{ishtml} = $attr->{value};               $$settings{maindata}{ishtml} = $attr->{value}; 
         } elsif (@state eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {            } elsif ("@state" eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {  
             $$settings{maindata}{isnewline} = $attr->{value};              $$settings{maindata}{isnewline} = $attr->{value};
           } elsif ("@state" eq "CONTENT BODY TYPE") {
               $$settings{maindata}{bodytype} =  $attr->{value};
         } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {          } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
             $$settings{isavailable} = $attr->{value};              $$settings{isavailable} = $attr->{value};
         } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {          } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
             $$settings{isfolder} = $attr->{value};              $$settings{isfolder} = $attr->{value};
         } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {          } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
             $$settings{newwindow} = $attr->{value};              $$settings{newwindow} = $attr->{value};
         } elsif ("@state" eq "CONTENT FILES FILEREF") {          } elsif ("@state" eq "CONTENT FILES $filetag") {
             %{$$settings{files}[$filecount]} = ();              %{$$settings{files}[$filecount]} = ();
             %{$$settings{files}[$filecount]{registry}} = ();               %{$$settings{files}[$filecount]{registry}} = (); 
         } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {          } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
             $$settings{files}[$filecount]{'relfile'} = $attr->{value};              $$settings{files}[$filecount]{'relfile'} = $attr->{value};
             push @allrelfiles, $attr->{value};              push @allrelfiles, $attr->{value};
         } elsif ("@state" eq "CONTENT FILES FILEREF MIMETYPE") {          } elsif ("@state" eq "CONTENT FILES $filetag MIMETYPE") {
             $$settings{files}[$filecount]{mimetype} = $attr->{value};              $$settings{files}[$filecount]{mimetype} = $attr->{value};
         } elsif ("@state" eq "CONTENT FILES FILEREF CONTENTTYPE") {          } elsif ("@state" eq "CONTENT FILES $filetag CONTENTTYPE") {
             $$settings{files}[$filecount]{contenttype} = $attr->{value};              $$settings{files}[$filecount]{contenttype} = $attr->{value};
         } elsif ("@state" eq "CONTENT FILES FILEREF FILEACTION") {          } elsif ("@state" eq "CONTENT FILES $filetag FILEACTION") {
             $$settings{files}[$filecount]{fileaction} = $attr->{value};              $$settings{files}[$filecount]{fileaction} = $attr->{value};
         } elsif ("@state" eq "CONTENT FILES FILEREF PACKAGEPARENT") {          } elsif ("@state" eq "CONTENT FILES $filetag PACKAGEPARENT") {
             $$settings{files}[$filecount]{packageparent} = $attr->{value};              $$settings{files}[$filecount]{packageparent} = $attr->{value};
         } elsif ("@state" eq "CONTENT FILES FILEREF LINKNAME") {          } elsif ("@state" eq "CONTENT FILES $filetag LINKNAME") {
             $$settings{files}[$filecount]{linkname} = $attr->{value};              $$settings{files}[$filecount]{linkname} = $attr->{value};
         } elsif ("@state" eq "CONTENT FILES FILEREF REGISTRY REGISTRYENTRY") {          } elsif ("@state" eq "CONTENT FILES $filetag REGISTRY REGISTRYENTRY") {
             my $key = $attr->{key};              my $key = $attr->{key};
             $$settings{files}[$filecount]{registry}{$key} = $attr->{value};              $$settings{files}[$filecount]{registry}{$key} = $attr->{value};
         }          }
Line 1987  sub process_content { Line 4887  sub process_content {
         my ($text) = @_;          my ($text) = @_;
         if ("@state" eq "CONTENT TITLE") {          if ("@state" eq "CONTENT TITLE") {
             $$settings{title} = $text;              $$settings{title} = $text;
         } elsif ("@state" eq "CONTENT MAINDATA TEXT") {          } elsif ( ("@state" eq "CONTENT MAINDATA TEXT") || ("@state" eq "CONTENT BODY TEXT") ) {
             $$settings{maindata}{text} = $text;              $$settings{maindata}{text} = $text;
         }  elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") {          }  elsif ("@state" eq "CONTENT FILES $filetag REFTEXT") {
             $$settings{files}[$filecount]{reftext} = $text;              $$settings{files}[$filecount]{reftext} = $text;
           } elsif ("@state" eq "CONTENT FILES FILE NAME" ) {
               $$settings{files}[$filecount]{'relfile'} = $text;
               push @allrelfiles, $text;
         }          }
        }, "dtext"],         }, "dtext"],
       end_h =>        end_h =>
       [sub {        [sub {
         my ($tagname) = @_;          my ($tagname) = @_;
         if ("@state" eq "CONTENT FILES FILEREF") {          if ("@state" eq "CONTENT FILES $filetag") {
             $filecount ++;              $filecount ++;
         }          }
         pop @state;          pop @state;
Line 2042  sub process_content { Line 4945  sub process_content {
                     }                      }
                 } else {                  } else {
                     my $filename=$$settings{files}[$filecount]{'relfile'};                      my $filename=$$settings{files}[$filecount]{'relfile'};
 #                  print "File is $filename\n";  
                     my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";                      my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
 #                  print "New filename is $newfilename\n";                      $$settings{maindata}{text} =~ s#(src|SRC|value)=("|&quot;)$filename("|&quot;)#$1="$newfilename"#g;
                     $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g;  
                 }                  }
             } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {              } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
                 unless (($$settings{files}[$filecount]{packageparent} ne '') && (grep/^$$settings{files}[$filecount]{packageparent}$/,@{$$settings{files}}) ) {                  unless (($$settings{files}[$filecount]{packageparent} ne '') && (grep/^$$settings{files}[$filecount]{packageparent}$/,@{$$settings{files}}) ) {
Line 2058  sub process_content { Line 4959  sub process_content {
                     }                      }
                       $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;                        $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;
                 }                  }
             } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') {              } elsif ( ($$settings{files}[$filecount]{fileaction} eq 'PACKAGE') || ($$settings{files}[$filecount]{fileaction} eq 'package') ) {
 #              print "Found a package\n";                 my $open_package = '';
                  if ($$settings{files}[$filecount]{'relfile'} =~ m|\.zip$|i) {
                      $open_package = &expand_zip("$docroot/$res",$$settings{files}[$filecount]{'relfile'});
                  }
                  if ($open_package eq 'ok') {
                      opendir(DIR,"$docroot/$res");
                      my @dircontents = grep(!/^\./,readdir(DIR));
                      closedir(DIR);
                      push @{$resrcfiles}, @dircontents;
                      @{$$hrefs{$res}} = @dircontents;
                      push @{$packages}, $res;
                  }
               } elsif ( ($$settings{files}[$filecount]{fileaction} eq 'BROKEN_IMAGE') && ($cms eq 'bb6') ) {
                   my $filename=$$settings{files}[$filecount]{'relfile'};
                   my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
                   $$settings{maindata}{text} =~ s#(src|SRC|value)=("|&quot;)$filename("|&quot;)#$1="$newfilename"#g;
               } elsif ( ($$settings{files}[$filecount]{fileaction} eq 'LINK') && ($cms eq 'bb6') ) {
                   my $filename=$$settings{files}[$filecount]{'relfile'};
                   my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
                   my $filetitle = $$settings{files}[$filecount]{'linkname'};
                   $$settings{maindata}{text} = '<a href="'.$newfilename.'">'.$filetitle.'</a><br /><br />'. $$settings{maindata}{text};
             }              }
         }          }
     }      }
Line 2067  sub process_content { Line 4988  sub process_content {
         $fontcol =  qq|<font color="$$settings{maindata}{textcolor}">|;          $fontcol =  qq|<font color="$$settings{maindata}{textcolor}">|;
     }      }
     if (defined($$settings{maindata}{text})) {      if (defined($$settings{maindata}{text})) {
           if ($$settings{maindata}{bodytype} eq "S") {
               $$settings{maindata}{text} =~ s#\n#<br/>#g;
           }
         if ($$settings{maindata}{ishtml} eq "false") {          if ($$settings{maindata}{ishtml} eq "false") {
             if ($$settings{maindata}{isnewline} eq "true") {              if ($$settings{maindata}{isnewline} eq "true") {
                 $$settings{maindata}{text} =~ s#\n#<br/>#g;                  $$settings{maindata}{text} =~ s#\n#<br/>#g;
             }              }
         } else {          } else {
             $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});  #            $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
         }          }
     }      }
   
     open(FILE,">$destdir/resfiles/$res.html");      if (!open(FILE,">$destdir/resfiles/$res.html")) {
     push @{$resrcfiles}, "$res.html";          &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
     print FILE qq|<html>      } else {
           push @{$resrcfiles}, "$res.html";
           my $htmldoc = 0;
   #        if ($$settings{maindata}{text} =~ m-&lt;(html|HTML)>.+&lt;\\(html|HTML)-) {
           if ($$settings{maindata}{text} =~ m-<(html|HTML)>-) {
               $htmldoc = 1;
           }
           unless ($htmldoc) {
               print FILE qq|<html>
 <head>  <head>
 <title>$$settings{title}</title>  <title>$$settings{title}</title>
 </head>  </head>
 <body bgcolor='#ffffff'>  <body bgcolor='#ffffff'>
 $fontcol  $fontcol
 |;  |;
     unless ($$settings{title} eq '') {           }
         print FILE qq|$$settings{title}<br/><br/>\n|;          unless ($$settings{title} eq '') { 
     }              print FILE qq|$$settings{title}<br/><br/>\n|;
     print FILE qq|          }
           print FILE qq|
 $$settings{maindata}{text}  $$settings{maindata}{text}
 $linktag|;  $linktag|;
     if (defined($$settings{maindata}{textcolor})) {          unless ($htmldoc) {
         print FILE qq|</font>|;              if (defined($$settings{maindata}{textcolor})) {
     }                  print FILE qq|</font>|;
     print FILE qq|              }
               print FILE qq|
   </body>    </body>
  </html>|;   </html>|;
     close(FILE);          }
           close(FILE);
       }
 }  }
   
   
Line 2142  sub process_angelboards { Line 5078  sub process_angelboards {
         my $msgcount = 0;           my $msgcount = 0; 
                                                                                                                                                                                                             
         my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);          my $putresult = &Apache::lonnet::put($boardname,\%boardinfo,$cdom,$crs);
 #        print STDERR "putresult is $putresult for $boardname $cdom $crs\n";  
         if ($db_handling eq 'importall') {          if ($db_handling eq 'importall') {
             foreach my $msg_id (@{$$messages{$$boards[$i]}}) {              foreach my $msg_id (@{$$messages{$$boards[$i]}}) {
                 $msgcount ++;                  $msgcount ++;
Line 2307  sub angel_content { Line 5242  sub angel_content {
     close(FILE);      close(FILE);
 }  }
   
   # ---------------------------------------------------------------- WebCT content
   sub webct4_content {
       my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
       if (!open(FILE,">$destdir/resfiles/$res.html")) {
           &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
       } else {
           push(@{$resrcfiles}, "$res.html");
           my $linktag = '';
           if (defined($$settings{url})) {
               $linktag = qq|<a href="$$settings{url}"|;
               if ($title ne '') {
                   $linktag .= qq|>$title</a>|;
               } else {
                   $linktag .= qq|>$$settings{url}|;
               }
           }
           print FILE qq|<html>
   <head>
   <title>$title</title>
   </head>
   <body bgcolor='#ffffff'>
   $linktag
   </body>
   </html>|;
           close(FILE);
       }
   }
   
   sub process_html {
       my ($text,$caller,$html_cond,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir) = @_;
       my $pathstart;
       if ($context eq 'CSTR') {
           $pathstart = '../..';
       } else {
           $pathstart = $dirname;
       }
       if ($caller eq 'bb5') {
           if ($html_cond eq 'true') {
               $$text = &HTML::Entities::decode($$text);
           }
       } elsif ($caller eq 'bb6') {
           if ($html_cond eq 'HTML') {
               $$text = &HTML::Entities::decode($$text);
           }
       }
       if ($$text =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
           if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
               $$text =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1$pathstart/resfiles/$res/webimages/$3$4#g;
           }
       }
       $$text =~ s#(<img src=[^>]+)/*>#$1 />#gi;
       $$text =~ s#<br>#<br />#g;
       return;
   }
   
   sub add_images_links {
       my ($type,$context,$settings,$id,$dirname,$res) = @_;
       my ($image,$imglink,$url,$pathstart);
       if ($context eq 'CSTR') {
           $pathstart = '../..';
       } else {
           $pathstart = $dirname;
       }
       if ((defined($$settings{$id}{$type}{image})) && ($$settings{$id}{$type}{image} ne '')) {
           if ( $$settings{$id}{$type}{style} eq 'Inline' ) {
               $image = qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{$type}{image}" alt="$$settings{$id}{$type}{label}"/><br />|;
           } else {
               $imglink = qq|<br /><a href="$pathstart/resfiles/$res/$$settings{$id}{$type}{image}">$$settings{$id}{$type}{label}</a><br />|;
           }
       }
       if ((defined($$settings{$id}{$type}{link})) && ($$settings{$id}{$type}{link} ne '' )) {
           $url = qq|<br /><a href="$$settings{$id}{$type}{link}">$$settings{$id}{$type}{linkname}</a><br />|;
       }
       return $image.$imglink.$url; 
   }
   
   sub remove_html {
       my ($choice_text) = @_;
       return $choice_text;
   }
   
   
 1;  1;
 __END__  __END__
Removed from v.1.4  
changed lines
  Added in v.1.38

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.