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

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

version 1.14, 2005/02/14 22:46:12 version 1.15, 2005/02/21 23:47:46
Line 51  sub ims_config { Line 51  sub ims_config {
                 survey => 'FORM',                  survey => 'FORM',
                 );                  );
     @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');      @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
       %{$$cmsmap{webct4}} = (
                   quiz => 'webctquiz',
                   survey => 'webctsurvey',
                   doc => 'webcontent'
                   );
     %{$areaname} = (      %{$areaname} = (
                 announce => 'Announcements',                  announce => 'Announcements',
                 board => 'Discussion Boards',                  board => 'Discussion Boards',
Line 146  sub process_manifest { Line 151  sub process_manifest {
               bb6 => 'organization',                bb6 => 'organization',
               bb5 => 'tableofcontents',                bb5 => 'tableofcontents',
               angel => 'organization',                angel => 'organization',
                 webct4 => 'organization',
               );                );
     my %contents = ();      my %contents = ();
     my @state = ();      my @state = ();
Line 198  sub process_manifest { Line 204  sub process_manifest {
                         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') {                              if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
                                 $$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 255  sub process_manifest { Line 261  sub process_manifest {
                 } elsif ("@state" eq "manifest resources resource" ) {                  } elsif ("@state" eq "manifest resources resource" ) {
                     $identifier = $attr->{identifier};                      $identifier = $attr->{identifier};
                     if ($$includedres{$identifier} || $phase ne 'build') {                       if ($$includedres{$identifier} || $phase ne 'build') { 
                         if ($cms eq 'bb5' || $cms eq 'bb6') {                          if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
                             $$resources{$identifier}{file} = $attr->{file};                              $$resources{$identifier}{file} = $attr->{file};
                             $$resources{$identifier}{type} = $attr->{type};                              $$resources{$identifier}{type} = $attr->{type};
                         } elsif ($cms eq 'angel') {                          } elsif ($cms eq 'angel') {
Line 268  sub process_manifest { Line 274  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') {                          if ($cms eq 'bb5' || $cms eq 'bb6' || $cms eq 'webct4') {
                             push @{$$hrefs{$identifier}},$attr->{href};                              push @{$$hrefs{$identifier}},$attr->{href};
                         } elsif ($cms eq 'angel') {                          } elsif ($cms eq 'angel') {
                             if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {                              if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
Line 283  sub process_manifest { Line 289  sub process_manifest {
         text_h =>          text_h =>
             [sub {              [sub {
                 my ($text) = @_;                  my ($text) = @_;
                   if ("@state" eq "manifest metadata lom general title langstring") {
                       $$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') {
                             $$items{$itm}{title} = $text;                              $$items{$itm}{title} = $text;
                         }                          }
                           if ($cms eq 'webct4') {
                               $$items{$itm}{title} = $text;
                               $$items{$itm}{title} =~ s/(<[^>]*>)//g;
                           }
                     }                      }
                 }                  }
               }, "dtext"],                }, "dtext"],
Line 353  sub copy_resources { Line 366  sub copy_resources {
                 %{$$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') {
                           $source = $tempdir.'/'.$file;
                       }
                     my $filename = '';                      my $filename = '';
                     my $fpath = $timenow.'/resfiles/'.$key.'/';                      my $fpath = $timenow.'/resfiles/'.$key.'/';
                     if ($cms eq 'angel') {                      if ($cms eq 'angel') {
Line 361  sub copy_resources { Line 377  sub copy_resources {
                         }                          }
                     }                      }
                     $file =~ s-\\-/-g;                      $file =~ s-\\-/-g;
                     $file = $fpath.$file;                      my $copyfile = $file;
                     my $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$file,$source);                      if ($cms eq 'webct4') {
                           if ($file =~ m-/([^/]+)$-) {
                               $copyfile = $1;
                           }
                       }
                       unless (($cms eq 'webct4') && ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/)) {
                           $copyfile = $fpath.$copyfile;
                           my $fileresult;
                           if (-e $source) {
                               $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$copyfile,$source);
                           }
                       }
                 }                  }
             }              }
         }          }
Line 374  sub copy_resources { Line 401  sub copy_resources {
             if (grep/^$key$/,@{$targets}) {              if (grep/^$key$/,@{$targets}) {
                 foreach my $file (@{$$hrefs{$key}}) {                  foreach my $file (@{$$hrefs{$key}}) {
                     $file =~ s-\\-/-g;                      $file =~ s-\\-/-g;
                     if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6') ) {                      if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6')) {
                         if (!-e "$destdir/resfiles/$key") {                          if (!-e "$destdir/resfiles/$key") {
                             mkdir("$destdir/resfiles/$key",0770);                              mkdir("$destdir/resfiles/$key",0770);
                         }                          }
   
                         my $filepath = $file;                          my $filepath = $file;
                         my $front = '';                          my $front = '';
                         while ($filepath =~ m-(\w+)/(.+)-) {                          while ($filepath =~ m-(\w+)/(.+)-) {
Line 395  sub copy_resources { Line 421  sub copy_resources {
                         } elsif ($cms eq 'bb5' || $cms eq 'bb6') {                          } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
                             rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");                              rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
                         }                          }
                       } elsif ($cms eq 'webct4') {
                           if (!-e "$destdir/resfiles/$key") {
                               mkdir("$destdir/resfiles/$key",0770);
                           }
                           if ($file =~ m-/([^/]+)$-) {
                               my $copyfile = $1;
                               unless ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/) { 
                                   rename("$tempdir/$file","$destdir/resfiles/$key/$1");
                               }
                           }
                     }                      }
                 }                  }
             }              }
