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

Diff for /loncom/imspackages/imsprocessor.pm between versions 1.43 and 1.44

version 1.43, 2008/08/23 21:08:29 version 1.44, 2008/08/25 13:43:39
Line 635  sub process_resinfo { Line 635  sub process_resinfo {
             if (grep/^$key$/,@{$targets}) {              if (grep/^$key$/,@{$targets}) {
                 if ($$resources{$key}{type} eq "webcontent") {                  if ($$resources{$key}{type} eq "webcontent") {
                     %{$$resinfo{$key}} = ();                      %{$$resinfo{$key}} = ();
                     &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);                      if ($$resources{$key}{file} eq 'questiondb.xml') {
                           &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                       } else {
                           &webct4_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
                       }
                 } elsif ($$resources{$key}{type} eq "webctquiz") {                  } elsif ($$resources{$key}{type} eq "webctquiz") {
                     &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);                      &process_assessment($cms,$context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles,$randompicks,\$dbparse,$resources,$items,\%catinfo,\%qzdbsettings,$hrefs,\%allquestions);
                 }                  }
Line 2775  sub parse_webct4_quizprops { Line 2779  sub parse_webct4_quizprops {
   
 sub parse_webct4_questionDB {  sub parse_webct4_questionDB {
     my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;      my ($docroot,$href,$catinfo,$settings,$allanswers,$allchoices,$allids) = @_;
     $href =~ s#[^/]+$##;      my $xmlfile;
     my $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file      if ($href eq 'questiondb.xml') {
           $xmlfile = $docroot.'/'.$href;
       } else {
           $href =~ s#[^/]+$##;
           $xmlfile = $docroot.'/'.$href.'questionDB.xml'; #quizDB file
       }
     my @state = ();      my @state = ();
     my $category; # the current category ID      my $category; # the current category ID
     my $id; # the current question ID      my $id; # the current question ID
Line 2797  sub parse_webct4_questionDB { Line 2806  sub parse_webct4_questionDB {
                    action => '',                     action => '',
                  );                   );
     my $currtexttype;      my $currtexttype;
     my $currimagtype;        my $currimagtype;
       my $is_objectbank;
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
     (      (
      xml_mode => 1,       xml_mode => 1,
      start_h =>       start_h =>
      [sub {       [sub {
         my ($tagname, $attr) = @_;          my ($tagname, $attr) = @_;
         push @state, $tagname;          if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
               $is_objectbank = 1;
           } else {
               push @state, $tagname;
           }
         if ("@state" eq "questestinterop section") {          if ("@state" eq "questestinterop section") {
             $category = $attr->{ident};              $category = $attr->{ident};
             %{$$catinfo{$category}} = ();              %{$$catinfo{$category}} = ();
Line 2893  sub parse_webct4_questionDB { Line 2907  sub parse_webct4_questionDB {
             $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};              $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
             $currtexttype = $attr->{texttype};              $currtexttype = $attr->{texttype};
         }          }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") {
               $$settings{$id}{$list}{$answer_id}{texttype} = $attr->{texttype};
               $currtexttype = $attr->{texttype};
           }
   
 # Numerical  # Numerical
         if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {          if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
Line 2979  sub parse_webct4_questionDB { Line 2997  sub parse_webct4_questionDB {
             }               } 
         }          }
         if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {          if ("@state" eq "questestinterop section item resprocessing respcondition setvar") {
             $setvar{varname} = $attr->{varname};              foreach my $key (keys(%{$attr})) {
                   $setvar{$key} = $attr->{$key};
               }
             if ($setvar{varname} eq 'WebCT_Correct') {              if ($setvar{varname} eq 'WebCT_Correct') {
                 push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);                  push(@{$$settings{$id}{$grp}{correctanswer}},$answer_id);
             }              }
Line 3010  sub parse_webct4_questionDB { Line 3030  sub parse_webct4_questionDB {
         }          }
         if ("@state" eq "questestinterop section item itemfeedback") {          if ("@state" eq "questestinterop section item itemfeedback") {
             $fdbk = $attr->{ident};              $fdbk = $attr->{ident};
               push(@{$$settings{$id}{feedback}},$fdbk);
             $$settings{$id}{$fdbk}{view} = $attr->{view};              $$settings{$id}{$fdbk}{view} = $attr->{view};
         }          }
         if ("@state" eq "questestinterop section item itemfeedback material mattext") {          if ("@state" eq "questestinterop section item itemfeedback material mattext") {
Line 3053  sub parse_webct4_questionDB { Line 3074  sub parse_webct4_questionDB {
         if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {          if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label material mattext") {
             $$settings{$id}{$list}{$answer_id}{text} = $text;              $$settings{$id}{$list}{$answer_id}{text} = $text;
         }          }
           if ("@state" eq "questestinterop section item presentation flow response_lid render_choice flow_label response_label flow_mat material mattext") {
               $$settings{$id}{$list}{$answer_id}{text} = $text;
           }
   
 # Numerical  # Numerical
         if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {          if ("@state" eq "questestinterop section item presentation material mat_extension webct:x_webct_v01_dynamicmattext") {
Line 3103  sub parse_webct4_questionDB { Line 3127  sub parse_webct4_questionDB {
                         push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);                          push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
                     }                      }
                 }                  }
               } elsif ($is_objectbank) { #Multiple Choice WebCT 4.1 D2L objectbank
                   if ($setvar{action} eq "Set") {
                       if ($text =~ /^\d+\.?\d*$/) {
                           if ($text > 0.000000001) {
                               push(@{$$settings{$id}{$list}{correctanswer}},$answer_id);
                           }
                       }
                   }
             }              }
         }          }
         if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {          if ("@state" eq "questestinterop section item resprocessing itemproc_extension webct:x_webct_v01_autocalculate webct:x_webct_v01_anstolerance") {
Line 3119  sub parse_webct4_questionDB { Line 3151  sub parse_webct4_questionDB {
      end_h =>       end_h =>
      [sub {       [sub {
         my ($tagname) = @_;          my ($tagname) = @_;
         pop @state;          if (("@state" eq "questestinterop") && ($tagname eq 'objectbank')) {
               $is_objectbank = '';
           } else {
               pop @state;
           }
      }, "tagname"],       }, "tagname"],
     );      );
     $p->unbroken_text(1);      $p->unbroken_text(1);
Line 3137  sub parse_webct4_questionDB { Line 3173  sub parse_webct4_questionDB {
                     }                      }
                 }                  }
             }              }
           } elsif ($$settings{$id}{class} eq 'multiplechoice') {
               if (ref($$settings{$id}) eq 'HASH') {
                   foreach my $list (keys(%{$$settings{$id}})) {
                       if (ref($$settings{$id}{$list}) eq 'HASH') {
                           if (defined($$settings{$id}{$list}{rcardinality})) {
                               if ($$settings{$id}{$list}{rcardinality} eq 'Multiple') {
                                   if (ref($$settings{$id}{$list}{correctanswer}) eq 'ARRAY') {
                                       if (@{$$settings{$id}{$list}{correctanswer}} == 1) {
                                           $$settings{$id}{$list}{rcardinality} = 'Single';
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
         }          }
     }      }
 }  }
Line 3215  sub process_assessment { Line 3267  sub process_assessment {
     }      }
   
     if ($cms eq 'webctce4') {      if ($cms eq 'webctce4') {
         &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);          if (@allids > 0 && $allids[0] ne '') {
               &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
           }
     } else {      } else {
         &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings,\%qzparams);          &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings,\%qzparams);
     }      }
Line 3328  sub build_problem_container { Line 3382  sub build_problem_container {
             }              }
             $probtitle{$id} =~ s/\s+/_/g;              $probtitle{$id} =~ s/\s+/_/g;
             $probtitle{$id} =~ s/:/_/g;              $probtitle{$id} =~ s/:/_/g;
               $probtitle{$id} =~ s/\//_/g;
             $probtitle{$id} .= '_'.$id;              $probtitle{$id} .= '_'.$id;
         }          }
         if (($cms eq 'webctce4' && $container ne 'database') ||          if (($cms eq 'webctce4' && $container ne 'database') ||
Line 3787  sub write_webct4_questions { Line 3842  sub write_webct4_questions {
         my $questionimage;          my $questionimage;
         foreach my $fdbk (@{$$settings{$id}{feedback}}) {          foreach my $fdbk (@{$$settings{$id}{feedback}}) {
             my $feedback =  $$settings{$id}{$fdbk}{text};              my $feedback =  $$settings{$id}{$fdbk}{text};
             if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {              if ($feedback ne '') {
                 $feedback = &HTML::Entities::decode($feedback);                  if ($$settings{$id}{$fdbk}{texttype} eq 'text/html') {
                       $feedback = &HTML::Entities::decode($feedback);
                   }
                   $allfeedback .= $feedback;
             }              }
             $allfeedback .= $feedback;  
         }          }
         if ($$settings{$id}{texttype} eq 'text/html') {          if ($$settings{$id}{texttype} eq 'text/html') {
             if ($$settings{$id}{text}) {              if ($$settings{$id}{text}) {
Line 3850  sub write_webct4_questions { Line 3907  sub write_webct4_questions {
  <essayresponse>   <essayresponse>
  <textfield>$pre_fill_answer</textfield>   <textfield>$pre_fill_answer</textfield>
  </essayresponse>   </essayresponse>
  <postanswerdate>  
   $allfeedback  
  </postanswerdate>  
 |;  |;
             } else {              } else {
                 $resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;                  $resourcedata{$symb.'questiontext'} = '<p>'.$$settings{$id}{text}.'</p>'.$questionimage;
Line 4363  $$settings{$id}{$list}{jumbledtext}[$k] Line 4417  $$settings{$id}{$list}{jumbledtext}[$k]
             if (!-e "$destdir/problems/$probdir") {              if (!-e "$destdir/problems/$probdir") {
                 mkdir("$destdir/problems/$probdir",0755);                  mkdir("$destdir/problems/$probdir",0755);
             }              }
               if ($allfeedback ne '') {
                   $output .= qq|
    <postanswerdate>
     $allfeedback
    </postanswerdate>
   |;
               }
             $output .= qq|</problem>              $output .= qq|</problem>
 |;  |;
             my $title = $$settings{$id}{title};              my $title = $$settings{$id}{title};
             $title =~ s/\s/_/g;              $title =~ s/\s/_/g;
             $title =~ s/:/_/g;              $title =~ s/:/_/g;
               $title =~ s/\//_/g;
             $title .= '_'.$id;              $title .= '_'.$id;
             open(PROB,">$destdir/problems/$probdir/$title.problem");              open(PROB,">$destdir/problems/$probdir/$title.problem");
             print PROB $output;              print PROB $output;
Removed from v.1.43  
changed lines
  Added in v.1.44

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