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

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

version 1.17, 2005/03/23 19:54:27 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 519  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,\%catinfo,\%qzdbsettings);                  &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,\%catinfo,\%qzdbsettings);                  &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,\%catinfo,\%qzdbsettings);                  &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 569  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") {
                     &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,\%catinfo,\%qzdbsettings,$hrefs);
                 }                  }
             }              }
         }          }
Line 679  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 715  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 743  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 753  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 865  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 918  sub make_structure { Line 930  sub make_structure {
     } elsif ($cms eq 'webct4') {      } elsif ($cms eq 'webct4') {
         if ($type eq 'webctquiz') {          if ($type eq 'webctquiz') {
             $src =  $srcstem.'/pages/'.$res.'.page';              $src =  $srcstem.'/pages/'.$res.'.page';
               $$count{$key}{page} ++;
               $$flag{$key}{seq} = 0;
         } else {          } else {
             if (grep/^$file$/,@{$$hrefs{$res}}) {              if (grep/^$file$/,@{$$hrefs{$res}}) {
                 my $filename;                  my $filename;
Line 1860  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 1877  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 2257  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,$catinfo,$qzdbsettings) = @_;      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 = ();
Line 2271  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 2338  sub process_assessment { Line 2351  sub process_assessment {
             $$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;  
                 }  
             }              }
         }          }
     }      }
Removed from v.1.17  
changed lines
  Added in v.1.19

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