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

Diff for /loncom/imspackages/imsprocessor.pm between versions 1.15 and 1.46

version 1.15, 2005/02/21 23:47:46 version 1.46, 2009/04/23 17:33:50
Line 1 Line 1
   # The LearningOnline Network with CAPA
   # Processor for IMS Packages
   #
   # $Id$
   #
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
 # This file is part of the LearningOnline Network with CAPA (LON-CAPA).  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
Line 24 Line 29
 package Apache::imsprocessor;  package Apache::imsprocessor;
   
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncleanup;
   use Apache::lonlocal;
   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 41  sub ims_config { Line 50  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}} =  %{$$cmsmap{bb5}};      %{$$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{bb6}{conference} = 'resource/x-bb-conference';
     %{$$cmsmap{angel}} =  (      %{$$cmsmap{angel}} =  (
                 board => 'BOARD',                  board => 'BOARD',
Line 51  sub ims_config { Line 70  sub ims_config {
                 survey => 'FORM',                  survey => 'FORM',
                 );                  );
     @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');      @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
     %{$$cmsmap{webct4}} = (      %{$$cmsmap{webctce4}} = (
                 quiz => 'webctquiz',                  quiz => 'webctquiz',
                 survey => 'webctsurvey',                  survey => 'webctsurvey',
                 doc => 'webcontent'                  doc => 'webcontent'
                 );                  );
     %{$areaname} = (      %{$$cmsmap{webctvista4}} = (
                   question => 'webct.question',
                   quiz => 'webct.assessment',
                   survey => 'webctsurvey',
                   doc => 'webcontent'
                   );
       %{$areaname} = &Apache::lonlocal::texthash (
                 announce => 'Announcements',                  announce => 'Announcements',
                 board => 'Discussion Boards',                  board => 'Discussion Boards',
                 doc => 'Documents, pages, and folders',                  doc => 'Documents, pages, and folders',
                 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',
Line 95  sub uploadzip { Line 121  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 107  sub uploadzip { Line 133  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 128  sub expand_zip { Line 154  sub expand_zip {
         return 'no zip';          return 'no zip';
     }      }
     if ($filename =~ m|\.zip$|i) {      if ($filename =~ m|\.zip$|i) {
     # unzip can cause an sh launch which can pass along all of %ENV  
     # which can be too large for /bin/sh to handle  
         my %oldENV=%ENV;  
         undef(%ENV);  
         open(OUTPUT, "unzip -o $zipfile -d $tempdir  2> /dev/null |");          open(OUTPUT, "unzip -o $zipfile -d $tempdir  2> /dev/null |");
         close(OUTPUT);          close(OUTPUT);
         %ENV=%oldENV;  
         undef(%oldENV);  
     } else {      } else {
         return 'nozip';          return 'nozip';
     }      }
Line 151  sub process_manifest { Line 171  sub process_manifest {
               bb6 => 'organization',                bb6 => 'organization',
               bb5 => 'tableofcontents',                bb5 => 'tableofcontents',
               angel => 'organization',                angel => 'organization',
               webct4 => '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 177  sub process_manifest { Line 193  sub process_manifest {
   
     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 187  sub process_manifest { Line 217  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) {  
                     $statestr .= "$_ ";  
                 }  
                 if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {  
                     my $searchstr = "manifest organizations $toc{$cms}";  
                     while ($num > 0) {  
                         $searchstr .= " item";  
                         $num --;   
                     }  
                     if (("@state" eq $searchstr) && (@state > 3)) {  
                         $itm = $attr->{identifier};                          $itm = $attr->{identifier};
                         if ($$includeditems{$itm} || $phase ne 'build') {                                        if ($$includeditems{$itm} || $phase ne 'build') {
                             %{$$items{$itm}} = ();                              %{$$items{$itm}} = ();
                             $$items{$itm}{contentscount} = 0;                              $$items{$itm}{contentscount} = 0;
                             if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {                              @{$$items{$itm}{contents}} = ();
                               if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webctce4' || $cms eq 'webctvista4') {
                                 $$items{$itm}{resnum} = $attr->{identifierref};                                  $$items{$itm}{resnum} = $attr->{identifierref};
                                 if ($cms eq 'bb5') {                                  if ($cms eq 'bb5') {
                                     $$items{$itm}{title} = $attr->{title};                                      $$items{$itm}{title} = $attr->{title};
Line 218  sub process_manifest { Line 239  sub process_manifest {
                                 %{$$resources{$$items{$itm}{resnum}}} = ();                                  %{$$resources{$$items{$itm}{resnum}}} = ();
                             }                              }
                             $$resources{$$items{$itm}{resnum}}{revitm} = $itm;                              $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
                             if ($start > @seq) {                              if ($start > @{$seq}) {
                                 unless ($lastitem eq '') {                                  unless ($lastitem eq '') {
                                     push @seq, $lastitem;                                      push @{$seq}, $lastitem;
                                     unless ( defined($contents{$seq[-1]}) ) {                                      unless ( defined($contents{$$seq[-1]}) ) {
                                         @{$contents{$seq[-1]}} = ();                                          @{$contents{$$seq[-1]}} = ();
                                     }                                      }
                                     push @{$contents{$seq[-1]}},$itm;                                      push @{$contents{$$seq[-1]}},$itm;
                                     $$items{$itm}{parentseq} = $seq[-1];                                      $$items{$itm}{parentseq} = $$seq[-1];
                                 }                                  }
                             } elsif ($start < @seq) {                              } elsif ($start < @{$seq}) {
                                 my $diff = @seq - $start;                                  my $diff = @{$seq} - $start;
                                 while ($diff > 0) {                                  while ($diff > 0) {
                                     pop @seq;                                      pop @{$seq};
                                     $diff --;                                      $diff --;
                                 }                                  }
                                 if (@seq) {                                  if (@{$seq}) {
                                     push @{$contents{$seq[-1]}}, $itm;                                      push @{$contents{$$seq[-1]}}, $itm;
                                 }                                  }
                             } else {                              } else {
                                 push @{$contents{$seq[-1]}}, $itm;                                  push @{$contents{$$seq[-1]}}, $itm;
                             }                              }
                             my $path;                              my $path;
                             if (@seq > 1) {                              if (@{$seq} > 1) {
                                 $path = join(',',@seq);                                  $path = join(',',@{$seq});
                             } elsif (@seq > 0) {                              } elsif (@{$seq} > 0) {
                                 $path = $seq[0];                                  $path = $$seq[0];
                             }                              }
                             $$items{$itm}{filepath} = $path;                              $$items{$itm}{filepath} = $path;
                             if ($cms eq 'bb5' || $cms eq 'bb6') {                              if ($cms eq 'bb5' || $cms eq 'bb6') {
Line 254  sub process_manifest { Line 275  sub process_manifest {
                                     $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';                                      $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
                                 }                                  }
                             }                              }
                             $$items{$seq[-1]}{contentscount} ++;                              $$items{$$seq[-1]}{contentscount} ++;
                               $$resources{$$items{$itm}{resnum}}{seqref} = $seq;
                             $lastitem = $itm;                              $lastitem = $itm;
                         }                          }
                     }                      }
                       if ($cms eq 'webctce4') {
                           if (($state[-1] eq "webct:properties") && (@state > 4)) {
                               $$items{$itm}{properties} = $attr->{identifierref};
                           }
                       }
                 } elsif ("@state" eq "manifest resources resource" ) {                  } elsif ("@state" eq "manifest resources resource" ) {
                     $identifier = $attr->{identifier};                      $identifier = $attr->{identifier};
                       push(@allidentifiers,$identifier);
                     if ($$includedres{$identifier} || $phase ne 'build') {                       if ($$includedres{$identifier} || $phase ne 'build') { 
                         if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {                          if ($cms eq 'bb5' || $cms eq 'bb6') {
                             $$resources{$identifier}{file} = $attr->{file};                              $$resources{$identifier}{file} = $attr->{file};
                             $$resources{$identifier}{type} = $attr->{type};                              $$resources{$identifier}{type} = $attr->{type};
                           } elsif ($cms eq 'webctce4') {
                               $$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') {                          } elsif ($cms eq 'angel') {
                             $identifier = substr($identifier,3);                              $identifier = substr($identifier,3);
                             if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {                              if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
Line 274  sub process_manifest { Line 308  sub process_manifest {
                     }                      }
                 } elsif ("@state" eq "manifest resources resource file") {                  } elsif ("@state" eq "manifest resources resource file") {
                     if ($$includedres{$identifier} || $phase ne 'build') {                      if ($$includedres{$identifier} || $phase ne 'build') {
                         if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {                          if ($cms eq 'webctvista4') {
                               $$resources{$identifier}{file} = $attr->{href};
                           }
                           if ($cms eq 'bb5' || $cms eq 'bb6' || 
                               $cms eq 'webctce4' || $cms eq 'webctvista4') {
                             push @{$$hrefs{$identifier}},$attr->{href};                              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') {                          } elsif ($cms eq 'angel') {
                             if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {                              if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
                                 push @{$$hrefs{$identifier}},$1;                                  push @{$$hrefs{$identifier}},$1;
                             } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {                              } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
                                 $$resources{$identifier}{type} = $1;                                  $$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'};
                         }                          }
                     }                      }
                 }                  }
Line 292  sub process_manifest { Line 349  sub process_manifest {
                 if ("@state" eq "manifest metadata lom general title langstring") {                  if ("@state" eq "manifest metadata lom general title langstring") {
                     $$items{'Top'}{title} = $text;                      $$items{'Top'}{title} = $text;
                 }                  }
                 if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $toc{$cms} && $state[-1] eq "title") {                  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 ($$includeditems{$itm} || $phase ne 'build') {
                         if ($cms eq 'angel' || $cms eq 'bb6') {                          if ($cms eq 'angel' || $cms eq 'bb6' || $cms eq 'webctvista4') {
                             $$items{$itm}{title} = $text;                              $$items{$itm}{title} = $text;
                         }                          }
                         if ($cms eq 'webct4') {                          if ($cms eq 'webctce4') {
                             $$items{$itm}{title} = $text;                              $$items{$itm}{title} = $text;
                             $$items{$itm}{title} =~ s/(<[^>]*>)//g;                              $$items{$itm}{title} =~ s/(<[^>]*>)//g;
                         }                          }
Line 312  sub process_manifest { Line 369  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 {  sub get_imports {
Line 359  sub target_resources { Line 414  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,$total) = @_;
     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 'webct4') {                      if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
                         $source = $tempdir.'/'.$file;                          $source = $tempdir.'/'.$file;
                     }                      }
                     my $filename = '';                      my $filename = '';
Line 378  sub copy_resources { Line 433  sub copy_resources {
                     }                      }
                     $file =~ s-\\-/-g;                      $file =~ s-\\-/-g;
                     my $copyfile = $file;                      my $copyfile = $file;
                     if ($cms eq 'webct4') {                      if ($cms eq 'webctce4' || $cms eq 'webctvista4') {
                         if ($file =~ m-/([^/]+)$-) {                          if ($file =~ m-/my_files/(.+)$-) {
                             $copyfile = $1;                              $copyfile = $1;
                         }                          }
                     }                      }
                     unless (($cms eq 'webct4') && ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/)) {                      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;                          $copyfile = $fpath.$copyfile;
                         my $fileresult;                          my $fileresult;
                         if (-e $source) {                          if (-e $source) {
                             $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$copyfile,$source);                              $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$copyfile,$source);
                         }                          }
                     }                      }
                 }                  }
Line 416  sub copy_resources { Line 471  sub copy_resources {
                                 mkdir("$fulldir",0770);                                  mkdir("$fulldir",0770);
                             }                              }
                         }                          }
                           my $renameres;
                         if ($cms eq 'angel') {                          if ($cms eq 'angel') {
                             rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");                              $renameres = rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
                         } elsif ($cms eq 'bb5' || $cms eq 'bb6') {                          } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
                             rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");                              $renameres = rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
                         }                          }
                     } elsif ($cms eq 'webct4') {                          if ($renameres) {
                         if (!-e "$destdir/resfiles/$key") {                              if (ref($total) eq 'HASH') {
                             mkdir("$destdir/resfiles/$key",0770);                                  $$total{'file'} ++;
                               }
                           } else {
                               &Apache::lonnet::logthis("IMS import error: $cms - renaming failed for file $file");
                         }                          }
                         if ($file =~ m-/([^/]+)$-) {                      } elsif ($cms eq 'webctce4') {
                           if ($file =~ m-/my_files/(.+)$-) {
                             my $copyfile = $1;                              my $copyfile = $1;
                             unless ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/) {                               if ($copyfile =~ m-^[^/]+/[^/]+-) {
                                 rename("$tempdir/$file","$destdir/resfiles/$key/$1");                                  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") {
                                   my $renameres = rename("$tempdir/$file","$destdir/resfiles/$copyfile");
                                   if ($renameres) {
                                       if (ref($total) eq 'HASH') {
                                           $$total{'file'} ++;
                                       }
                                   } else {
                                       &Apache::lonnet::logthis("IMS import error: WebCT4 - renaming failed for file $file");
                                   }
                             }                              }
                           } elsif ($file !~ m-/data/(.+)$-) {
                               &Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
                         }                          }
                     }                      }
                 }                  }
Line 445  sub process_resinfo { Line 525  sub process_resinfo {
     my $dbparse = 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;
     }      }
Line 493  sub process_resinfo { Line 577  sub process_resinfo {
                 }                  }
             } 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 506  sub process_resinfo { Line 590  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($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);                  &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                 push @{$pools}, $key;                  push @{$pools}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {              } elsif ($$resources{$key}{type} =~ /assessment\/x\-bb\-(qti\-)?quiz/) {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);                  &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($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);                  &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 551  sub process_resinfo { Line 635  sub process_resinfo {
         if (@{$pools}) {          if (@{$pools}) {
             $$items{'Top'}{'contentscount'} ++;              $$items{'Top'}{'contentscount'} ++;
         }          }
     } elsif ($cms eq 'webct4') {      } elsif ($cms eq 'webctce4') {
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort keys %{$resources}) {
             if (grep/^$key$/,@{$targets}) {              if (grep/^$key$/,@{$targets}) {
                 if ($$resources{$key}{type} eq "webcontent") {                  if ($$resources{$key}{type} eq "webcontent") {
                     %{$$resinfo{$key}} = ();                      %{$$resinfo{$key}} = ();
 #                    &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);                      if ($$resources{$key}{file} eq 'questiondb.xml') {
                           &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                       } else {
                           &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
                       }
                 } elsif ($$resources{$key}{type} eq "webctquiz") {                  } elsif ($$resources{$key}{type} eq "webctquiz") {
 #                    &webct4_assessment($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);                      &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                     &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);                  }
               }
           }
       } 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;
Line 632  sub build_structure { Line 759  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};
         my $contentscount = $$items{$key}{'contentscount'};           my $contentscount = $$items{$key}{'contentscount'};
         if (($cms eq 'angel' && $type eq "FOLDER") || (($cms eq 'bb5' || $cms eq 'bb6') && $$resinfo{$resnum}{'isfolder'} eq "true") && (($type eq "resource/x-bb-document") || ($type eq "resource/x-bb-staffinfo") || ($type eq "resource/x-bb-externallink")) || ($cms eq 'webct4' &&  $contentscount > 0)) {          my $seqtitle = $$items{$key}{'title'};
             print STDERR "$key is identified as a folder has $contentscount\n";          $seqtitle =~ s|/+|_|g;
           $seqtitle =~ s/\s+/_/g;
           $seqtitle .= '_'.$key;
           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') {              unless (($cms eq 'bb5') && $key eq 'Top') {
                 $seqtext{$key} = "<map>\n";                  $seqtext{$key} = "<map>\n";
             }              }
Line 651  sub build_structure { Line 781  sub build_structure {
 <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 $contitemcount = $$items{$contitem}{contentscount};                   my $contitemcount = $$items{$contitem}{contentscount}; 
                 my ($res,$itm,$type);                  my ($res,$itm,$type,$file);
                 if (exists($$items{$contitem}{resnum})) {                  if (exists($$items{$contitem}{resnum})) {
                     $res = $$items{$contitem}{resnum};                      $res = $$items{$contitem}{resnum};
                     $itm = $$resources{$res}{revitm};                      $itm = $$resources{$res}{revitm};
                     $type = $$resources{$res}{type};                      $type = $$resources{$res}{type};
                       $file = $$resources{$res}{file};
                 }                  }
                 my $title = $$items{$contitem}{title};                  my $title = $$items{$contitem}{title};
                 my $packageflag = 0;                  my $packageflag = 0;
                 if (grep/^$res$/,@{$packages}) {                  if (grep/^$res$/,@{$packages}) {
                     $packageflag = 1;                      $packageflag = 1;
                 }                  }
                 $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);                  $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
                 unless ($flag{$key}{page} == 1) {                  unless ($flag{$key}{page} == 1) {
                       if ($$randompicks{$contitem}) {
                           $seqtext{$key} .= qq|
   <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"|;                      $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 695  sub build_structure { Line 835  sub build_structure {
                             my $contitemcount = $$items{$contitem}{contentscount};                              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;                              my $packageflag = 0;
                             if (grep/^$res$/,@{$packages}) {                              if (grep/^$res$/,@{$packages}) {
                                 $packageflag = 1;                                  $packageflag = 1;
                             }                              }
                             $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);                              $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
   
                             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 722  sub build_structure { Line 867  sub build_structure {
                     my $contitemcount = $$items{$contitem}{contentscount};                      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;                      my $packageflag = 0;
                     if (grep/^$res$/,@{$packages}) {                      if (grep/^$res$/,@{$packages}) {
                         $packageflag = 1;                          $packageflag = 1;
                     }                      }
                     $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);                      $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$$randompicks{$contitem},$title);
   
                     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) {
Line 737  sub build_structure { Line 883  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 756  sub build_structure { Line 907  sub build_structure {
             }              }
             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");                  if ($cms eq 'webctce4' && $key ne 'Top') {
                       push @{$seqfiles}, "$seqtitle.sequence";
                       open(LOCFILE,">$destdir/sequences/$seqtitle.sequence");
                   } else {
                       push @{$seqfiles}, "$key.sequence";
                       open(LOCFILE,">$destdir/sequences/$key.sequence");
                   }
                 print LOCFILE $seqtext{$key};                  print LOCFILE $seqtext{$key};
                 close(LOCFILE);                  close(LOCFILE);
                 push @{$seqfiles}, "$key.sequence";  
             }              }
             $count{$key}{page} ++;              $count{$key}{page} ++;
             $$total{page} += $count{$key}{page};              $$total{page} += $count{$key}{page};
Line 849  sub build_structure { Line 1005  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,$contcount,$packageflag,$contitemcount) = @_;      my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount,$randompick,$title) = @_;
     my $src ='';      my $src ='';
     if (($cms eq 'angel' && $type eq 'FOLDER') || (($cms eq 'bb5' || $cms eq 'bb6') && (($$resinfo{$res}{'isfolder'} eq 'true') || $key eq 'Top')) || ($cms eq 'webct4' && $contitemcount > 0)) {      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';
           if ($cms eq 'webctce4') {
               $title =~ s|/+|_|g;
               $title =~ s/\s+/_/g;
               $title .= '_'.$contitem;
               $src = $srcstem.'/sequences/'.$title.'.sequence';
           }
           $$flag{$key}{page} = 0;
           $$flag{$key}{seq} = 1;
           $$count{$key}{seq} ++;
       } elsif ($cms eq 'webctce4' && $randompick) {
           $src = $srcstem.'/sequences/'.$res.'.sequence';
         $$flag{$key}{page} = 0;          $$flag{$key}{page} = 0;
         $$flag{$key}{seq} = 1;          $$flag{$key}{seq} = 1;
         $$count{$key}{seq} ++;          $$count{$key}{seq} ++;
Line 872  sub make_structure { Line 1039  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 899  sub make_structure { Line 1066  sub make_structure {
             }              }
             $$flag{$key}{seq} = 0;              $$flag{$key}{seq} = 0;
         }          }
     } elsif ($cms eq 'webct4') {      } elsif ($cms eq 'webctce4') {
         unless ($type eq 'webctquiz') {          if ($type eq 'webctquiz') {
             foreach my $file (@{$$hrefs{$res}}) {              $src =  $srcstem.'/pages/'.$res.'.page';
               $$count{$key}{page} ++;
               $$flag{$key}{seq} = 0;
           } else {
               if (grep/^$file$/,@{$$hrefs{$res}}) {
                 my $filename;                  my $filename;
                 if ($file =~ m-/([^/]+)$-) {                  if ($file =~ m-/([^/]+)$-) {
                     $filename = $1;                      $filename = $1;
                 }                  }
                 $src = $srcstem.'/resfiles/'.$res.'/'.$filename;                  $src =  $srcstem.'/resfiles/'.$filename;
               } else {
                   foreach my $file (@{$$hrefs{$res}}) {
                       my $filename;
                       if ($file =~ m-/my_files/(.+)$-) {
                           $filename = $1;
                       } elsif ($file =~ m-/([^/]+)$-) { 
                           $filename = $1;
                       }
                       $src = $srcstem.'/resfiles/'.$filename;
                   }
             }              }
             $$flag{$key}{page} = 0;              $$flag{$key}{page} = 0;
             $$flag{$key}{file} = 1;              $$flag{$key}{file} = 1;
Line 1152  sub process_group { Line 1333  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 1277  sub process_staff { Line 1458  sub process_staff {
             <font face="arial" size="2"><b>Office Hours:</b></font>              <font face="arial" size="2"><b>Office Hours:</b></font>
           </td>            </td>
           <td>            <td>
             <font face=arial size=2>$$settings{office}{hours}</font>              <font face="arial" size="2">$$settings{office}{hours}</font>
           </td>            </td>
         </tr>          </tr>
         |;          |;
Line 1310  sub process_staff { Line 1491  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 1333  $staffentry Line 1514  $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 1626  sub addposting { Line 1807  sub addposting {
 sub parse_bb5_assessment {  sub parse_bb5_assessment {
     my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;      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 $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
Line 1685  sub parse_bb5_assessment { Line 1865  sub parse_bb5_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 1741  sub parse_bb5_assessment { Line 1921  sub parse_bb5_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 1748  sub parse_bb5_assessment { Line 1930  sub parse_bb5_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") ) {
             $$settings{$id}{text} = $text;              unless ($text eq '') { 
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) {                  $$settings{$id}{text} = $text;
             $$settings{$id}{$answer_id}{text} = $text;              }
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) {          } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[-1] eq "TEXT") ) {
             $$settings{$id}{$answer_id}{text} = $text;                          unless ($text eq '') {
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) {                  $$settings{$id}{$answer_id}{text} = $text;
             $$settings{$id}{feedback_corr} = $text;              }
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) {          } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[-1] eq "TEXT") ) {
             $$settings{$id}{feedback_incorr} = $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"],        }, "dtext"],
      end_h =>       end_h =>
Line 1767  sub parse_bb5_assessment { Line 1959  sub parse_bb5_assessment {
      }, "tagname"],       }, "tagname"],
     );      );
     $p->unbroken_text(1);      $p->unbroken_text(1);
       $p->marked_sections(1);
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
 }  }
   
 sub parse_bb6_assessment {  sub parse_bb6_assessment {
      my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;      my ($res,$docroot,$container,$settings,$allids) = @_;
      return;      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") {
               $$qzparams{$res}{id} = $attr->{'ident'};
               $$qzparams{$res}{title} = $attr->{'title'};
           }
           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} .= '________';
               }
           }
           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};
                   $$settings{$id}{$label}{case} = $attr->{'case'};
               } 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 {  sub parse_webct4_assessment {
     my ($res,$docroot,$container,$allids) = @_;      my ($res,$docroot,$href,$container,$allids) = @_;
     my $xmlfile = $docroot.'/quiz'.$res.".xml"; #quiz file      my $xmlfile = $docroot.'/'.$href; #quiz file
     print STDERR "XML file is $xmlfile\n";  
     my @state = ();      my @state = ();
     my $id; # the current question ID      my $id; # the current question ID
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
Line 1791  sub parse_webct4_assessment { Line 2711  sub parse_webct4_assessment {
         push @state, $tagname;          push @state, $tagname;
         my $depth = 0;          my $depth = 0;
         my @seq = ();          my @seq = ();
         my $class;  
         if ("@state" eq "questestinterop assessment section itemref") {          if ("@state" eq "questestinterop assessment section itemref") {
             $id = $attr->{linkrefid};               $id = $attr->{linkrefid}; 
             push(@{$allids},$id);              push(@{$allids},$id);
Line 1812  sub parse_webct4_assessment { Line 2731  sub parse_webct4_assessment {
     $p->eof;      $p->eof;
 }  }
   
 sub parse_webct_quizprops {  sub parse_webct4_quizprops {
     my ($res,$docroot,$container,$qzparams) = @_;      my ($res,$docroot,$href,$container,$qzparams) = @_;
     my $xmlfile = $docroot.'/quiz'.$res.".xml"; #quiz file      my $xmlfile = $docroot.'/'.$href; #properties file
     print STDERR "XML file is $xmlfile\n";  
     my @state = ();      my @state = ();
     %{$$qzparams{$res}} = ();      %{$$qzparams{$res}} = ();
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
Line 1825  sub parse_webct_quizprops { Line 2743  sub parse_webct_quizprops {
      [sub {       [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          push @state, $tagname;
         my $depth = 0;  
         my @seq = ();  
         my $class;  
         if ($state[0] eq 'properties' && $state[1] eq 'processing')  {  
             if ($state[2] eq 'scores' && $state[3] eq 'score') {  
                 $$qzparams{$res}{weight} = $attr->{linkrefid};  
             } elsif ($state[2] eq 'selection' && $state[3] eq 'select') {  
                 $$qzparams{$res}{numpick} = $attr->{linkrefid};        
             }  
         }  
      }, "tagname, attr"],       }, "tagname, attr"],
      text_h =>       text_h =>
      [sub {       [sub {
         my ($text) = @_;          my ($text) = @_;
         if ($state[0] eq 'properties' && $state[1] eq 'delivery')  {          if ($state[0] eq 'properties' && $state[1] eq 'delivery')  {
              if ($state[2] eq 'time_available') {              if ($state[2] eq 'time_available') {
                 $$qzparams{$res}{opendate} = $text;                  $$qzparams{$res}{opendate} = $text;
              } elsif ($state[2] eq 'time_due') {              } elsif ($state[2] eq 'time_due') {
                 $$qzparams{$res}{opendate} = $text;                  $$qzparams{$res}{duedate} = $text;
              } elsif ($state[3] eq 'max_attempt') {              } elsif ($state[3] eq 'max_attempt') {
                 $$qzparams{$res}{tries} = $text;                  $$qzparams{$res}{tries} = $text;
              } elsif ($state[3] eq 'post_submission') {              } elsif ($state[3] eq 'post_submission') {
                 $$qzparams{$res}{posts} = $text;                  $$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') {          } elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
              if ($state[2] eq 'display_answer') {              if ($state[2] eq 'display_answer') {
                 $$qzparams{$res}{answerdate} = $text;                  $$qzparams{$res}{showanswer} = $text;
              }              }
         }           } 
       }, "dtext"],        }, "dtext"],
      end_h =>       end_h =>
Line 1867  sub parse_webct_quizprops { Line 2783  sub parse_webct_quizprops {
 }  }
   
 sub parse_webct4_questionDB {  sub parse_webct4_questionDB {
     my ($docroot,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;      my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
     my $xmlfile = $docroot.'/questionDB.xml'; #quizDB file      my $xmlfile;
     print STDERR "XML file is $xmlfile\n";      if ($href eq 'questiondb.xml') {
           $xmlfile = $docroot.'/'.$href;
       } else {
           $href =~ s#[^/]+$##;
           $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file
       }
     my @state = ();      my @state = ();
     my $category; # the current category ID      my $category; # the current category ID
     my $id; # the current question ID      my $id; # the current question ID
Line 1881  sub parse_webct4_questionDB { Line 2802  sub parse_webct4_questionDB {
     my $unitid; # the current unit ID for numerical questions      my $unitid; # the current unit ID for numerical questions
     my $answer_id; # the current answer ID      my $answer_id; # the current answer ID
     my $fdbk; # the current feedback ID      my $fdbk; # the current feedback ID
     my $maxvar; # the current max variable for numerical problems      my $currvar; # the current variable for numerical problems
     my $minvar; # the current min variable for numerical problems      my $fibtype; # the current fill-in-blank type for numerical or string
     my $stepvar; # the current step variable for numerical problems      my $prompt;
     my $fibtype; # the current fill-in-blank type fro numerical or string      my $boxnum; 
     my $prompt;   
     my %setvar = (      my %setvar = (
                    varname => '',                     varname => '',
                    action => '',                     action => '',
                  );                     );
       my $currtexttype;
       my $currimagtype;
       my $is_objectbank;
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
     (      (
      xml_mode => 1,       xml_mode => 1,
      start_h =>       start_h =>
      [sub {       [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
               $is_objectbank = 1;
           } else {
               push @state, $tagname;
           }
         if ("@state" eq "questestinterop section") {          if ("@state" eq "questestinterop section") {
             $category = $attr->{ident};              $category = $attr->{ident};
             %{$$catinfo{$category}} = ();              %{$$catinfo{$category}} = ();
Line 1907  sub parse_webct4_questionDB { Line 2834  sub parse_webct4_questionDB {
             push @{$allids}, $id;              push @{$allids}, $id;
             push(@{$$catinfo{$category}{contents}},$id);              push(@{$$catinfo{$category}{contents}},$id);
             %{$$settings{$id}} = ();              %{$$settings{$id}} = ();
               @{$$allchoices{$id}} = ();
             @{$$settings{$id}{grps}} = ();              @{$$settings{$id}{grps}} = ();
             @{$$settings{$id}{lists}} = ();              @{$$settings{$id}{lists}} = ();
             @{$$settings{$id}{feedback}} = ();              @{$$settings{$id}{feedback}} = ();
               @{$$settings{$id}{str}} = ();
             %{$$settings{$id}{strings}} = ();              %{$$settings{$id}{strings}} = ();
               @{$$settings{$id}{numids}} = ();
               @{$$settings{$id}{boxes}} = ();
             %{$$allanswers{$id}} = ();              %{$$allanswers{$id}} = ();
             @{$$allanswers{$id}{strings}} = ();  
             $$settings{$id}{title} = $attr->{title};              $$settings{$id}{title} = $attr->{title};
               $$settings{$id}{category} = $category;
               $boxnum = 0;
         }          }
   
 # Matching  
         if ("@state" eq "questestinterop section item presentation material mattext") {          if ("@state" eq "questestinterop section item presentation material mattext") {
             $$settings{$id}{texttype} = $attr->{texttype};              $$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") {          if ("@state" eq "questestinterop section item presentation response_grp") {
             $$settings{$id}{class} = 'QUESTION_MATCH';                      $$settings{$id}{class} = 'match';
             $grp = $attr->{ident};              $grp = $attr->{ident};
             push(@{$$settings{$id}{grps}},$grp);              push(@{$$settings{$id}{grps}},$grp);
             %{$$settings{$id}{$grp}} = ();              %{$$settings{$id}{$grp}} = ();
             @{$$allanswers{$id}{$grp}} = ();  
             @{$$settings{$id}{$grp}{correctanswer}} = ();              @{$$settings{$id}{$grp}{correctanswer}} = ();
             $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};              $$settings{$id}{$grp}{rcardinality} = $attr->{rcardinality};
         }          }
         if ("@state" eq "questestinterop section item presentation response_grp material mattext") {           if ("@state" eq "questestinterop section item presentation response_grp material mattext") { 
             $$settings{$id}{$grp}{texttype} = $attr->{texttype};              $$settings{$id}{$grp}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
         }          }
         if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label") {          if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label") {
             $answer_id = $attr->{ident};              $answer_id = $attr->{ident};
             push(@{$$allanswers{$id}{$grp}},$answer_id);              push(@{$$allanswers{$id}{$grp}},$answer_id);
             %{$$settings{$id}{$grp}{$answer_id}} = ();              %{$$settings{$id}{$grp}{$answer_id}} = ();
             $$settings{$id}{$grp}{$answer_id}{texttype} =  $attr->{texttype};              $$settings{$id}{$grp}{$answer_id}{texttype} =  $attr->{texttype};
               $currtexttype = $attr->{texttype};
         }          }
   
 # Multiple choice  # Multiple choice
   
         if ("@state" eq "questestinterop section item presentation flow material mattext") {          if ("@state" eq "questestinterop section item presentation flow material mattext") {
             $$settings{$id}{texttype} = $attr->{texttype};              $$settings{$id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation flow material matimage") {
               $$settings{$id}{imagtype} = $attr->{imagtype};
               $currimagtype = $attr->{imagtype};
               $$settings{$id}{uri} = $attr->{uri};
   
         }          }
         if ("@state" eq "questestinterop section item presentation flow response_lid") {          if ("@state" eq "questestinterop section item presentation flow response_lid") {
             $$settings{$id}{class} = 'QUESTION_MULTIPLEANSWER';              $$settings{$id}{class} = 'multiplechoice';
             $list = $attr->{ident};              $list = $attr->{ident};
             push(@{$$settings{$id}{lists}},$list);              push(@{$$settings{$id}{lists}},$list);
             %{$$settings{$id}{$list}} = ();              %{$$settings{$id}{$list}} = ();
Line 1963  sub parse_webct4_questionDB { Line 2910  sub parse_webct4_questionDB {
         }          }
         if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {          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};              $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") {
               $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
         }          }
   
 # Numerical  # Numerical
         if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {          if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
             $$settings{$id}{texttype} = $attr->{texttype};              $$settings{$id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
         }          }
         if ("@state" eq "questestinterop section item presentation response_num") {          if ("@state" eq "questestinterop section item presentation response_num") {
             $$settings{$id}{class} = 'QUESTION_NUMERICAL';              $$settings{$id}{class} = 'numerical';
             $numid = $attr->{ident};              $numid = $attr->{ident};
               push(@{$$settings{$id}{numids}},$numid);
             %{$$settings{$id}{$numid}} = ();              %{$$settings{$id}{$numid}} = ();
               %{$$settings{$id}{$numid}{vars}} = ();
               @{$$settings{$id}{$numid}{units}} = ();
             $$settings{$id}{$numid}{rcardinality} = $attr->{rcardinality};              $$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") {                      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") {            
             $minvar = $attr->{name};              $currvar = $attr->{name};
             $$settings{$id}{$numid}{minvar} = $minvar;              %{$$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_minvalue webct:x_webct_v01_variable") {          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") {
             $maxvar = $attr->{name};              $currvar = $attr->{name};
             $$settings{$id}{$numid}{maxvar} = $maxvar;  
         }          }
         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") {          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") {
             $stepvar = $attr->{name};              $currvar = $attr->{name};
             $$settings{$id}{$numid}{stepvar} = $stepvar;  
         }          }
         if ("@state" eq "questestinterop section item presentation response_num render_fib") {          if ("@state" eq "questestinterop section item presentation response_num render_fib") {
             $fibtype = $attr->{fibtype};              $fibtype = $attr->{fibtype};
Line 1999  sub parse_webct4_questionDB { Line 2953  sub parse_webct4_questionDB {
         if ("@state" eq "questestinterop section item presentation response_str") {          if ("@state" eq "questestinterop section item presentation response_str") {
             $str_id = $attr->{ident};              $str_id = $attr->{ident};
             push(@{$$settings{$id}{str}},$str_id);              push(@{$$settings{$id}{str}},$str_id);
               @{$$settings{$id}{boxes}[$boxnum]} = ();
               $boxnum ++;
             %{$$settings{$id}{$str_id}} = ();              %{$$settings{$id}{$str_id}} = ();
               @{$$settings{$id}{$str_id}{labels}} = ();
             $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};              $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
         }          }
   
         if ("@state" eq "questestinterop section item presentation response_str render_fib") {          if ("@state" eq "questestinterop section item presentation response_str render_fib") {
             $fibtype = $attr->{fibtype};              $fibtype = $attr->{fibtype};
               $prompt = $attr->{prompt};
         }              }    
         if ("@state" eq "questestinterop section item presentation response_str render_fib response_label") {          if ("@state" eq "questestinterop section item presentation response_str render_fib response_label") {
             $label = $attr->{ident};              $label = $attr->{ident};
             %{$$settings{$id}{$str_id}{$label}} = ();              push(@{$$settings{$id}{$str_id}{labels}},$label);
             push(@{$$allanswers{$id}{strings}},$label);  
             @{$$settings{$id}{strings}{$label}} = ();              @{$$settings{$id}{strings}{$label}} = ();
               %{$$settings{$id}{$str_id}{$label}} = ();
             $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;              $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
         }          }
   
 # Numerical  # Numerical
         if ("@state" eq "questestinterop section item presentation response_str render_fib") {  
             $fibtype = $attr->{fibtype};  
             $prompt = $attr->{prompt};  
         }  
         if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_formula") {  
             $$settings{$id}{$numid}{formula} = $attr->{ident};  
         }  
         if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anspresentation") {          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}{digits} = $attr->{digits};
             $$settings{$id}{$numid}{format} = $attr->{format};              $$settings{$id}{$numid}{format} = $attr->{format};
Line 2030  sub parse_webct4_questionDB { Line 2981  sub parse_webct4_questionDB {
             $$settings{$id}{$numid}{toltype} = $attr->{type};              $$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") {          if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
             my $unitid = $attr->{ident};              $unitid = $attr->{ident};
             %{$$settings{$id}{$numid}{$unitid}} = ();              %{$$settings{$id}{$numid}{$unitid}} = ();
               push(@{$$settings{$id}{$numid}{units}},$unitid);
             $$settings{$id}{$numid}{$unitid}{value} = $attr->{value};               $$settings{$id}{$numid}{$unitid}{value} = $attr->{value}; 
             $$settings{$id}{$numid}{$unitid}{space} = $attr->{space};              $$settings{$id}{$numid}{$unitid}{space} = $attr->{space};
             $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};              $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
Line 2039  sub parse_webct4_questionDB { Line 2991  sub parse_webct4_questionDB {
   
 # Matching   # Matching 
         if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {          if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
             $grp = $attr->{respident};              if ($$settings{$id}{class} eq 'match') {
         }                  unless ($attr->{respident} eq 'WebCT_Incorrect') {
         if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar setvar") {                      $grp = $attr->{respident};
             $setvar{varname} = $attr->{varname};                  }
   # String
               } else {
                   $label = $attr->{respident};
                   $$settings{$id}{$label}{case} = $attr->{case};   
               } 
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
               foreach my $key (keys(%{$attr})) {
                   $setvar{$key} = $attr->{$key};
               }
             if ($setvar{varname} eq 'WebCT_Correct') {              if ($setvar{varname} eq 'WebCT_Correct') {
                 push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);                  push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
             }              }
         }          }
   
 # String   # 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") {          if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") {
             $$settings{$id}{class} = 'QUESTION_FILLINBLANK';              $$settings{$id}{class} = 'string';
             $answer_id = $attr->{respident};              $label = $attr->{respident};
             $$settings{$id}{class} = '';  
         }          }
         if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar not") {          if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar not") {
             $$settings{$id}{class} = 'QUESTION_ESSAY';              $$settings{$id}{class} = 'paragraph';
         }          }
     
   
Line 2069  sub parse_webct4_questionDB { Line 3035  sub parse_webct4_questionDB {
         }          }
         if ("@state" eq "questestinterop section item itemfeedback") {          if ("@state" eq "questestinterop section item itemfeedback") {
             $fdbk = $attr->{ident};              $fdbk = $attr->{ident};
               push(@{$$settings{$id}{feedback}},$fdbk);
             $$settings{$id}{$fdbk}{view} = $attr->{view};              $$settings{$id}{$fdbk}{view} = $attr->{view};
         }          }
         if ("@state" eq "questestinterop section item itemfeedback material mattext") {          if ("@state" eq "questestinterop section item itemfeedback material mattext") {
             $$settings{$id}{$fdbk}{texttype} = $attr->{texttype};              $$settings{$id}{$fdbk}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
         }          }
      }, "tagname, attr"],       }, "tagname, attr"],
      text_h =>       text_h =>
      [sub {       [sub {
         my ($text) = @_;          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") {          if ("@state" eq "questestinterop section item itemmetadata qmd_itemtype") {
             $$settings{$id}{itemtype} = $text;              $$settings{$id}{itemtype} = $text;
               if ($text eq 'String') {
                   $$settings{$id}{class} = 'string';
               }
         }          }
   
 #Matching  
   
         if ("@state" eq "questestinterop section item presentation material mattext") {          if ("@state" eq "questestinterop section item presentation material mattext") {
             $$settings{$id}{text} = $text;              $$settings{$id}{text} = $text;
         }          }
   # Matching
         if ("@state" eq "questestinterop section item presentation response_grp material mattext") {          if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
             $$settings{$id}{$grp}{text} = $text;              $$settings{$id}{$grp}{text} = $text;
               unless ($text eq '') {
                   push(@{$$allchoices{$id}},$grp);
               }
         }          }
         if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label material mattext") {          if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label material mattext") {
             $$settings{$id}{$grp}{$answer_id}{text} = $text;              $$settings{$id}{$grp}{$answer_id}{text} = $text;
Line 2103  sub parse_webct4_questionDB { Line 3079  sub parse_webct4_questionDB {
         if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {          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;              $$settings{$id}{$list}{$answer_id}{text} = $text;
         }          }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") {
               $$settings{$id}{$list}{$answer_id}{text} = $text;
           }
   
 # Numerical  # Numerical
         if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {          if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
             $$settings{$id}{text} = $text;              $$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") {          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}{$minvar}{min} = $text;               $$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") {          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}{$maxvar}{max} = $text;               $$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") {          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}{$stepvar}{step} = $text;               $$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 ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
             $answer_id = $text;              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          if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") { # String
             push(@{$$settings{$id}{strings}{$answer_id}},$text);              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 conditionvar setvar") {          if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
             if ($setvar{varname} eq "answerValue") { # Multiple Choice              if ($setvar{varname} eq "answerValue") { # Multiple Choice WebCT4.0
                   if ($text =~ m/^\d+$/) {
                       if ($text > 0) {
                           push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);   
                       }
                   }
               } elsif ($setvar{varname} eq "que_score") { # Multiple Choice WebCT4.1
                 if ($text =~ m/^\d+$/) {                  if ($text =~ m/^\d+$/) {
                     if ($text > 0) {                      if ($text > 0) {
                         push(@{$$settings{$id}{$list}{correctanswer}}),$answer_id;                             push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
                       }
                   }
               } elsif ($is_objectbank) { #Multiple Choice WebCT 4.1 D2L objectbank
                   if ($setvar{action} eq "Set") {
                       if ($text =~ /^\d+\.?\d*$/) {
                           if ($text > 0.000000001) {
                               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") {          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;              $$settings{$id}{$numid}{$unitid}{text} = $text;
         }          }
Line 2145  sub parse_webct4_questionDB { Line 3156  sub parse_webct4_questionDB {
      end_h =>       end_h =>
      [sub {       [sub {
         my ($tagname) = @_;          my ($tagname) = @_;
         pop @state;          if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
               $is_objectbank = '';
           } else {
               pop @state;
           }
      }, "tagname"],       }, "tagname"],
     );      );
     $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 ++;
                       }
                   }
               }
           } elsif ($$settings{$id}{class} eq 'multiplechoice') {
               if (ref($$settings{$id}) eq 'HASH') {
                   foreach my $list (keys(%{$$settings{$id}})) {
                       if (ref($$settings{$id}{$list}) eq 'HASH') {
                           if (defined($$settings{$id}{$list}{rcardinality})) {
                               if ($$settings{$id}{$list}{rcardinality} eq 'Multiple') {
                                   if (ref($$settings{$id}{$list}{correctanswer}) eq 'ARRAY') {
                                       if (@{$$settings{$id}{$list}{correctanswer}} == 1) {
                                           $$settings{$id}{$list}{rcardinality} = 'Single';
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
 }  }
   
 sub process_assessment {  sub process_assessment {
     my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse) = @_;      my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs,$allquestions) = @_;
     my @allids = ();      my @allids = ();
       my @allquestids = ();
     my %allanswers = ();      my %allanswers = ();
     my %allchoices = ();      my %allchoices = ();
     my %qzparams = ();      my %qzparams = ();
     my @allquestids = ();  
     my %catinfo = ();  
     my %qzdbsettings = ();  
     my %alldbanswers = ();      my %alldbanswers = ();
     my %alldbchoices = ();      my %alldbchoices = ();
     my @alldbquestids = ();      my @alldbquestids = ();
Line 2170  sub process_assessment { Line 3213  sub process_assessment {
     my $randompickflag = 0;      my $randompickflag = 0;
     my ($cid,$cdom,$cnum);      my ($cid,$cdom,$cnum);
     if ($context eq 'DOCS') {      if ($context eq 'DOCS') {
         $cid = $ENV{'request.course.id'};          $cid = $env{'request.course.id'};
         ($cdom,$cnum) = split/_/,$cid;          ($cdom,$cnum) = split/_/,$cid;
     }      }
     my $destresdir = $destdir;      my $destresdir = $destdir;
Line 2182  sub process_assessment { Line 3225  sub process_assessment {
     if ($cms eq 'bb5') {      if ($cms eq 'bb5') {
         &parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);          &parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
     } elsif ($cms eq 'bb6') {      } elsif ($cms eq 'bb6') {
         &parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);          &parse_bb6_assessment($res,$docroot,$container,$settings,\@allids);
     } elsif ($cms eq 'webct4') {      } elsif ($cms eq 'webctce4') {
         unless($$dbparse) {          unless($$dbparse) {
             &parse_webct4_questionDB($docroot,\%catinfo,\%qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);              &parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
             if (!-e "$destdir/sequences") {              &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
                 mkdir("$destdir/sequences",0755);              &write_webct4_questions($cms,\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
             }  
             my $numcats = keys %catinfo;  
             my $curr_id = 0;  
             my $next_id = 1;  
             my $fh;  
             open($fh,">$destdir/sequences/question_database.sequence");  
             push @{$sequencesfiles},'question_database.sequence';  
             foreach my $category (sort keys %catinfo) {  
                 my $seqname = $catinfo{$category}{title}.'_'.$category;  
                 $seqname =~ s/\s/_/g;  
                 $seqname =~ s/\W//g;  
                 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>  
 <resource id="2" src="" type="finish">\n|;  
                 } else {  
                     $curr_id = $next_id;  
                     $next_id = $curr_id + 1;  
                     $catsrc = "$destresdir/sequences/$seqname.sequence";  
                     print $fh qq|  
 <link from="$curr_id" to="$next_id" index="$curr_id"></link>  
 <resource id="$next_id" src="$catsrc" title="$catinfo{$category}{title}"|;  
                     if ($next_id == $numcats) {  
                         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);  
                 }  
                 my $newdir = "$destdir/problems/$seqname";  
                 my $dbcontainerdir;  
                 &build_problem_container($seqname,$newdir,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,\$newdir,$cid,$cdom,$cnum);  
             }  
             close($fh);  
             &write_webct4_questions(\@alldbquestids,$context,$settings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum);  
             $$dbparse = 1;              $$dbparse = 1;
         }          }
         &parse_webct4_quizprops($res,$docroot,$container,\%qzparams);          &parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
         foreach (sort keys %qzparams) {          &parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
             if (exists($qzparams{$res}{numpick})) {           if (exists($qzparams{$res}{numpick})) { 
                 if ($qzparams{$res}{numpick} < @allids) {              if ($qzparams{$res}{numpick} < @allids) {
                     $$randompicks{$res} = $qzparams{$res}{numpick};                  $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
                     $randompickflag = 1;                  $randompickflag = 1;
                 }  
             }              }
         }          }
         &parse_webct4_assessment($res,$docroot,$container,\@allids);      } elsif ($cms eq 'webctvista4') {
     }          unless($$dbparse) {
     my $dirtitle = $$settings{'title'};              foreach my $res (sort keys %{$allquestions}) {
     $dirtitle =~ s/\W//g;                  my $parent = $$allquestions{$res};
     $dirtitle .= '_'.$res;                  &parse_webctvista4_question($res,$docroot,$resources,$hrefs,$qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);
     if (!-e "$destdir/problems") {              }
         mkdir("$destdir/problems",0755);              &build_category_sequences($destdir,$catinfo,$sequencesfiles,$pagesfiles,$destresdir,$newdir,$cms,$total,$randompickflag,$context,$udom,$uname,$dirname,$cid,$cdom,$cnum,$qzdbsettings);
     }              $$dbparse = 1;
     if (!-e "$destdir/problems/$dirtitle") {          }
         mkdir("$destdir/problems/$dirtitle",0755);          &parse_webctvista4_assessment($res,$docroot,$$resources{$res}{file},\@allids,\%qzparams);
           if ($qzparams{$res}{numpick} < @allids) {
               $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
               $randompickflag = 1;
           }
       }
       my $dirtitle;
       unless ($cms eq 'webctce4' || $cms eq 'webctvista4') {
           $dirtitle = $$settings{'title'};
           $dirtitle =~ s/\s+/_/g;
           $dirtitle =~ s/:/_/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') {
           if (@allids > 0 && $allids[0] ne '') {
               &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,$qzdbsettings,\%qzparams);
     }      }
     my $newdir = "$destdir/problems/$dirtitle";  
   
     &build_problem_container($dirtitle,$newdir,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,\$newdir,$cid,$cdom,$cnum);  
     if ($cms eq 'bb5') {      if ($cms eq 'bb5') {
         &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);          &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
     } elsif ($cms eq 'bb6') {      } elsif ($cms eq 'bb6') {
         &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);          &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,$qzdbsettings,$dirname,\%allanswers,\%allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle);
       }
   }
   
   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 $next_id = 1;
       my $fh;
       open($fh,">$destdir/sequences/question_database.sequence");
       push @{$sequencesfiles},'question_database.sequence';
       foreach my $category (sort keys %{$catinfo}) {
           my $seqname;
           if ($cms eq 'webctce4') { 
               $seqname = $$catinfo{$category}{title}.'_'.$category;
           } else {
               $seqname = $$catinfo{$category}{title};
           }
           $seqname =~ s/\s+/_/g;
           $seqname =~ s/:/_/g;
           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>
   <resource id="2" src="" type="finish">\n|;
           } else {
               $curr_id = $next_id;
               $next_id = $curr_id + 1;
               $catsrc = "$destresdir/sequences/$seqname.sequence";
               print $fh qq|
   <link from="$curr_id" to="$next_id" index="$curr_id"></link>
   <resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
               if ($next_id == $numcats) {
                   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 {  sub build_problem_container {
     my ($dirtitle,$newdir,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,$allids,$udom,$uname,$dirname,$containerdir,$newdir,$cid,$cdom,$cnum) = @_;      my ($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,$allids,$udom,$uname,$dirname,$containerdir,$cid,$cdom,$cnum,$catinfo,$settings,$qzparams) = @_;
     my $seqdir = "$destdir/sequences";      my $seqdir = "$destdir/sequences";
     my $pagedir = "$destdir/pages";      my $pagedir = "$destdir/pages";
     my $curr_id = 0;      my $curr_id = 0;
     my $next_id = 1;      my $next_id = 1;
     my $fh;      my $fh;
       my $mapname = $res;
       if ($cms eq 'webctvista4' && ref($$qzparams{$res}) eq 'HASH') {
           if ($$qzparams{$res}{title}) {
               $mapname = $$qzparams{$res}{title};
               $mapname =~ s/\s+/_/g;
           }
       }
     if ($container eq 'pool' || $randompickflag || $container eq 'database') {      if ($container eq 'pool' || $randompickflag || $container eq 'database') {
         $$containerdir = $seqdir.'/'.$res.'.sequence';          $$containerdir = $seqdir.'/'.$mapname.'.sequence';
         if (!-e "$seqdir") {          if (!-e "$seqdir") {
             mkdir("$seqdir",0770);              mkdir("$seqdir",0770);
         }          }
         open($fh,">$$containerdir");          open($fh,">$$containerdir");
         $$total{seq} ++;          $$total{seq} ++;
         push @{$sequencesfiles},$res.'.sequence';          push @{$sequencesfiles},$mapname.'.sequence';
     } else {      } else {
         $$containerdir = $pagedir.'/'.$res.'.page';          $$containerdir = $pagedir.'/'.$mapname.'.page';
         if (!-e "$destdir/pages") {          if (!-e "$destdir/pages") {
             mkdir("$destdir/pages",0770);              mkdir("$destdir/pages",0770);
         }          }
         open($fh,">$$containerdir");          open($fh,">$$containerdir");
         $$total{page} ++;          $$total{page} ++;
         push @{$pagesfiles},$res.'.page';          push @{$pagesfiles},$mapname.'.page';
     }      }
     print $fh qq|<map>      print $fh qq|<map>
 |;  |;
       my %probtitle = ();
     my $probsrc = "/res/lib/templates/simpleproblem.problem";      my $probsrc = "/res/lib/templates/simpleproblem.problem";
     if ($context eq 'CSTR') {      if ($context eq 'CSTR') {
         $probsrc="/res/$udom/$uname/$dirname/problems/$dirtitle/$$allids[0].problem";          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/:/_/g;
               $probtitle{$id} =~ s/\//_/g;
               $probtitle{$id} .= '_'.$id;
           }
           if (($cms eq 'webctce4' && $container ne 'database') ||
               ($cms eq 'webctvista4'))   {
               my $probdir;
               my $catid = $$settings{$$allids[0]}{category};
               if ($catid) {
                   if ($cms eq 'webctce4') { 
                       $probdir = $$catinfo{$catid}{title}.'_'.$catid;
                   } else {
                       $probdir = $$catinfo{$catid}{title};
                   }
                   $probdir =~ s/\s+/_/g;
                   $probdir =~ s/:/_/g;
                   $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
               } else {
                   $probsrc="$dirname/problems/$dirtitle/$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>|;      print $fh qq|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>|;
     if (@{$allids} == 1) {      if (@{$allids} == 1) {
Line 2310  sub build_problem_container { Line 3424  sub build_problem_container {
             $curr_id = $j;              $curr_id = $j;
             $next_id = $curr_id + 1;              $next_id = $curr_id + 1;
             if ($context eq 'CSTR') {              if ($context eq 'CSTR') {
                 $probsrc = "/res/$udom/$uname/$dirname/problems/$dirtitle/$$allids[$j].problem";                  if (($cms eq 'webctce4' && $container ne 'database') ||
                       ($cms eq 'webctvista4')) {
                       my $probdir;
                       my $catid = $$settings{$$allids[$j]}{category};
                       if ($catid) {
                           if ($cms eq 'webctce4') {
                               $probdir = $$catinfo{$catid}{title}.'_'.$catid;
                           } else {
                               $probdir = $$catinfo{$catid}{title};
                           }
                           $probdir =~ s/\s/_/g;
                           $probdir =~ s/:/_/g;
                           $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
                       } else {
                           $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
                       }
                   } else {
                       $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
                   }
             }              }
             print $fh 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>
Line 2327  sub build_problem_container { Line 3459  sub build_problem_container {
 }  }
   
 sub write_bb5_questions {  sub write_bb5_questions {
     my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum) = @_;      my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
     my $qnum = 0;      my $qnum = 0;
       my $pathstart;
       if ($context eq 'CSTR') {
           $pathstart = '../..';
       } else {
           $pathstart = $dirname;
       }
     foreach my $id (@{$allids}) {      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 ++;          $qnum ++;
         my $output;          my $output;
         my $permcontainer = $containerdir;          my $permcontainer = $containerdir;
Line 2373  sub write_bb5_questions { Line 3521  sub write_bb5_questions {
             my ($image,$imglink,$url);              my ($image,$imglink,$url);
             if ( defined($$settings{$id}{image}) ) {              if ( defined($$settings{$id}{image}) ) {
                 if ( $$settings{$id}{style} eq 'embed' ) {                  if ( $$settings{$id}{style} eq 'embed' ) {
                     $image = 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 {
                     $imglink = 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}) ) {
Line 2409  sub write_bb5_questions { Line 3557  sub write_bb5_questions {
                         $output .= "false\" location=\"";                          $output .= "false\" location=\"";
                         $resourcedata{$symb.'value'.$iter} = "false";                          $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";                          $resourcedata{$symb.'position'.$iter} = "bottom";
                     } else {                      } else {
Line 2420  sub write_bb5_questions { Line 3568  sub write_bb5_questions {
                     my ($ans_image,$ans_link);                      my ($ans_image,$ans_link);
                     if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {                      if ( defined($$settings{$id}{$$allanswers{$id}[$k]}{image}) ) {
                         if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {                          if ( $$settings{$id}{$$allanswers{$id}[$k]}{style} eq 'embed' ) {
                             $ans_image .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" /><br />|;                              $ans_image .= qq|<br /><img src="$pathstart/resfiles/$res/$$settings{$id}{$$allanswers{$id}[$k]}{image}" /><br />|;
                         } else {                          } else {
                             $ans_link .= 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 .= $ans_image.$ans_link.'<endouttext /></foil>'."\n";                      $output .= $ans_image.$ans_link.'<endouttext /></foil>'."\n";
Line 2673  sub write_bb5_questions { Line 3821  sub write_bb5_questions {
         if ($context eq 'CSTR') {          if ($context eq 'CSTR') {
             $output .= qq|</problem>              $output .= qq|</problem>
 |;  |;
             open(PROB,">$newdir/$id.problem");              my $title = $$settings{title};
               $title =~ s/\s/_/g;
               $title =~ s/\W//g;
               $title .= '_'.$id;
               open(PROB,">$newdir/$title.problem");
             print PROB $output;              print PROB $output;
             close PROB;              close PROB;
         } else {          } else {
Line 2685  sub write_bb5_questions { Line 3837  sub write_bb5_questions {
 }  }
   
 sub write_webct4_questions {  sub write_webct4_questions {
     my ($alldbquestids,$context,$settings,$dirname,$alldbanswers,$alldbchoices,$total,$cid,$cdom,$cnum) = @_;      my ($cms,$alldbquestids,$context,$settings,$dirname,$allanswers,$allchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo,$dirtitle) = @_;
       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 ($feedback ne '') {
                   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 'webctce4') {
                           $$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 'webctce4') {
                   if ($$settings{$id}{imagtype} =~ /^image\//) {
                       $questionimage = '<p><img src="../../resfiles/'.$$settings{$id}{uri}.'" /></p>'."\n";
                   } else {
                       $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>
   |;
               } 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|
   </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 'webctce4') {
                       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>
   </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 'webctce4') { 
                               $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 $probdir;
               my $catid = $$settings{$id}{category};
               if ($catid) {
                   if ($cms eq 'webctce4') {
                       $probdir = $$catinfo{$catid}{title}.'_'.$catid;
                   } else {
                       $probdir = $$catinfo{$catid}{title};
                   }
                   $probdir =~ s/\s/_/g;
                   $probdir =~ s/://g;
               } elsif (defined($dirtitle)) {
                   $probdir = $dirtitle;
               }
               if (!-e "$destdir/problems/$probdir") {
                   mkdir("$destdir/problems/$probdir",0755);
               }
               if ($allfeedback ne '') {
                   $output .= qq|
    <postanswerdate>
     $allfeedback
    </postanswerdate>
   |;
               }
               $output .= qq|</problem>
   |;
               my $title = $$settings{$id}{title};
               $title =~ s/\s/_/g;
               $title =~ s/:/_/g;
               $title =~ s/\//_/g;
               $title .= '_'.$id;
               open(PROB,">$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 {  sub write_bb6_questions {
     my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices) = @_;      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 {
                           $output .= "False\"";
                           $resourcedata{$symb.'value'.$iter} = "False";
                       }
                       $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}); 
                           }
                       }
                   }
                   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|
   <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">
   <textline>
   </textline>
   </stringresponse>
   <hintgroup showoncorrect="no">
    <stringhint type="cs">
    </stringhint>
    <hintpart on="default">
       <startouttext/><endouttext />
    </hintpart>
   </hintgroup>
   |;
                           }
                       }
                   }
               } elsif ($$settings{$id}{class} eq "Matching") {
                   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'} =  $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>
                       |;
                       }
                   }
                   if ($context eq 'CSTR') {
                       $output .= qq|
           </itemgroup>
   |;
                   }
                   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($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>
   ';
                       } else {
                           my $iter = $k+1;
                           $resourcedata{$symb.'value'.$iter} = "$allmatchers[$$settings{$id}{$$settings{$id}{$answer_id}{correctanswer}}{order}]";
                           $resourcedata{$symb.'text'.$iter} = $answer_text;
                       }
                   }
                   if ($context eq 'CSTR') {
                       $output .= qq|
       </foilgroup>
   </matchresponse>
   |;
                   } else {
                       $resourcedata{$symb.'options'} = "('".join("','",@allmatchers)."')";
                   }
               }
           }
           if ($context eq 'CSTR') {
               
               $output .= qq|
    <postanswerdate>
     $$settings{$id}{solutionfeedback}{text}
    </postanswerdate>
   </problem>
   |;
               my $title = $$settings{title};
               $title =~ s/\s/_/g;
               $title =~ s/\W//g;
               $title .= '_'.$id;
               open(PROB,">$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;
       }
 }  }
   
 # ---------------------------------------------------------------- Process Blackboard Announcements  # ---------------------------------------------------------------- Process Blackboard Announcements
Line 3209  sub angel_content { Line 5403  sub angel_content {
 # ---------------------------------------------------------------- WebCT content  # ---------------------------------------------------------------- WebCT content
 sub webct4_content {  sub webct4_content {
     my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;      my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
     if (!open(FILE,">$destdir/resfiles/$res.html")) {      if (defined($$settings{url})) {
         &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");          if (!open(FILE,">$destdir/resfiles/$res.html")) {
     } else {              &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
         push(@{$resrcfiles}, "$res.html");          } else {
         my $linktag = '';              push(@{$resrcfiles}, "$res.html");
         if (defined($$settings{url})) {              my $linktag = qq|<a href="$$settings{url}"|;
             $linktag = qq|<a href="$$settings{url}"|;  
             if ($title ne '') {              if ($title ne '') {
                 $linktag .= qq|>$title</a>|;                  $linktag .= qq|>$title</a>|;
             } else {              } else {
                 $linktag .= qq|>$$settings{url}|;                  $linktag .= qq|>$$settings{url}|;
             }              }
         }              print FILE qq|<html>
         print FILE qq|<html>  
 <head>  <head>
 <title>$title</title>  <title>$title</title>
 </head>  </head>
Line 3230  sub webct4_content { Line 5422  sub webct4_content {
 $linktag  $linktag
 </body>  </body>
 </html>|;  </html>|;
         close(FILE);              close(FILE);
           }
     }      }
 }  }
   
 # ---------------------------------------------------------------- WebCT assessments  sub process_html {
 sub webct4_assessment {      my ($text,$caller,$html_cond,$context,$res,$dirname,$cdom,$cnum,$docroot,$destdir) = @_;
     my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;      my $pathstart;
     print STDERR "webct assessment detected - $res, $docroot, $destdir, $type,$title\n";      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.15  
changed lines
  Added in v.1.46

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.