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

Diff for /loncom/imspackages/imsprocessor.pm between versions 1.52 and 1.57

version 1.52, 2013/07/27 22:04:49 version 1.57, 2018/05/02 17:08:40
Line 29 Line 29
 package Apache::imsprocessor;  package Apache::imsprocessor;
   
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncommon;
 use Apache::loncleanup;  use Apache::loncleanup;
 use Apache::lonlocal;  use Apache::lonlocal;
 use LWP::UserAgent;  
 use HTTP::Request::Common;  use HTTP::Request::Common;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use LONCAPA::LWPReq;
 use strict;  use strict;
   
 sub ims_config {  sub ims_config {
Line 99  sub create_tempdir { Line 100  sub create_tempdir {
     my ($context,$pathinfo,$timenow) = @_;         my ($context,$pathinfo,$timenow) = @_;   
     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');      my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
     my $tempdir;      my $tempdir;
       $pathinfo = &Apache::loncommon::clean_path($pathinfo);
   # Collapse dots
       $pathinfo =~ s/\.+/./g;
     if ($context eq 'DOCS') {      if ($context eq 'DOCS') {
         $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;          $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
         if (!-e "$tempdir") {          if (!-e "$tempdir") {
Line 130  sub uploadzip { Line 134  sub uploadzip {
         $fname=~s/\s+/\_/g;          $fname=~s/\s+/\_/g;
 # Replace all other weird characters by nothing  # Replace all other weird characters by nothing
         $fname=~s/[^\w\.\-]//g;          $fname=~s/[^\w\.\-]//g;
   # Collapse dots
           $fname=~s/\.+/./g;
 # 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') {
Line 334  sub parse_manifest { Line 340  sub parse_manifest {
                                     $$resources{$identifier}{file} = $attr->{href};                                      $$resources{$identifier}{file} = $attr->{href};
                                 } else {                                  } else {
                                     push(@{$$hrefs{$identifier}},$attr->{href});                                      push(@{$$hrefs{$identifier}},$attr->{href});
                                 }                                   }
                             }                              }
                         } elsif ($cms eq 'angel5') {                          } elsif ($cms eq 'angel5') {
                             if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {                              if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
Line 371  sub parse_manifest { Line 377  sub parse_manifest {
                 }                  }
                 if ("@state" eq "manifest webct:ContentObject webct:Name") {                  if ("@state" eq "manifest webct:ContentObject webct:Name") {
                     if ($cms eq 'webctvista4') {                      if ($cms eq 'webctvista4') {
                         $$resources{$identifier}{title} = (split(/,/,$text))[-1];                          if ($text =~ /,/) {
                               $$resources{$identifier}{title} = (split(/,/,$text))[-1];
                           } else {
                               $$resources{$identifier}{title} = $text;
                           }
                     }                      }
                 }                  }
               }, "dtext"],                }, "dtext"],
Line 383  sub parse_manifest { Line 393  sub parse_manifest {
     );      );
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
     foreach my $itm (keys %contents) {      foreach my $itm (keys(%contents)) {
         @{$$items{$itm}{contents}} = @{$contents{$itm}};          @{$$items{$itm}{contents}} = @{$contents{$itm}};
     }      }
 }  }
Line 434  sub target_resources { Line 444  sub target_resources {
 sub copy_resources {  sub copy_resources {
     my ($context,$cms,$hrefs,$resources,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;      my ($context,$cms,$hrefs,$resources,$tempdir,$targets,$url,$crs,$cdom,$destdir,$timenow,$assessmentfiles,$total) = @_;
     if ($context eq 'DOCS') {      if ($context eq 'DOCS') {
         foreach my $key (sort keys %{$hrefs}) {          foreach my $key (sort(keys(%{$hrefs}))) {
             if (grep/^$key$/,@{$targets}) {              if (grep/^$key$/,@{$targets}) {
                 %{$$url{$key}} = ();                  %{$$url{$key}} = ();
                 foreach my $file (@{$$hrefs{$key}}) {                  foreach my $file (@{$$hrefs{$key}}) {
Line 563  sub copy_resources { Line 573  sub copy_resources {
                                             if (ref($$resources{$$resources{$key}{usedby}}{imagetitle}) eq 'ARRAY') {                                              if (ref($$resources{$$resources{$key}{usedby}}{imagetitle}) eq 'ARRAY') {
                                                 $imgtitle = $$resources{$$resources{$key}{usedby}}{imagetitle}[$i];                                                   $imgtitle = $$resources{$$resources{$key}{usedby}}{imagetitle}[$i]; 
                                             }                                              }
                                             if (($img =~ /^\Q$filestem\E/i) && ($imgtitle =~ /\Q$extension\E/i)) {                                              if ($imgtitle =~ /\Q$extension\E/i) {
                                                 $copyfile = $img.'_'.$imgtitle;                                                  $copyfile = $imgtitle;
                                                 last;                                                  last;
                                             } elsif ($img =~ /^\Q$filestem\E/i) {                                              } elsif ($img =~ /^\Q$filestem\E/i) {
                                                 $copyfile = $img.'.'.$extension;                                                  $copyfile = $img.'.'.$extension;
Line 613  sub process_resinfo { Line 623  sub process_resinfo {
     }      }
     if ($cms eq 'angel5') {      if ($cms eq 'angel5') {
         my $currboard = '';          my $currboard = '';
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort(keys(%{$resources}))) {
           if (grep/^$key$/,@{$targets}) {            if (grep/^$key$/,@{$targets}) {
             if ($$resources{$key}{type} eq "BOARD") {              if ($$resources{$key}{type} eq "BOARD") {
                 push @{$boards}, $key;                  push @{$boards}, $key;
Line 642  sub process_resinfo { Line 652  sub process_resinfo {
           }            }
         }          }
     } elsif ($cms eq 'bb5' || $cms eq 'bb6') {      } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort(keys(%{$resources}))) {
           if (grep/^$key$/,@{$targets}) {            if (grep/^$key$/,@{$targets}) {
             if ($$resources{$key}{type} eq "resource/x-bb-document") {              if ($$resources{$key}{type} eq "resource/x-bb-document") {
                 unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {                  unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
Line 710  sub process_resinfo { Line 720  sub process_resinfo {
             $$items{'Top'}{'contentscount'} ++;              $$items{'Top'}{'contentscount'} ++;
         }          }
     } elsif ($cms eq 'webctce4') {      } elsif ($cms eq 'webctce4') {
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort(keys(%{$resources}))) {
             if (grep/^$key$/,@{$targets}) {              if (grep/^$key$/,@{$targets}) {
                 if ($$resources{$key}{type} eq "webcontent") {                  if ($$resources{$key}{type} eq "webcontent") {
                     %{$$resinfo{$key}} = ();                      %{$$resinfo{$key}} = ();
Line 725  sub process_resinfo { Line 735  sub process_resinfo {
             }              }
         }          }
     } elsif ($cms eq 'webctvista4') {      } elsif ($cms eq 'webctvista4') {
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort(keys(%{$resources}))) {
             if (grep/^$key$/,@{$targets}) {              if (grep/^$key$/,@{$targets}) {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                 if ($$resources{$key}{type} eq 'webct.question') {                  if ($$resources{$key}{type} eq 'webct.question') {
Line 812  sub build_structure { Line 822  sub build_structure {
         $srcstem = "/res/$udom/$uname/$newdir";          $srcstem = "/res/$udom/$uname/$newdir";
     }      }
   
     foreach my $key (sort keys %{$items}) {      foreach my $key (sort(keys(%{$items}))) {
       if ($$includeditems{$key}) {        if ($$includeditems{$key}) {
         %{$flag{$key}} = (          %{$flag{$key}} = (
                           page => 0,                            page => 0,
Line 1030  sub build_structure { Line 1040  sub build_structure {
         $filestem = "/res/$udom/$uname/$newdir";          $filestem = "/res/$udom/$uname/$newdir";
     }      }
   
     foreach my $key (sort keys %pagecontents) {      foreach my $key (sort(keys(%pagecontents))) {
         for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {          for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
             my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';              my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
             my $resource = "$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html";              my $resource = "$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html";
Line 1346  sub process_user { Line 1356  sub process_user {
   my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');    my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
   my $xmlstem =  $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";    my $xmlstem =  $$configvars{'lonDaemons'}."/tmp/".$user_cdom."_".$user_crs."_";
   
   foreach my $user_id (keys %{$settings}) {    foreach my $user_id (keys(%{$settings})) {
       if ($$settings{$user_id}{user_role} eq "s") {        if ($$settings{$user_id}{user_role} eq "s") {
                         
       } elsif ($user_handling eq 'enrollall') {        } elsif ($user_handling eq 'enrollall') {
Line 1866  sub addposting { Line 1876  sub addposting {
          &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);           &Apache::lonnet::put('discussiontimes',\%storenewentry,$cdom,$crs);
     }      }
     my %record=&Apache::lonnet::restore('_discussion');      my %record=&Apache::lonnet::restore('_discussion');
     my ($temp)=keys %record;      my ($temp)=keys(%record);
     unless ($temp=~/^error\:/) {      unless ($temp=~/^error\:/) {
         my %newrecord=();          my %newrecord=();
         $newrecord{'resource'}=$symb;          $newrecord{'resource'}=$symb;
Line 2408  sub parse_webctvista4_question { Line 2418  sub parse_webctvista4_question {
             @{$$settings{$id}{numids}} = ();              @{$$settings{$id}{numids}} = ();
             %{$$allanswers{$id}} = ();              %{$$allanswers{$id}} = ();
             $$settings{$id}{title} = $attr->{title};              $$settings{$id}{title} = $attr->{title};
               $$settings{$id}{title} =~ s/\%/pct_/g;
         }          }
         if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {          if ("@state" eq "questestinterop item presentation flow material mat_extension webct:calculated webct:var") {
             $currvar = $attr->{'webct:name'};              $currvar = $attr->{'webct:name'};
Line 2642  sub parse_webctvista4_question { Line 2653  sub parse_webctvista4_question {
      text_h =>       text_h =>
      [sub {       [sub {
         my ($text) = @_;          my ($text) = @_;
           $text =~ s/\s*\&\s*/_and_/g;
         if ($currtexttype eq '/text/html') {          if ($currtexttype eq '/text/html') {
             $text =~ s#(&lt;img\ssrc=")([^"]+)"&gt;#$1../resfiles/$2#g;              $text =~ s#(&lt;img\ssrc=")([^"]+)"&gt;#$1../resfiles/$2#g;
         }          }
         if ("@state" eq "questestinterop item presentation flow material matimage") {          if ("@state" eq "questestinterop item presentation flow material matimage") {
             my $imagetitle = (split(/,/,$text))[-1];              my $imagetitle;
               if ($text =~ /,/) {
                   $imagetitle = (split(/,/,$text))[-1];
               } else {
                   $imagetitle = $text;
               }
             $$settings{$id}{imagetitle} = $imagetitle;              $$settings{$id}{imagetitle} = $imagetitle;
             push(@{$$resources{$res}{imagetitle}},$imagetitle);              push(@{$$resources{$res}{imagetitle}},$imagetitle);
         }          }
Line 3252  sub parse_webct4_questionDB { Line 3269  sub parse_webct4_questionDB {
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
     my $boxcount;      my $boxcount;
     foreach my $id (keys %{$settings}) {      foreach my $id (keys(%{$settings})) {
         if ($$settings{$id}{class} eq 'string') {          if ($$settings{$id}{class} eq 'string') {
             $boxcount = 0;              $boxcount = 0;
             if (@{$$settings{$id}{boxes}} > 1) {              if (@{$$settings{$id}{boxes}} > 1) {
Line 3329  sub process_assessment { Line 3346  sub process_assessment {
         }          }
     } elsif ($cms eq 'webctvista4') {      } elsif ($cms eq 'webctvista4') {
         unless($$dbparse) {          unless($$dbparse) {
             foreach my $res (sort keys %{$allquestions}) {              foreach my $res (sort(keys(%{$allquestions}))) {
                 my $parent = $$allquestions{$res};                  my $parent = $$allquestions{$res};
                 &parse_webctvista4_question($res,$docroot,$resources,$hrefs,$qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);                  &parse_webctvista4_question($res,$docroot,$resources,$hrefs,$qzdbsettings,\@allquestids,\%allanswers,\%allchoices,$parent,$catinfo);
             }              }
Line 3378  sub build_category_sequences { Line 3395  sub build_category_sequences {
     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;          my $seqname;
         if ($cms eq 'webctce4') {           if ($cms eq 'webctce4') { 
             $seqname = $$catinfo{$category}{title}.'_'.$category;              $seqname = $$catinfo{$category}{title}.'_'.$category;
Line 3474  sub build_problem_container { Line 3491  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} =~ s/\//_/g;
             $probtitle{$id} .= '_'.$id;              if ($cms eq 'webctce4') {
                   $probtitle{$id} .= '_'.$id;
               }
         }          }
         if (($cms eq 'webctce4' && $container ne 'database') ||          if (($cms eq 'webctce4' && $container ne 'database') ||
             ($cms eq 'webctvista4'))   {              ($cms eq 'webctvista4'))   {
Line 3949  sub write_webct4_questions { Line 3968  sub write_webct4_questions {
         }           } 
         if ($$settings{$id}{class} eq 'numerical') {          if ($$settings{$id}{class} eq 'numerical') {
             foreach my $numid (@{$$settings{$id}{numids}}) {              foreach my $numid (@{$$settings{$id}{numids}}) {
                 foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {                  foreach my $var (keys(%{$$settings{$id}{$numid}{vars}})) {
                     if ($cms eq 'webctce4') {                      if ($cms eq 'webctce4') {
                         $$settings{$id}{text} =~ s/{($var)}/\$$1 /g;                          $$settings{$id}{text} =~ s/{($var)}/\$$1 /g;
                     } elsif ($cms eq 'webctvista4') {                      } elsif ($cms eq 'webctvista4') {
Line 3996  sub write_webct4_questions { Line 4015  sub write_webct4_questions {
         if (($cms eq 'webctvista4') && (defined($$settings{$id}{image}))) {          if (($cms eq 'webctvista4') && (defined($$settings{$id}{image}))) {
             my $imgsrc = '../../resfiles/'.$$settings{$id}{image};              my $imgsrc = '../../resfiles/'.$$settings{$id}{image};
             if (defined($$settings{$id}{imagetitle})) {              if (defined($$settings{$id}{imagetitle})) {
                 $imgsrc .= '_'.$$settings{$id}{imagetitle};                  $imgsrc = '../../resfiles/'.$$settings{$id}{imagetitle};
             }              }
             $questionimage = qq|<p><img src="$imgsrc" /></p>|;              $questionimage = qq|<p><img src="$imgsrc" /></p>|;
         }          }
Line 4436  $$settings{$id}{$list}{jumbledtext}[$k] Line 4455  $$settings{$id}{$list}{jumbledtext}[$k]
 |;  |;
                 foreach my $numid (@{$$settings{$id}{numids}}) {                  foreach my $numid (@{$$settings{$id}{numids}}) {
                     my $formula = $$settings{$id}{$numid}{formula};                      my $formula = $$settings{$id}{$numid}{formula};
                     my $pattern = join('|',(sort (keys (%mathfns))));                      my $pattern = join('|',(sort(keys(%mathfns))));
                     $formula =~ s/($pattern)/\&$mathfns{$1}/g;                      $formula =~ s/($pattern)/\&$mathfns{$1}/g;
                     foreach my $var (keys %{$$settings{$id}{$numid}{vars}}) {                      foreach my $var (keys(%{$$settings{$id}{$numid}{vars}})) {
                         my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};                          my $decnum = $$settings{$id}{$numid}{vars}{$var}{dec};
                         my $increment = '0.';                          my $increment = '0.';
                         if ($decnum == 0) {                          if ($decnum == 0) {
Line 4530  $$settings{$id}{$list}{jumbledtext}[$k] Line 4549  $$settings{$id}{$list}{jumbledtext}[$k]
             $title =~ s/\s/_/g;              $title =~ s/\s/_/g;
             $title =~ s/:/_/g;              $title =~ s/:/_/g;
             $title =~ s/\//_/g;              $title =~ s/\//_/g;
             $title .= '_'.$id;  
             open(PROB,">$destdir/problems/$probdir/$title.problem");              open(PROB,">$destdir/problems/$probdir/$title.problem");
             print PROB $output;              print PROB $output;
             close PROB;              close PROB;
Line 4945  sub retrieve_image { Line 4963  sub retrieve_image {
     my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;      my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
     my $contents;      my $contents;
     my $url = $urlpath.$filename;      my $url = $urlpath.$filename;
     my $ua=new LWP::UserAgent;      my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
     my $request=new HTTP::Request('GET',$url);      my $request=new HTTP::Request('GET',$url);
     my $response=$ua->request($request);      my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request);
     if ($response->is_success) {       if ($response->is_success) { 
         $contents = $response->content;          $contents = $response->content;
         if (!-e "$docroot/$res") {          if (!-e "$docroot/$res") {
Line 5209  sub process_content { Line 5227  sub process_content {
                     if ($$settings{newwindow} eq "true") {                      if ($$settings{newwindow} eq "true") {
                         $linktag .= qq| target="$res$filecount"|;                          $linktag .= qq| target="$res$filecount"|;
                     }                      }
                     foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {                      foreach my $entry (keys(%{$$settings{files}[$filecount]{registry}})) {
                         $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;                          $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
                     }                      }
                       $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;                        $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a><br/>\n|;
Removed from v.1.52  
changed lines
  Added in v.1.57

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