[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.17

version 1.16, 2005/03/15 15:25:32 version 1.17, 2005/03/23 19:54:27
Line 177  sub process_manifest { Line 177  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 187  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 250  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 382  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 437  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 454  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 519  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);
                 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);
                 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);
                 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 569  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);
                     &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 659  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 900  sub make_structure { Line 888  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 916  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';
           } 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 1817  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 1851  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 2269  sub parse_webct4_questionDB { Line 2257  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) = @_;
     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 2300  sub process_assessment { Line 2286  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 2315  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 2331  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);
Line 2376  sub process_assessment { Line 2362  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 2396  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 2434  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 3866  $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.17

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