Line 403  sub copy_resources { Line 439  sub copy_resources {
 }  }
   
 sub process_resinfo {  sub process_resinfo {
     my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles) = @_;      my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles,$randompicks) = @_;
     my $board_id = time;      my $board_id = time;
     my $board_count = 0;      my $board_count = 0;
       my $dbparse = 0;
     my $announce_handling = 'include';      my $announce_handling = 'include';
     my $longcrs = '';      my $longcrs = '';
     if ($crs =~ m/^(\d)(\d)(\d)/) {      if ($crs =~ m/^(\d)(\d)(\d)/) {
Line 471  sub process_resinfo { Line 508  sub process_resinfo {
                 }                  }
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {              } elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_assessment($context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);                  &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);
                 push @{$pools}, $key;                  push @{$pools}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {              } elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_assessment($context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);                  &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);
                 push @{$quizzes}, $key;                  push @{$quizzes}, $key;
             } elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {              } elsif ($$resources{$key}{type} eq "assessment/x-bb-survey") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 &process_assessment($context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);                  &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse);
                 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 514  sub process_resinfo { Line 551  sub process_resinfo {
         if (@{$pools}) {          if (@{$pools}) {
             $$items{'Top'}{'contentscount'} ++;              $$items{'Top'}{'contentscount'} ++;
         }          }
       } elsif ($cms eq 'webct4') {
           foreach my $key (sort keys %{$resources}) {
               if (grep/^$key$/,@{$targets}) {
                   if ($$resources{$key}{type} eq "webcontent") {
                       %{$$resinfo{$key}} = ();
   #                    &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
                   } elsif ($$resources{$key}{type} eq "webctquiz") {
   #                    &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);
   
                   }
               }
           }
     }      }
   
     $$total{'board'} = $board_count;      $$total{'board'} = $board_count;
Line 523  sub process_resinfo { Line 573  sub process_resinfo {
 }  }
   
 sub build_structure {  sub build_structure {
     my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems) = @_;      my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems,$randompicks) = @_;
     my %flag = ();      my %flag = ();
     my %count = ();      my %count = ();
     my %pagecontents = ();      my %pagecontents = ();
