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

Diff for /loncom/imspackages/imsprocessor.pm between versions 1.16 and 1.19

version 1.16, 2005/03/15 15:25:32 version 1.19, 2005/04/07 06:56:22
Line 95  sub uploadzip { Line 95  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 107  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 128  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 177  sub process_manifest { Line 171  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';
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
Line 187  sub process_manifest { Line 181  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;  
                 my $statestr = '';  
                 foreach (@state) {  
                     $statestr .= "$_ ";  
                 }  
                 if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {                  if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {
                     my $searchstr = "manifest organizations $toc{$cms}";                      if ($state[-1] eq 'item') {
                     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}} = ();
Line 260  sub process_manifest { Line 244  sub process_manifest {
                         }                          }
                     }                      }
                     if ($cms eq 'webct4') {                      if ($cms eq 'webct4') {
                         if ("@state" eq "$searchstr webct:properties") {                          if (($state[-1] eq "webct:properties") && (@state > 4)) {
                             $$items{$itm}{properties} = $attr->{identifierref};                              $$items{$itm}{properties} = $attr->{identifierref};
                         }                          }
                     }                      }
Line 392  sub copy_resources { Line 376  sub copy_resources {
                             $copyfile = $1;                              $copyfile = $1;
                         }                          }
                     }                      }
                     unless (($cms eq 'webct4') && ($copyfile eq 'questionDB.xml' || $copyfile =~ m/^quiz_QIZ_\d+\.xml$/)) {                      unless (($cms eq 'webct4') && ($copyfile =~ m/questionDB\.xml$/ || $copyfile =~ m/quiz_QIZ_\d+\.xml$/ || $copyfile =~ m/properties_QIZ_\d+\.xml$/)) {
                         $copyfile = $fpath.$copyfile;                          $copyfile = $fpath.$copyfile;
                         my $fileresult;                          my $fileresult;
                         if (-e $source) {                          if (-e $source) {
Line 447  sub copy_resources { Line 431  sub copy_resources {
                             if (-e "$tempdir/$file") {                              if (-e "$tempdir/$file") {
                                 rename("$tempdir/$file","$destdir/resfiles/$copyfile");                                  rename("$tempdir/$file","$destdir/resfiles/$copyfile");
                             }                              }
                         } elsif ($file =~ m-/data/(.+)$-) {                          } elsif ($file !~ m-/data/(.+)$-) {
                             print STDERR "File $file is a WebCT data file \n";                              &Apache::lonnet::logthis("IMS import error: WebCT4 - file $file is in unexpected location");
                         } else {  
                             print STDERR "File $file is in unexpected location\n";  
                         }                          }
                     }                      }
                 }                  }
Line 466  sub process_resinfo { Line 448  sub process_resinfo {
     my $dbparse = 0;      my $dbparse = 0;
     my $announce_handling = 'include';      my $announce_handling = 'include';
     my $longcrs = '';      my $longcrs = '';
       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 529  sub process_resinfo { Line 513  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($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);                  &process_assessment($cms,$context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
                 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($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);                  &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
                 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($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);                  &process_assessment($cms,$context,$key,$docroot,'survey',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs);
                 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 579  sub process_resinfo { Line 563  sub process_resinfo {
                     %{$$resinfo{$key}} = ();                      %{$$resinfo{$key}} = ();
                     &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);                      &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);
                     &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items);  
                 }                  }
             }              }
         }          }
