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

Diff for /loncom/homework/lonr.pm between versions 1.8 and 1.12

version 1.8, 2009/08/12 20:09:02 version 1.12, 2024/06/21 23:42:49
Line 33  use IO::Socket; Line 33  use IO::Socket;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::response();  use Apache::response();
 use LONCAPA;  use LONCAPA;
   use Tie::IxHash::Easy; # autoties all subhashes to keep index order
 ### You need to install the libraries below for this to work!  use Data::Dumper;  # used to output hash contents
   
 ###use Tie::IxHash::Easy; # autoties all subhashes to keep index order  
 ###use Data::Dumper;  # used to output hash contents  
   
 my $errormsg='';  my $errormsg='';
   
Line 56  sub Rcroak { Line 53  sub Rcroak {
 #  #
 sub Rpeel {  sub Rpeel {
         my $x = $_[0];  # the string containing the serialized R object(s)          my $x = $_[0];  # the string containing the serialized R object(s)
         if ($x =~ /^((?:i|d):(.+?);)(.*)$/) {          if ($x =~ /^N\;(.*)$/) {
               return ('',$1);
           } elsif ($x =~ /^((?:i|d):(.+?);)(.*)$/) {
                 return ($1, $+);  # x starts with a number                  return ($1, $+);  # x starts with a number
         }          } elsif ($x =~ /^s:(\d+):/) {
         elsif ($x =~ /^s:(\d+):/) {  
                 my $n = $1;  # x starts with a string of length n                  my $n = $1;  # x starts with a string of length n
                 if ($x =~ /^(s:\d+:\"(.{$n})\";)(.*)$/) {                  if ($x =~ /^(s:\d+:\"(.{$n})\";)(.*)$/) {
                         return ($1, $+);  # x starts with a valid string                          return ($1, $+);  # x starts with a valid string
                 } else {                  } else {
                         &Rcroak('invalid string detected');                          &Rcroak('invalid string detected');
                 }                  }
         }          } elsif ($x =~ /^a:/) {
         elsif ($x =~ /^a:/) {  
                 # x starts with an array -- need to find the closing brace                  # x starts with an array -- need to find the closing brace
                 my $i = index $x, '{', 0;  # position of first opening brace                  my $i = index $x, '{', 0;  # position of first opening brace
                 if ($i < 0) {                  if ($i < 0) {
Line 152  sub Rreturn { Line 149  sub Rreturn {
         }          }
         if ($errormsg) { return $errormsg; }          if ($errormsg) { return $errormsg; }
         return \%h;  # return a reference to the hash          return \%h;  # return a reference to the hash
       } elsif ($x eq '') {
           return '';
     } else {      } else {
         return 'Unrecognized output';          return 'Unrecognized output';
     }      }
Line 244  sub blacklisted { Line 243  sub blacklisted {
 }  }
   
 sub r_allowed_libraries {  sub r_allowed_libraries {
    return ('alr3','boot','car','class','cluster','datasets','Hmisc','KernSmooth','leaps','lmtest',     return ('alr3','boot','car','class','cluster','datasets','FactoMineR','Hmisc','KernSmooth','leaps',
            'MASS','methods','mgcv','nlme','nnet','qAnalyst','quadprog','rpart','SuppDists','spatial',             'lmtest','MASS','mdatools','methods','mgcv','nlme','nnet','qAnalyst','quadprog','rpart', 
            'splines','stats','stats4','survival','tseries','zoo');             'SuppDists','spatial','splines','stats','stats4','survival','tseries','zoo');
 }  }
   
 sub r_is_allowed_library {  sub r_is_allowed_library {
Line 260  sub r_is_allowed_library { Line 259  sub r_is_allowed_library {
 sub runscript {  sub runscript {
     my ($socket,$fullscript,$libraries)=@_;      my ($socket,$fullscript,$libraries)=@_;
     if (&blacklisted($fullscript)) { return 'Error: blacklisted'; }      if (&blacklisted($fullscript)) { return 'Error: blacklisted'; }
     my $reply;      my $reply='';
     $fullscript=~s/[\n\r\l]//gs;      $fullscript=~s/[\n\r\l]//gs;
     if ($libraries) {      if ($libraries) {
        foreach my $library (split(/\s*\,\s*/,$libraries)) {         foreach my $library (split(/\s*\,\s*/,$libraries)) {
           unless ($library=~/\w/) { next; }            unless ($library=~/\w/) { next; }
           if (&r_is_allowed_library($library)) {            if (&r_is_allowed_library($library)) {
               $reply=&rreply($socket,'library('.$library.');'."\n");                $reply=&rreply($socket,'library('.$library.');');
               if ($reply=~/^Error\:/) { return $reply; }                if ($reply=~/^Error\:/) { return $reply; }
           } else {             } else { 
              return 'Error: blacklisted';                return 'Error: blacklisted'; 
           }            }
        }         }
     }      }
     foreach my $line (split(/[\n\r]+/s,$fullscript)) {      $fullscript=~s/\;+\s*$//s;
  if ($line=~/\w/) { $reply=&rreply($socket,$line.";\n"); }      if ($fullscript=~/\w/) { $reply=&rreply($socket,$fullscript.';'); }
  if ($reply=~/^Error\:/) { return $reply; }      if ($reply=~/^Error\:/) { return $reply; }
     }  
     $reply=~s/^\s*//gs;      $reply=~s/^\s*//gs;
     $reply=~s/\s*$//gs;      $reply=~s/\s*$//gs;
     &Apache::lonxml::debug("r $fullscript \n reply $reply");      &Apache::lonxml::debug("r $fullscript \n reply $reply");
Line 292  sub runserializedscript { Line 290  sub runserializedscript {
        foreach my $library (split(/\s*\,\s*/,$libraries)) {         foreach my $library (split(/\s*\,\s*/,$libraries)) {
           unless ($library=~/\w/) { next; }            unless ($library=~/\w/) { next; }
           if (&r_is_allowed_library($library)) {            if (&r_is_allowed_library($library)) {
               $reply=&rreply($socket,'library('.$library.');'."\n");                $reply=&rreply($socket,'library('.$library.');');
               if ($reply=~/^Error\:/) { return($reply,$reply); }                if ($reply=~/^Error\:/) { return($reply,$reply); }
           } else {            } else {
              return 'Error: blacklisted';               return 'Error: blacklisted';
           }            }
        }         }
     }      }
     my @actuallines=();      $fullscript=~s/\;+\s*$//s;
     foreach my $line (split(/\;/s,$fullscript)) {      my $lastline='';
         if ($line=~/\w/) { push (@actuallines,$line); }      my $firstpart='';
       if ($fullscript=~/\;/) {
          ($firstpart,$lastline)=($fullscript=~/^(.*\;)([^\;]+)$/);
       } else {
          $lastline=$fullscript;
     }      }
     for (my $i=0; $i<$#actuallines; $i++) {      if ($firstpart) {
         $reply=&rreply($socket,$actuallines[$i].";\n");          $firstpart=~s/\;+\s*$//s;
           $reply=&rreply($socket,$firstpart.';');
         if ($reply=~/^Error\:/) { return($reply,$reply); }          if ($reply=~/^Error\:/) { return($reply,$reply); }
     }      }
 # The last line needs to be serialized  # The last line needs to be serialized
     $reply=&Rreturn(&rreply($socket,"phpSerialize($actuallines[-1]);\n"));      $reply=&Rreturn(&rreply($socket,"phpSerialize($lastline);"));
     return($reply,&Dumper($reply));      return($reply,&Dumper($reply));
 }  }
   
Removed from v.1.8  
changed lines
  Added in v.1.12

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