Line 582  sub build_structure { Line 632  sub build_structure {
         my $curr_id = 1;          my $curr_id = 1;
         my $resnum = $$items{$key}{resnum};          my $resnum = $$items{$key}{resnum};
         my $type = $$resources{$resnum}{type};          my $type = $$resources{$resnum}{type};
         if (($cms eq 'angel' && $type eq "FOLDER") || (($cms eq 'bb5' || $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")) ) {          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)) {
               print STDERR "$key is identified as a folder has $contentscount\n";
             unless (($cms eq 'bb5') && $key eq 'Top') {              unless (($cms eq 'bb5') && $key eq 'Top') {
                 $seqtext{$key} = "<map>\n";                  $seqtext{$key} = "<map>\n";
             }              }
             if ($$items{$key}{contentscount} == 0) {              if ($contentscount == 0) {
         if ($key eq 'Top') {          if ($key eq 'Top') {
                     unless ($topspecials) {                      unless ($topspecials) {
                         $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>                          $seqtext{$key} .= qq|<resource id="$curr_id" src="" type="start"></resource>
Line 601  sub build_structure { Line 653  sub build_structure {
             } else {              } else {
                 my $contcount = @{$$items{$key}{contents}};                  my $contcount = @{$$items{$key}{contents}};
                 my $contitem = $$items{$key}{contents}[0];                  my $contitem = $$items{$key}{contents}[0];
                 my $res = $$items{$contitem}{resnum};                  my $contitemcount = $$items{$contitem}{contentscount}; 
                 my $type = $$resources{$res}{type};                  my ($res,$itm,$type);
                   if (exists($$items{$contitem}{resnum})) {
                       $res = $$items{$contitem}{resnum};
                       $itm = $$resources{$res}{revitm};
                       $type = $$resources{$res}{type};
                   }
                 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);                  $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
                 unless ($flag{$key}{page} == 1) {                  unless ($flag{$key}{page} == 1) {
                     $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}) {
Line 635  sub build_structure { Line 692  sub build_structure {
                     if ($contcount > 2 ) {                      if ($contcount > 2 ) {
                         for (my $i=1; $i<$contcount-1; $i++) {                          for (my $i=1; $i<$contcount-1; $i++) {
                             my $contitem = $$items{$key}{contents}[$i];                              my $contitem = $$items{$key}{contents}[$i];
                               my $contitemcount = $$items{$contitem}{contentscount};
                             my $res = $$items{$contitem}{resnum};                              my $res = $$items{$contitem}{resnum};
                             my $type = $$resources{$res}{type};                              my $type = $$resources{$res}{type};
                             my $title = $$items{$contitem}{title};                              my $title = $$items{$contitem}{title};
Line 642  sub build_structure { Line 700  sub build_structure {
                             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);                              $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
   
                             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>
Line 660  sub build_structure { Line 719  sub build_structure {
                         }                          }
                     }                      }
                     my $contitem = $$items{$key}{contents}[-1];                      my $contitem = $$items{$key}{contents}[-1];
                       my $contitemcount = $$items{$contitem}{contentscount};
                     my $res = $$items{$contitem}{resnum};                      my $res = $$items{$contitem}{resnum};
                     my $type = $$resources{$res}{type};                      my $type = $$resources{$res}{type};
                     my $title = $$items{$contitem}{title};                      my $title = $$items{$contitem}{title};
Line 667  sub build_structure { Line 727  sub build_structure {
                     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);                      $src = &make_structure($cms,$key,$srcstem,\%flag,\%count,$timestamp,$boardnum,$hrefs,\%pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount);
   
                     if ($flag{$key}{page}) {                      if ($flag{$key}{page}) {
                         if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {                          if ($count{$key}{seq} + $count{$key}{page} + $count{$key}{board} + $count{$key}{file} +1 == 1) {
                             $seqtext{$key} .= qq|></resource>                              $seqtext{$key} .= qq|></resource>
Line 788  sub build_structure { Line 849  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) = @_;      my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$resinfo,$contitem,$uname,$cdom,$contcount,$packageflag,$contitemcount) = @_;
     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')) ) {      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)) {
         $src = $srcstem.'/sequences/'.$contitem.'.sequence';          $src = $srcstem.'/sequences/'.$contitem.'.sequence';
         $$flag{$key}{page} = 0;          $$flag{$key}{page} = 0;
         $$flag{$key}{seq} = 1;          $$flag{$key}{seq} = 1;
Line 838  sub make_structure { Line 899  sub make_structure {
             }              }
             $$flag{$key}{seq} = 0;              $$flag{$key}{seq} = 0;
         }          }
       } elsif ($cms eq 'webct4') {
           unless ($type eq 'webctquiz') {
               foreach my $file (@{$$hrefs{$res}}) {
                   my $filename;
                   if ($file =~ m-/([^/]+)$-) {
                       $filename = $1;
                   }
                   $src = $srcstem.'/resfiles/'.$res.'/'.$filename;
               }
               $$flag{$key}{page} = 0;
               $$flag{$key}{file} = 1;
           }
     }      }
     return $src;      return $src;
 }  }
Line 1275  sub process_link { Line 1348  sub process_link {
             } elsif ("@state" eq "EXTERNALLINK TEXTCOLOR") {                } elsif ("@state" eq "EXTERNALLINK TEXTCOLOR") {  
                 $$settings{textcolor} = $attr->{value};                  $$settings{textcolor} = $attr->{value};
             } elsif ("@state" eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {                } elsif ("@state" eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {  
                 $$settings{ishtml} = $attr->{value};                                                 $$settings{ishtml} = $attr->{value};
             } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {              } elsif ("@state" eq "EXTERNALLINK FLAGS ISAVAILABLE" ) {
                 $$settings{isavailable} = $attr->{value};                  $$settings{isavailable} = $attr->{value};
             } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {              } elsif ("@state" eq "EXTERNALLINK FLAGS LAUNCHINNEWWINDOW" ) {
Line 1549  sub addposting { Line 1622  sub addposting {
     }      }
     return $status;      return $status;
 }  }
 # ---------------------------------------------------------------- Process Blackboard Assessments - pools, quizzes, surveys  
 sub process_assessment {  sub parse_bb5_assessment {
     my ($context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles) = @_;      my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
     my $xmlfile = $docroot.'/'.$res.".dat";      my $xmlfile = $docroot.'/'.$res.".dat";
 #  print "XML file is $xmlfile\n";  #  print "XML file is $xmlfile\n";
     my @state = ();      my @state = ();
     my @allids = ();  
     my %allanswers = ();  
     my %allchoices = ();  
     my $id; # the current question ID      my $id; # the current question ID
     my $answer_id; # the current answer ID      my $answer_id; # the current answer ID
     my %toptag = ( pool => 'POOL',      my %toptag = ( pool => 'POOL',
Line 1603  sub process_assessment { Line 1673  sub process_assessment {
         }              }    
         if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {            if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {  
             $id = $attr->{id};              $id = $attr->{id};
             push @allids, $id;              push @{$allids}, $id;
             %{$$settings{$id}} = ();              %{$$settings{$id}} = ();
             @{$allanswers{$id}} = ();              @{$$allanswers{$id}} = ();
             $$settings{$id}{class} = $attr->{class};              $$settings{$id}{class} = $attr->{class};
             unless ($container eq "pool") {              unless ($container eq "pool") {
                 $$settings{$id}{points} = $attr->{points};                  $$settings{$id}{points} = $attr->{points};
Line 1627  sub process_assessment { Line 1697  sub process_assessment {
             $$settings{$id}{name} = $attr->{name};              $$settings{$id}{name} = $attr->{name};
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {          } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
             $answer_id = $attr->{id};              $answer_id = $attr->{id};
             push @{$allanswers{$id}},$answer_id;              push @{$$allanswers{$id}},$answer_id;
             %{$$settings{$id}{$answer_id}} = ();              %{$$settings{$id}{$answer_id}} = ();
             $$settings{$id}{$answer_id}{position} = $attr->{position};              $$settings{$id}{$answer_id}{position} = $attr->{position};
             if ($$settings{$id}{class} eq 'QUESTION_MATCH') {              if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
Line 1636  sub process_assessment { Line 1706  sub process_assessment {
             }              }
         } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {          } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
             $answer_id = $attr->{id};              $answer_id = $attr->{id};
             push @{$allchoices{$id}},$answer_id;               push @{$$allchoices{$id}},$answer_id; 
             %{$$settings{$id}{$answer_id}} = ();              %{$$settings{$id}{$answer_id}} = ();
             $$settings{$id}{$answer_id}{position} = $attr->{position};              $$settings{$id}{$answer_id}{position} = $attr->{position};
             $$settings{$id}{$answer_id}{placement} = $attr->{placement};              $$settings{$id}{$answer_id}{placement} = $attr->{placement};
Line 1699  sub process_assessment { Line 1769  sub process_assessment {
     $p->unbroken_text(1);      $p->unbroken_text(1);
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
   }
   
   sub parse_bb6_assessment {
        my ($res,$docroot,$container,$settings,$allanswers,$allchoices,$allids) = @_;
        return;
   }
   
   sub parse_webct4_assessment {
       my ($res,$docroot,$container,$allids) = @_;
       my $xmlfile = $docroot.'/quiz'.$res.".xml"; #quiz file
       print STDERR "XML file is $xmlfile\n";
       my @state = ();
       my $id; # the current question ID
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
           my $depth = 0;
           my @seq = ();
           my $class;
           if ("@state" eq "questestinterop assessment section itemref") {
               $id = $attr->{linkrefid}; 
               push(@{$allids},$id);
           }
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
         }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->parse_file($xmlfile);
       $p->eof;
   }
   
   sub parse_webct_quizprops {
       my ($res,$docroot,$container,$qzparams) = @_;
       my $xmlfile = $docroot.'/quiz'.$res.".xml"; #quiz file
       print STDERR "XML file is $xmlfile\n";
       my @state = ();
       %{$$qzparams{$res}} = ();
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           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"],
        text_h =>
        [sub {
           my ($text) = @_;
           if ($state[0] eq 'properties' && $state[1] eq 'delivery')  {
                if ($state[2] eq 'time_available') {
                   $$qzparams{$res}{opendate} = $text;
                } elsif ($state[2] eq 'time_due') {
                   $$qzparams{$res}{opendate} = $text;
                } elsif ($state[3] eq 'max_attempt') {
                   $$qzparams{$res}{tries} = $text;
                } elsif ($state[3] eq 'post_submission') {
                   $$qzparams{$res}{posts} = $text;
                }
           } elsif ($state[0] eq 'properties' && $state[1] eq 'result') {
                if ($state[2] eq 'display_answer') {
                   $$qzparams{$res}{answerdate} = $text;
                }
           } 
         }, "dtext"],
        end_h =>
        [sub {
           my ($tagname) = @_;
           pop @state;
        }, "tagname"],
       );
       $p->unbroken_text(1);
       $p->parse_file($xmlfile);
       $p->eof;
   }
   
   sub parse_webct4_questionDB {
       my ($docroot,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
       my $xmlfile = $docroot.'/questionDB.xml'; #quizDB file
       print STDERR "XML file is $xmlfile\n";
       my @state = ();
       my $category; # the current category ID
       my $id; # the current question ID
       my $list; # the current list ID for multiple choice questions
       my $numid; # the current answer ID for numerical questions
       my $grp; # the current group ID for matching questions
       my $label; # the current reponse label for string questions 
       my $str_id; # the current string ID for string questions
       my $unitid; # the current unit ID for numerical questions
       my $answer_id; # the current answer ID
       my $fdbk; # the current feedback ID
       my $maxvar; # the current max variable for numerical problems
       my $minvar; # the current min variable for numerical problems
       my $stepvar; # the current step variable for numerical problems
       my $fibtype; # the current fill-in-blank type fro numerical or string
       my $prompt; 
       my %setvar = (
                      varname => '',
                      action => '',
                    );  
       my $p = HTML::Parser->new
       (
        xml_mode => 1,
        start_h =>
        [sub {
           my ($tagname, $attr) = @_;
           push @state, $tagname;
           if ("@state" eq "questestinterop section") {
               $category = $attr->{ident};
               %{$$catinfo{$category}} = ();
               $$catinfo{$category}{title} = $attr->{title};   
           }
           if ("@state" eq "questestinterop section item") {
               $id = $attr->{ident};
               push @{$allids}, $id;
               push(@{$$catinfo{$category}{contents}},$id);
               %{$$settings{$id}} = ();
               @{$$settings{$id}{grps}} = ();
               @{$$settings{$id}{lists}} = ();
               @{$$settings{$id}{feedback}} = ();
               %{$$settings{$id}{strings}} = ();
               %{$$allanswers{$id}} = ();
               @{$$allanswers{$id}{strings}} = ();
               $$settings{$id}{title} = $attr->{title};
           }
   
   # Matching
           if ("@state" eq "questestinterop section item presentation material mattext") {
               $$settings{$id}{texttype} = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation response_grp") {
               $$settings{$id}{class} = 'QUESTION_MATCH';        
               $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 section item presentation response_grp material mattext") { 
               $$settings{$id}{$grp}{texttype} = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label") {
               $answer_id = $attr->{ident};
               push(@{$$allanswers{$id}{$grp}},$answer_id);
               %{$$settings{$id}{$grp}{$answer_id}} = ();
               $$settings{$id}{$grp}{$answer_id}{texttype} =  $attr->{texttype};
           }
   
   # Multiple choice
   
           if ("@state" eq "questestinterop section item presentation flow material mattext") {
               $$settings{$id}{texttype} = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid") {
               $$settings{$id}{class} = 'QUESTION_MULTIPLEANSWER';
               $list = $attr->{ident};
               push(@{$$settings{$id}{lists}},$list);
               %{$$settings{$id}{$list}} = ();
               @{$$allanswers{$id}{$list}} = ();
               @{$$settings{$id}{$list}{correctanswer}} = ();
               $$settings{$id}{$list}{rcardinality} = $attr->{rcardinality};
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice") {
               $$settings{$id}{$list}{randomize} = $attr->{shuffle};
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label") {
               $answer_id = $attr->{ident};
               push(@{$$allanswers{$id}{$list}},$answer_id);
               %{$$settings{$id}{$list}{$answer_id}} = ();
           }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
               $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
           }
   
   # Numerical
           if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
               $$settings{$id}{texttype} = $attr->{texttype};
           }
           if ("@state" eq "questestinterop section item presentation response_num") {
               $$settings{$id}{class} = 'QUESTION_NUMERICAL';
               $numid = $attr->{ident};
               %{$$settings{$id}{$numid}} = ();
               $$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") {            
               $minvar = $attr->{name};
               $$settings{$id}{$numid}{minvar} = $minvar;
           }
           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") {
               $maxvar = $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") {
               $stepvar = $attr->{name};
               $$settings{$id}{$numid}{stepvar} = $stepvar;
           }
           if ("@state" eq "questestinterop section item presentation response_num render_fib") {
               $fibtype = $attr->{fibtype};
               $prompt = $attr->{prompt};
           }
           if ("@state" eq "questestinterop section item presentation response_num render_fib response_label") {
               $$settings{$id}{$numid}{label} = $attr->{ident};
           }
   
   # String or Numerical
           if ("@state" eq "questestinterop section item presentation response_str") {
               $str_id = $attr->{ident};
               push(@{$$settings{$id}{str}},$str_id);
               %{$$settings{$id}{$str_id}} = ();
               $$settings{$id}{$str_id}{rcardinality} = $attr->{rcardinality};
           }
   
           if ("@state" eq "questestinterop section item presentation response_str render_fib") {
               $fibtype = $attr->{fibtype};
           }    
           if ("@state" eq "questestinterop section item presentation response_str render_fib response_label") {
               $label = $attr->{ident};
               %{$$settings{$id}{$str_id}{$label}} = ();
               push(@{$$allanswers{$id}{strings}},$label);
               @{$$settings{$id}{strings}{$label}} = ();
               $$settings{$id}{$str_id}{$label}{fibtype} = $fibtype;
           }
   
   # 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") {
               $$settings{$id}{$numid}{digits} = $attr->{digits};
               $$settings{$id}{$numid}{format} = $attr->{format};
           }
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
               $$settings{$id}{$numid}{toltype} = $attr->{type};
           }
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
               my $unitid = $attr->{ident};
               %{$$settings{$id}{$numid}{$unitid}} = ();
               $$settings{$id}{$numid}{$unitid}{value} = $attr->{value}; 
               $$settings{$id}{$numid}{$unitid}{space} = $attr->{space};
               $$settings{$id}{$numid}{$unitid}{case} = $attr->{case};
           }
   
   # Matching 
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
               $grp = $attr->{respident};
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar setvar") {
               $setvar{varname} = $attr->{varname};
               if ($setvar{varname} eq 'WebCT_Correct') {
                   push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
               }
           }
   
   # String 
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") {
               $$settings{$id}{class} = 'QUESTION_FILLINBLANK';
               $answer_id = $attr->{respident};
               $$settings{$id}{class} = '';
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar not") {
               $$settings{$id}{class} = 'QUESTION_ESSAY';
           }
    
   
   # Feedback
    
           if ("@state" eq "questestinterop section item respcondition displayfeedback") {
               $fdbk = $attr->{linkrefid};
               push(@{$$settings{$id}{feedback}},$fdbk);
               $$settings{$id}{$fdbk} = ();
               $$settings{$id}{$fdbk}{feedbacktype} = $attr->{feedbacktype};
           }
           if ("@state" eq "questestinterop section item itemfeedback") {
               $fdbk = $attr->{ident};
               $$settings{$id}{$fdbk}{view} = $attr->{view};
           }
           if ("@state" eq "questestinterop section item itemfeedback material mattext") {
               $$settings{$id}{$fdbk}{texttype} = $attr->{texttype};
           }
        }, "tagname, attr"],
        text_h =>
        [sub {
           my ($text) = @_;
           if ("@state" eq "questestinterop section item itemmetadata qmd_itemtype") {
               $$settings{$id}{itemtype} = $text;
           }
   
   #Matching
   
           if ("@state" eq "questestinterop section item presentation material mattext") {
               $$settings{$id}{text} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_grp material mattext") {
               $$settings{$id}{$grp}{text} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_grp render_choice response_label material mattext") {
               $$settings{$id}{$grp}{$answer_id}{text} = $text;
           }
   
   # Multiple choice
   
           if ("@state" eq "questestinterop section item presentation flow material mattext") {
               $$settings{$id}{text} = $text;
           }
   
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
               $$settings{$id}{$list}{$answer_id}{text} = $text;
           }
   
   # Numerical
           if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
               $$settings{$id}{text} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_minvalue webct:x_webct_v01_variable") {
                $$settings{$id}{$minvar}{min} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_maxvalue webct:x_webct_v01_variable") {
                $$settings{$id}{$maxvar}{max} = $text;
           }
           if ("@state" eq "questestinterop section item presentation response_num material mat_extension webct:x_webct_v01_dynamicdata webct:x_webct_v01_datarange webct:x_webct_v01_decimalnum webct:x_webct_v01_variable") {
                $$settings{$id}{$stepvar}{step} = $text;
           }
   
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varequal") {
               $answer_id = $text;
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar varsubset") { # String
               push(@{$$settings{$id}{strings}{$answer_id}},$text);
           }
           if ("@state" eq "questestinterop section item resprocessing respcondition conditionvar setvar") {
               if ($setvar{varname} eq "answerValue") { # Multiple Choice
                   if ($text =~ m/^\d+$/) {
                       if ($text > 0) {
                           push(@{$$settings{$id}{$list}{correctanswer}}),$answer_id;   
                       }
                   }
               }
           }
   
           if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_unit") {
               $$settings{$id}{$numid}{$unitid}{text} = $text;
           }
   
           if ("@state" eq "questestinterop section item itemfeedback 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 process_assessment {
       my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse) = @_;
       my @allids = ();
       my %allanswers = ();
       my %allchoices = ();
       my %qzparams = ();
       my @allquestids = ();
       my %catinfo = ();
       my %qzdbsettings = ();
       my %alldbanswers = ();
       my %alldbchoices = ();
       my @alldbquestids = ();
       my $containerdir;
       my $newdir;
       my $randompickflag = 0;
       my ($cid,$cdom,$cnum);
       if ($context eq 'DOCS') {
           $cid = $ENV{'request.course.id'};
           ($cdom,$cnum) = split/_/,$cid;
       }
       my $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|;
       }
       if ($cms eq 'bb5') {
           &parse_bb5_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
       } elsif ($cms eq 'bb6') {
           &parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
       } elsif ($cms eq 'webct4') {
           unless($$dbparse) {
               &parse_webct4_questionDB($docroot,\%catinfo,\%qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
               if (!-e "$destdir/sequences") {
                   mkdir("$destdir/sequences",0755);
               }
               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;
           }
           &parse_webct4_quizprops($res,$docroot,$container,\%qzparams);
           foreach (sort keys %qzparams) {
               if (exists($qzparams{$res}{numpick})) { 
                   if ($qzparams{$res}{numpick} < @allids) {
                       $$randompicks{$res} = $qzparams{$res}{numpick};
                       $randompickflag = 1;
                   }
               }
           }
           &parse_webct4_assessment($res,$docroot,$container,\@allids);
       }
     my $dirtitle = $$settings{'title'};      my $dirtitle = $$settings{'title'};
     $dirtitle =~ s/\W//g;      $dirtitle =~ s/\W//g;
     $dirtitle .= '_'.$res;      $dirtitle .= '_'.$res;
Line 1710  sub process_assessment { Line 2257  sub process_assessment {
         mkdir("$destdir/problems/$dirtitle",0755);          mkdir("$destdir/problems/$dirtitle",0755);
     }      }
     my $newdir = "$destdir/problems/$dirtitle";      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') {
           &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
       } elsif ($cms eq 'bb6') {
           &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
       }
   }
   
   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 $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 $containerdir;      if ($container eq 'pool' || $randompickflag || $container eq 'database') {
     if ($container eq 'pool') {          $$containerdir = $seqdir.'/'.$res.'.sequence';
         $containerdir = $seqdir.'/'.$res.'.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},$res.'.sequence';
     } else {      } else {
         $containerdir = $pagedir.'/'.$res.'.page';          $$containerdir = $pagedir.'/'.$res.'.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},$res.'.page';
     }      }
     print $fh qq|<map>      print $fh qq|<map>
 |;  |;
     my $probsrc = "/res/lib/templates/simpleproblem.problem";      my $probsrc = "/res/lib/templates/simpleproblem.problem";
     my ($cid,$cdom,$cnum);  
     if ($context eq 'DOCS') {  
         $cid = $ENV{'request.course.id'};  
         ($cdom,$cnum) = split/_/,$cid;  
     }  
     if ($context eq 'CSTR') {      if ($context eq 'CSTR') {
         $probsrc="/res/$udom/$uname/$dirname/problems/$dirtitle/$allids[0].problem";          $probsrc="/res/$udom/$uname/$dirname/problems/$dirtitle/$$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) {
         print $fh qq|          print $fh qq|
 <link from="1" to="2" index="1"></link>  <link from="1" to="2" index="1"></link>
 <resource id="2" src="" type="finish">\n|;  <resource id="2" src="" type="finish">\n|;
     } else {      } else {
         for (my $j=1; $j<@allids; $j++) {          for (my $j=1; $j<@{$allids}; $j++) {
             my $qntitle = $j;              my $qntitle = $j+1;
             while (length($qntitle) <4) {              while (length($qntitle) <4) {
                 $qntitle = '0'.$qntitle;                  $qntitle = '0'.$qntitle;
             }              }
             $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";                  $probsrc = "/res/$udom/$uname/$dirname/problems/$dirtitle/$$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>
 <resource id="$next_id" src="$probsrc" title="question_$qntitle"|;  <resource id="$next_id" src="$probsrc" title="question_$qntitle"|;
             if ($next_id == @allids) {              if ($next_id == @{$allids}) {
                 print $fh qq| type="finish"></resource>\n|;                  print $fh qq| type="finish"></resource>\n|;
             } else {              } else {
                 print $fh qq|></resource>|;                  print $fh qq|></resource>|;
Line 1772  sub process_assessment { Line 2324  sub process_assessment {
     }      }
     print $fh qq|</map>|;      print $fh qq|</map>|;
     close($fh);      close($fh);
   }
   
   sub write_bb5_questions {
       my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum) = @_;
     my $qnum = 0;      my $qnum = 0;
     foreach my $id (@allids) {      foreach my $id (@{$allids}) {
         $qnum ++;          $qnum ++;
         my $output;          my $output;
         my $permcontainer = $containerdir;          my $permcontainer = $containerdir;
Line 1785  sub process_assessment { Line 2341  sub process_assessment {
             $resourcedata{$symb.'text'.$iter} = "";              $resourcedata{$symb.'text'.$iter} = "";
             $resourcedata{$symb.'value'.$iter} = "unused";              $resourcedata{$symb.'value'.$iter} = "unused";
             $resourcedata{$symb.'position'.$iter} = "random";              $resourcedata{$symb.'position'.$iter} = "random";
         }            }
         $resourcedata{$symb.'randomize'} = 'yes';          $resourcedata{$symb.'randomize'} = 'yes';
         $resourcedata{$symb.'maxfoils'} = 10;          $resourcedata{$symb.'maxfoils'} = 10;
         if ($context eq 'CSTR') {          if ($context eq 'CSTR') {
Line 1800  sub process_assessment { Line 2356  sub process_assessment {
  <textfield></textfield>   <textfield></textfield>
  </essayresponse>   </essayresponse>
  <postanswerdate>   <postanswerdate>
  $$settings{$id}{feedbackcorr}    $$settings{$id}{feedbackcorr} 
  </postanswerdate>   </postanswerdate>
 |;  |;
              } else {               } else {
Line 1832  sub process_assessment { Line 2388  sub process_assessment {
                 $resourcedata{$symb.'questiontext'} .= $image.$imglink.$url;                  $resourcedata{$symb.'questiontext'} .= $image.$imglink.$url;
             }              }
             if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {              if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 if ($context eq 'CSTR') {                  if ($context eq 'CSTR') {
                     $output .= qq|                      $output .= qq|
  <radiobuttonresponse max="$numfoils" randomize="yes">   <radiobuttonresponse max="$numfoils" randomize="yes">
Line 1843  sub process_assessment { Line 2399  sub process_assessment {
                     $resourcedata{$symb.'questiontype'} = 'radio';                      $resourcedata{$symb.'questiontype'} = 'radio';
                     $resourcedata{$symb.'maxfoils'} = $numfoils;                      $resourcedata{$symb.'maxfoils'} = $numfoils;
                 }                  }
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                     my $iter = $k+1;                      my $iter = $k+1;
                     $output .= "   <foil name=\"foil".$k."\" value=\"";                      $output .= "   <foil name=\"foil".$k."\" value=\"";
                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {                      if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                         $output .= "true\" location=\"";                          $output .= "true\" location=\"";
                         $resourcedata{$symb.'value'.$iter} = "true";                          $resourcedata{$symb.'value'.$iter} = "true";
                     } else {                      } else {
                         $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)\sof\sthe\sabove\.?/) {
                         $output .= "bottom\"";                          $output .= "bottom\"";
                         $resourcedata{$symb.'position'.$iter} = "bottom";                          $resourcedata{$symb.'position'.$iter} = "bottom";
                     } else {                      } else {
                         $output .= "random\"";                          $output .= "random\"";
                     }                      }
                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};                      $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text};
                     $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};                      $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                     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="$dirname/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="$dirname/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 1880  sub process_assessment { Line 2436  sub process_assessment {
 |;  |;
                 }                  }
             } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {              } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 if ($context eq 'CSTR') {                  if ($context eq 'CSTR') {
                     $output .= qq|                      $output .= qq|
    <radiobuttonresponse max="$numfoils" randomize="yes">     <radiobuttonresponse max="$numfoils" randomize="yes">
Line 1891  sub process_assessment { Line 2447  sub process_assessment {
                     $resourcedata{$symb.'hiddenparts'} = '!radio';                      $resourcedata{$symb.'hiddenparts'} = '!radio';
                     $resourcedata{$symb.'questiontype'} = 'radio';                      $resourcedata{$symb.'questiontype'} = 'radio';
                 }                  }
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                     my $iter = $k+1;                      my $iter = $k+1;
                     $output .= "   <foil name=\"foil".$k."\" value=\"";                      $output .= "   <foil name=\"foil".$k."\" value=\"";
                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {                      if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                         $output .= "true\" location=\"random\"";                          $output .= "true\" location=\"random\"";
                         $resourcedata{$symb.'value'.$iter} = "true";                          $resourcedata{$symb.'value'.$iter} = "true";
                     } else {                      } else {
                         $output .= "false\" location=\"random\"";                          $output .= "false\" location=\"random\"";
                         $resourcedata{$symb.'value'.$iter} = "false";                          $resourcedata{$symb.'value'.$iter} = "false";
                     }                      }
                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";                      $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                     $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};                      $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                 }                  }
                 if ($context eq 'CSTR') {                  if ($context eq 'CSTR') {
                     chomp($output);                      chomp($output);
Line 1912  sub process_assessment { Line 2468  sub process_assessment {
 |;  |;
                 }                  }
             } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {              } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 if ($context eq 'CSTR') {                  if ($context eq 'CSTR') {
                     $output .= qq|                      $output .= qq|
    <optionresponse max="$numfoils" randomize="yes">     <optionresponse max="$numfoils" randomize="yes">
Line 1926  sub process_assessment { Line 2482  sub process_assessment {
                     $resourcedata{$symb.'questiontype'} = 'option';                      $resourcedata{$symb.'questiontype'} = 'option';
                     $resourcedata{$symb.'maxfoils'} = $numfoils;                      $resourcedata{$symb.'maxfoils'} = $numfoils;
                 }                  }
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                     my $iter = $k+1;                      my $iter = $k+1;
                     $output .= "   <foil name=\"foil".$k."\" value=\"";                      $output .= "   <foil name=\"foil".$k."\" value=\"";
                     if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {                      if (grep/^$$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
                         $output .= "True\"";                          $output .= "True\"";
                         $resourcedata{$symb.'value'.$iter} = "True";                          $resourcedata{$symb.'value'.$iter} = "True";
                     } else {                      } else {
                         $output .= "False\"";                          $output .= "False\"";
                         $resourcedata{$symb.'value'.$iter} = "False";                          $resourcedata{$symb.'value'.$iter} = "False";
                     }                      }
                     $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";                      $output .= "\><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                     $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};                      $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                 }                  }
                 if ($context eq 'CSTR') {                    if ($context eq 'CSTR') {  
                     chomp($output);                      chomp($output);
Line 1947  sub process_assessment { Line 2503  sub process_assessment {
 |;  |;
                 }                  }
             } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {              } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
                 my $numfoils = @{$allanswers{$id}};                  my $numfoils = @{$$allanswers{$id}};
                 my @allorder = ();                  my @allorder = ();
                 if ($context eq 'CSTR') {                  if ($context eq 'CSTR') {
                     $output .= qq|                      $output .= qq|
Line 1961  sub process_assessment { Line 2517  sub process_assessment {
                     $resourcedata{$symb.'questiontype'} = 'option';                      $resourcedata{$symb.'questiontype'} = 'option';
                     $resourcedata{$symb.'maxfoils'} = $numfoils;                      $resourcedata{$symb.'maxfoils'} = $numfoils;
                 }                  }
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                     if ($context eq 'CSTR') {                      if ($context eq 'CSTR') {
                         $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";                          $output .= "   <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
                     } else {                      } else {
                         my $iter = $k+1;                          my $iter = $k+1;
                         $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};                          $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                         if (!grep/^$$settings{$id}{$allanswers{$id}[$k]}{order}$/,@allorder) {                          if (!grep/^$$settings{$id}{$$allanswers{$id}[$k]}{order}$/,@allorder) {
                             push @allorder, $$settings{$id}{$allanswers{$id}[$k]}{order};                              push @allorder, $$settings{$id}{$$allanswers{$id}[$k]}{order};
                         }                          }
                     }                      }
                 }                  }
Line 1987  sub process_assessment { Line 2543  sub process_assessment {
                 if ($context eq 'DOCS') {                  if ($context eq 'DOCS') {
                     $numerical = 0;                      $numerical = 0;
                 } else {                  } else {
                     for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                      for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                         if ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {                          if ($$settings{$id}{$$allanswers{$id}[$k]}{text} =~ m/([^\d\.]|\.\.)/) {
                             $numerical = 0;                              $numerical = 0;
                         }                          }
                     }                      }
Line 1996  sub process_assessment { Line 2552  sub process_assessment {
                 if ($numerical) {                  if ($numerical) {
                     my $numans;                      my $numans;
                     my $tol;                      my $tol;
                     if (@{$allanswers{$id}} == 1) {                      if (@{$$allanswers{$id}} == 1) {
                         $tol = 5;                          $tol = 5;
                         $numans = $$settings{$id}{$allanswers{$id}[0]}{text};                          $numans = $$settings{$id}{$$allanswers{$id}[0]}{text};
                     } else {                      } else {
                         my $min = $$settings{$id}{$allanswers{$id}[0]}{text};                          my $min = $$settings{$id}{$$allanswers{$id}[0]}{text};
                         my $max = $$settings{$id}{$allanswers{$id}[0]}{text};                          my $max = $$settings{$id}{$$allanswers{$id}[0]}{text};
                         for (my $k=1; $k<@{$allanswers{$id}}; $k++) {                          for (my $k=1; $k<@{$$allanswers{$id}}; $k++) {
                             if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {                              if ($$settings{$id}{$$allanswers{$id}[$k]}{text} <= $min) {
                                 $min = $$settings{$id}{$allanswers{$id}[$k]}{text};                                  $min = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                             }                              }
                             if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {                              if ($$settings{$id}{$$allanswers{$id}[$k]}{text} >= $max) {
                                 $max = $$settings{$id}{$allanswers{$id}[$k]}{text};                                  $max = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                             }                              }
                         }                          }
                         $numans = ($max + $min)/2;                          $numans = ($max + $min)/2;
Line 2027  sub process_assessment { Line 2583  sub process_assessment {
                     if ($context eq 'DOCS') {                      if ($context eq 'DOCS') {
                         $resourcedata{$symb.'hiddenparts'} = '!string';                          $resourcedata{$symb.'hiddenparts'} = '!string';
                         $resourcedata{$symb.'questiontype'} = 'string';                          $resourcedata{$symb.'questiontype'} = 'string';
                         $resourcedata{$symb.'maxfoils'} = @{$allanswers{$id}};                          $resourcedata{$symb.'maxfoils'} = @{$$allanswers{$id}};
                         $resourcedata{$symb.'hiddenparts'} = '!string';                          $resourcedata{$symb.'hiddenparts'} = '!string';
                         $resourcedata{$symb.'stringtype'} = 'ci';                          $resourcedata{$symb.'stringtype'} = 'ci';
                         $resourcedata{$symb.'stringanswer'} = $$settings{$id}{$allanswers{$id}[0]}{text};                          $resourcedata{$symb.'stringanswer'} = $$settings{$id}{$$allanswers{$id}[0]}{text};
                     } else {                      } else {
                         if (@{$allanswers{$id}} == 1) {                          if (@{$$allanswers{$id}} == 1) {
                             $output .= qq|                              $output .= qq|
 <stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">  <stringresponse answer="$$settings{$id}{$$allanswers{$id}[0]}{text}" type="ci">
 <textline>  <textline>
 </textline>  </textline>
 </stringresponse>  </stringresponse>
 |;  |;
                         } else {                          } else {
                             my @answertext = ();                              my @answertext = ();
                             for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                              for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                                 $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;                                  $$settings{$id}{$$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
                                 push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};                                  push @answertext, $$settings{$id}{$$allanswers{$id}[$k]}{text};
                             }                              }
                             my $regexpans = join('|',@answertext);                              my $regexpans = join('|',@answertext);
                             $regexpans = '/^('.$regexpans.')\b/';                              $regexpans = '/^('.$regexpans.')\b/';
Line 2070  sub process_assessment { Line 2626  sub process_assessment {
                     $resourcedata{$symb.'delopt'} = '';                      $resourcedata{$symb.'delopt'} = '';
                     $resourcedata{$symb.'hiddenparts'} = '!option';                      $resourcedata{$symb.'hiddenparts'} = '!option';
                     $resourcedata{$symb.'questiontype'} = 'option';                      $resourcedata{$symb.'questiontype'} = 'option';
                     $resourcedata{$symb.'maxfoils'} =  @{$allanswers{$id}};                      $resourcedata{$symb.'maxfoils'} =  @{$$allanswers{$id}};
                 }                  }
                 for (my $k=0; $k<@{$allchoices{$id}}; $k++) {                  for (my $k=0; $k<@{$$allchoices{$id}}; $k++) {
                     if ($context eq 'CSTR') {                      if ($context eq 'CSTR') {
                         $output .= qq|                          $output .= qq|
 <item name="$allchoices{$id}[$k]">  <item name="$$allchoices{$id}[$k]">
 <startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />  <startouttext />$$settings{$id}{$$allchoices{$id}[$k]}{text}<endouttext />
 </item>  </item>
                     |;                      |;
                     } else {                      } else {
                         if (!grep/^$$settings{$id}{$allchoices{$id}[$k]}{text}$/,@allmatchers) {                          if (!grep/^$$settings{$id}{$$allchoices{$id}[$k]}{text}$/,@allmatchers) {
                             push @allmatchers, $$settings{$id}{$allchoices{$id}[$k]}{text};                              push @allmatchers, $$settings{$id}{$$allchoices{$id}[$k]}{text};
                             $matchtext{$allchoices{$id}[$k]} = $$settings{$id}{$allchoices{$id}[$k]}{text};                              $matchtext{$$allchoices{$id}[$k]} = $$settings{$id}{$$allchoices{$id}[$k]}{text};
                         }                          }
                     }                      }
                 }                  }
Line 2091  sub process_assessment { Line 2647  sub process_assessment {
         </itemgroup>          </itemgroup>
 |;  |;
                 }                  }
                 for (my $k=0; $k<@{$allanswers{$id}}; $k++) {                  for (my $k=0; $k<@{$$allanswers{$id}}; $k++) {
                     if ($context eq 'CSTR') {                      if ($context eq 'CSTR') {
                         $output .= qq|                          $output .= qq|
         <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">          <foil location="random" value="$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}" name="$$allanswers{$id}[$k]">
          <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />           <startouttext />$$settings{$id}{$$allanswers{$id}[$k]}{text}<endouttext />
         </foil>          </foil>
 |;  |;
                     } else {                      } else {
                         my $iter = $k+1;                          my $iter = $k+1;
                         $resourcedata{$symb.'value'.$iter} = $matchtext{$$settings{$id}{$allanswers{$id}[$k]}{choice_id}};                          $resourcedata{$symb.'value'.$iter} = $matchtext{$$settings{$id}{$$allanswers{$id}[$k]}{choice_id}};
                         $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$allanswers{$id}[$k]}{text};                          $resourcedata{$symb.'text'.$iter} = $$settings{$id}{$$allanswers{$id}[$k]}{text};
                     }                      }
                 }                  }
                 if ($context eq 'CSTR') {                  if ($context eq 'CSTR') {
Line 2128  sub process_assessment { Line 2684  sub process_assessment {
     }      }
 }  }
   
   sub write_webct4_questions {
       my ($alldbquestids,$context,$settings,$dirname,$alldbanswers,$alldbchoices,$total,$cid,$cdom,$cnum) = @_;
   }
   
   sub write_bb6_questions {
       my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices) = @_;
   }
   
 # ---------------------------------------------------------------- Process Blackboard Announcements  # ---------------------------------------------------------------- Process Blackboard Announcements
 sub process_announce {  sub process_announce {
     my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;      my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;
Line 2222  sub process_content { Line 2786  sub process_content {
     my $xmlfile = $docroot.'/'.$res.".dat";      my $xmlfile = $docroot.'/'.$res.".dat";
     my $destresdir = $destdir;      my $destresdir = $destdir;
     if ($context eq 'CSTR') {      if ($context eq 'CSTR') {
 #        $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;          $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
         $destresdir =~ s|/home/$user/public_html/|/priv/$user/|;  
     } elsif ($context eq 'DOCS') {      } elsif ($context eq 'DOCS') {
         $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;          $destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
     }      }
Line 2643  sub angel_content { Line 3206  sub angel_content {
     close(FILE);      close(FILE);
 }  }
   
   # ---------------------------------------------------------------- WebCT content
   sub webct4_content {
       my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
       if (!open(FILE,">$destdir/resfiles/$res.html")) {
           &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
       } else {
           push(@{$resrcfiles}, "$res.html");
           my $linktag = '';
           if (defined($$settings{url})) {
               $linktag = qq|<a href="$$settings{url}"|;
               if ($title ne '') {
                   $linktag .= qq|>$title</a>|;
               } else {
                   $linktag .= qq|>$$settings{url}|;
               }
           }
           print FILE qq|<html>
   <head>
   <title>$title</title>
   </head>
   <body bgcolor='#ffffff'>
   $linktag
   </body>
   </html>|;
           close(FILE);
       }
   }
   
   # ---------------------------------------------------------------- WebCT assessments
   sub webct4_assessment {
       my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
       print STDERR "webct assessment detected - $res, $docroot, $destdir, $type,$title\n";
   }
   
 1;  1;
 __END__  __END__
Removed from v.1.14  
changed lines
  Added in v.1.15

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