Line 670  sub build_structure { Line 653  sub build_structure {
 <resource id="$next_id" src="" type="finish"></resource>\n|;  <resource id="$next_id" src="" type="finish"></resource>\n|;
                 }                  }
             } else {              } else {
                 print "key is $key\n";  
                 my $contcount = 0;                  my $contcount = 0;
                 if (defined($$items{$key}{contents})) {                   if (defined($$items{$key}{contents})) { 
                     $contcount = @{$$items{$key}{contents}};                      $contcount = @{$$items{$key}{contents}};
                 } else {                  } else {
                     print STDERR "not defined for $key\n";                      &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}; 
Line 691  sub build_structure { Line 673  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,$file,$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});
                 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 727  sub build_structure { Line 713  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,$file,$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});
   
                             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 755  sub build_structure { Line 745  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,$file,$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});
   
                     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 765  sub build_structure { Line 755  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 877  sub build_structure { Line 872  sub build_structure {
 }  }
   
 sub make_structure {  sub make_structure {
     my ($cms,$key,$srcstem,$flag,$count,$timestamp,$boardnum,$hrefs,$pagecontents,$res,$type,$file,$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) = @_;
     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 '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;
         $$count{$key}{seq} ++;          $$count{$key}{seq} ++;
       } elsif ($cms eq 'webct4' && $randompick) {
           $src = $srcstem.'/sequences/'.$res.'.sequence';
           $$flag{$key}{page} = 0;
           $$flag{$key}{seq} = 1;
           $$count{$key}{seq} ++;
     } elsif ($cms eq 'angel' && $type eq 'BOARD') {      } elsif ($cms eq 'angel' && $type eq 'BOARD') {
         $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard';           $src = '/adm/'.$cdom.'/'.$uname.'/'.$$timestamp[$$boardnum{$res}].'/bulletinboard'; 
         $$flag{$key}{page} = 0;          $$flag{$key}{page} = 0;
Line 900  sub make_structure { Line 900  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 928  sub make_structure { Line 928  sub make_structure {
             $$flag{$key}{seq} = 0;              $$flag{$key}{seq} = 0;
         }          }
     } elsif ($cms eq 'webct4') {      } elsif ($cms eq 'webct4') {
         unless ($type eq 'webctquiz') {          if ($type eq 'webctquiz') {
               $src =  $srcstem.'/pages/'.$res.'.page';
               $$count{$key}{page} ++;
               $$flag{$key}{seq} = 0;
           } else {
             if (grep/^$file$/,@{$$hrefs{$res}}) {              if (grep/^$file$/,@{$$hrefs{$res}}) {
                 my $filename;                  my $filename;
                 if ($file =~ m-/([^/]+)$-) {                  if ($file =~ m-/([^/]+)$-) {
Line 1827  sub parse_bb6_assessment { Line 1831  sub parse_bb6_assessment {
 sub parse_webct4_assessment {  sub parse_webct4_assessment {
     my ($res,$docroot,$href,$container,$allids) = @_;      my ($res,$docroot,$href,$container,$allids) = @_;
     my $xmlfile = $docroot.'/'.$href; #quiz file      my $xmlfile = $docroot.'/'.$href; #quiz file
     print STDERR "quiz file -- 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 1862  sub parse_webct4_assessment { Line 1865  sub parse_webct4_assessment {
 sub parse_webct4_quizprops {  sub parse_webct4_quizprops {
     my ($res,$docroot,$href,$container,$qzparams) = @_;      my ($res,$docroot,$href,$container,$qzparams) = @_;
     my $xmlfile = $docroot.'/'.$href; #properties file      my $xmlfile = $docroot.'/'.$href; #properties file
     print STDERR "props file -- XML file is $xmlfile\n";  
     my @state = ();      my @state = ();
     %{$$qzparams{$res}} = ();      %{$$qzparams{$res}} = ();
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
Line 1872  sub parse_webct4_quizprops { Line 1874  sub parse_webct4_quizprops {
      [sub {       [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          push @state, $tagname;
         my $depth = 0;  
         my @seq = ();  
         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 {
Line 1889  sub parse_webct4_quizprops { Line 1882  sub parse_webct4_quizprops {
             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"],
Line 2269  sub parse_webct4_questionDB { Line 2270  sub parse_webct4_questionDB {
 }  }
   
 sub process_assessment {  sub process_assessment {
     my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items) = @_;      my ($cms,$context,$res,$docroot,$container,$dirname,$destdir,$settings,$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,$dbparse,$resources,$items,$catinfo,$qzdbsettings,$hrefs) = @_;
     my @allids = ();      my @allids = ();
     my %allanswers = ();      my %allanswers = ();
     my %allchoices = ();      my %allchoices = ();
     my %qzparams = ();      my %qzparams = ();
     my @allquestids = ();      my @allquestids = ();
     my %catinfo = ();  
     my %qzdbsettings = ();  
     my %alldbanswers = ();      my %alldbanswers = ();
     my %alldbchoices = ();      my %alldbchoices = ();
     my @alldbquestids = ();      my @alldbquestids = ();
Line 2285  sub process_assessment { Line 2284  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 2300  sub process_assessment { Line 2299  sub process_assessment {
         &parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);          &parse_bb6_assessment($res,$docroot,$container,$settings,\%allanswers,\%allchoices,\@allids);
     } elsif ($cms eq 'webct4') {      } elsif ($cms eq 'webct4') {
         unless($$dbparse) {          unless($$dbparse) {
             &parse_webct4_questionDB($docroot,$$resources{$res}{file},\%catinfo,\%qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);              &parse_webct4_questionDB($docroot,$$resources{$res}{file},$catinfo,$qzdbsettings,\%alldbanswers,\%alldbchoices,\@alldbquestids);
             if (!-e "$destdir/sequences") {              if (!-e "$destdir/sequences") {
                 mkdir("$destdir/sequences",0755);                  mkdir("$destdir/sequences",0755);
             }              }
             my $numcats = scalar(keys %catinfo);              my $numcats = scalar(keys %{$catinfo});
             my $curr_id = 0;              my $curr_id = 0;
             my $next_id = 1;              my $next_id = 1;
             my $fh;              my $fh;
             open($fh,">$destdir/sequences/question_database.sequence");              open($fh,">$destdir/sequences/question_database.sequence");
             push @{$sequencesfiles},'question_database.sequence';              push @{$sequencesfiles},'question_database.sequence';
             foreach my $category (sort keys %catinfo) {              foreach my $category (sort keys %{$catinfo}) {
                 my $seqname = $catinfo{$category}{title}.'_'.$category;                  my $seqname = $$catinfo{$category}{title}.'_'.$category;
                 $seqname =~ s/\s/_/g;                  $seqname =~ s/\s/_/g;
                 $seqname =~ s/\W//g;                  $seqname =~ s/\W//g;
                 push(@{$sequencesfiles},$seqname.'.sequence');                  push(@{$sequencesfiles},$seqname.'.sequence');
                 my $catsrc = "$destresdir/sequences/$seqname.sequence";                  my $catsrc = "$destresdir/sequences/$seqname.sequence";
                 if ($curr_id == 0) {                  if ($curr_id == 0) {
                     print $fh qq|<resource id="1" src="$catsrc" type="start" title="$catinfo{$category}{title}"></resource>|;                      print $fh qq|<resource id="1" src="$catsrc" type="start" title="$$catinfo{$category}{title}"></resource>|;
                 }                  }
                 if ($numcats == 1) {                  if ($numcats == 1) {
                     print $fh qq|                      print $fh qq|
Line 2329  sub process_assessment { Line 2328  sub process_assessment {
                     $catsrc = "$destresdir/sequences/$seqname.sequence";                      $catsrc = "$destresdir/sequences/$seqname.sequence";
                     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="$catsrc" title="$catinfo{$category}{title}"|;  <resource id="$next_id" src="$catsrc" title="$$catinfo{$category}{title}"|;
                     if ($next_id == $numcats) {                      if ($next_id == $numcats) {
                         print $fh qq| type="finish"></resource>\n|;                          print $fh qq| type="finish"></resource>\n|;
                     } else {                      } else {
Line 2345  sub process_assessment { Line 2344  sub process_assessment {
                 }                  }
                 my $newdir = "$destdir/problems/$seqname";                  my $newdir = "$destdir/problems/$seqname";
                 my $dbcontainerdir;                  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);                  &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);              close($fh);
             &write_webct4_questions(\@alldbquestids,$context,\%qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,\%catinfo);              &write_webct4_questions(\@alldbquestids,$context,$qzdbsettings,$dirname,\%alldbanswers,\%alldbchoices,$total,$cid,$cdom,$cnum,$destdir,$catinfo);
             $$dbparse = 1;              $$dbparse = 1;
         }          }
         &parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);          &parse_webct4_assessment($res,$docroot,$$resources{$res}{file},$container,\@allids);
         &parse_webct4_quizprops($res,$docroot,$$resources{$$items{$$resources{$res}{revitm}}{properties}}{file},$container,\%qzparams);          &parse_webct4_quizprops($res,$docroot,$$hrefs{$$items{$$resources{$res}{revitm}}{properties}}[0],$container,\%qzparams);
         foreach (sort keys %qzparams) {          if (exists($qzparams{$res}{numpick})) { 
             if (exists($qzparams{$res}{numpick})) {               if ($qzparams{$res}{numpick} < @allids) {
                 if ($qzparams{$res}{numpick} < @allids) {                  $$randompicks{$$resources{$res}{revitm}} = $qzparams{$res}{numpick};
                     $$randompicks{$res} = $qzparams{$res}{numpick};                  $randompickflag = 1;
                     $randompickflag = 1;  
                 }  
             }              }
         }          }
     }      }
Line 2376  sub process_assessment { Line 2373  sub process_assessment {
         my $newdir = "$destdir/problems/$dirtitle";          my $newdir = "$destdir/problems/$dirtitle";
     }      }
   
     &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,\%catinfo,\%qzdbsettings);      &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
     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,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
     } elsif ($cms eq 'bb6') {      } elsif ($cms eq 'bb6') {
Line 2410  sub build_problem_container { Line 2407  sub build_problem_container {
     }      }
     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') {
           foreach my $id (@{$allids}) {
               $probtitle{$id} = $$settings{$id}{title};
               $probtitle{$id} =~ s/\s/_/g;
               $probtitle{$id} =~ s/\W//g;
               $probtitle{$id} .= '_'.$id;
           }
         if ($cms eq 'webct4' && $container ne 'database') {          if ($cms eq 'webct4' && $container ne 'database') {
             my $catid = $$settings{$$allids[0]}{category};              my $catid = $$settings{$$allids[0]}{category};
             my $probdir = $$catinfo{$catid}{title}.'_'.$catid;              my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
             $probdir =~ s/\s/_/g;              $probdir =~ s/\s/_/g;
             $probdir =~ s/\W//g;              $probdir =~ s/\W//g;
             $probsrc = "$dirname/problems/$probdir/$$allids[0].problem";              $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
         } else {          } else {
             $probsrc="$dirname/problems/$dirtitle/$$allids[0].problem";              $probsrc="$dirname/problems/$dirtitle/$$allids[0].problem";
         }          }
Line 2441  sub build_problem_container { Line 2445  sub build_problem_container {
                     my $probdir = $$catinfo{$catid}{title}.'_'.$catid;                      my $probdir = $$catinfo{$catid}{title}.'_'.$catid;
                     $probdir =~ s/\s/_/g;                      $probdir =~ s/\s/_/g;
                     $probdir =~ s/\W//g;                      $probdir =~ s/\W//g;
                     $probsrc = "$dirname/problems/$probdir/$$allids[$j].problem";                      $probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
                 } else {                  } else {
                     $probsrc = "$dirname/problems/$dirtitle/$$allids[$j].problem";                      $probsrc = "$dirname/problems/$dirtitle/$$allids[$j].problem";
                 }                  }
Line 3873  $linktag Line 3877  $linktag
     }      }
 }  }
   
 # ---------------------------------------------------------------- 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.16  
changed lines
  Added in v.1.19

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