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

Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.87 and 1.96

version 1.87, 2002/04/18 20:21:38 version 1.96, 2002/07/05 21:44:50
Line 106  my %courseopt; Line 106  my %courseopt;
 my %useropt;  my %useropt;
 my %parmhash;  my %parmhash;
   
   #
   # Some hashes for stats on timing and performance
   #
   
   my %starttimes;
   my %usedtimes;
   my %numbertimes;
   
 # Stuff that only the screen handler can know  # Stuff that only the screen handler can know
   
 my $includedir;  my $includedir;
Line 122  sub initsheet { Line 130  sub initsheet {
     $safeeval->permit("sort");      $safeeval->permit("sort");
     $safeeval->deny(":base_io");      $safeeval->deny(":base_io");
     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');      $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
     $safehole->wrap(\&send_msg,     $safeeval,"&send_msg");      $safeeval->share('$@');
     $safehole->wrap(\&send_crit_msg,$safeeval,"&send_crit_msg");  
     my $code=<<'ENDDEFS';      my $code=<<'ENDDEFS';
 # ---------------------------------------------------- Inside of the safe space  # ---------------------------------------------------- Inside of the safe space
   
Line 167  $cfn=''; Line 174  $cfn='';
   
 $usymb='';  $usymb='';
   
   # error messages
   
   $errormsg='';
   
 sub mask {  sub mask {
     my ($lower,$upper)=@_;      my ($lower,$upper)=@_;
   
Line 742  sub expandnamed { Line 753  sub expandnamed {
     return 0;      return 0;
         }          }
     } else {      } else {
         return '$c{\''.$expression.'\'}';          # it is not a function, so it is a parameter name
           # We should do the following:
           #    1. Take the list of parameter names
           #    2. look through the list for ones that match the parameter we want
           #    3. If there are no collisions, return the one that matches
           #    4. If there is a collision, return 'bad parameter name error'
           my $returnvalue = '';
           my @matches = ();
           $#matches = -1;
           study $expression;
           foreach $parameter (keys(%c)) {
               push @matches,$parameter if ($parameter =~ /$expression/);
           }
           if ($#matches == 0) {
               $returnvalue = '$c{\''.$matches[0].'\'}';
           } else {
               $returnvalue =  "'bad parameter name : $expression'";
           }
           return $returnvalue;
     }      }
 }  }
   
Line 762  sub sett { Line 791  sub sett {
       if ($_=~/A(\d+)/) {        if ($_=~/A(\d+)/) {
  my $trow=$1;   my $trow=$1;
                 if ($trow) {                  if ($trow) {
                       # Get the name of this cell
     my $lb=$col.$trow;      my $lb=$col.$trow;
                       # Grab the template declaration
                     $t{$lb}=$f{'template_'.$col};                      $t{$lb}=$f{'template_'.$col};
                       # Replace '#' with the row number
                     $t{$lb}=~s/\#/$trow/g;                      $t{$lb}=~s/\#/$trow/g;
                       # Replace '....' with ','
                     $t{$lb}=~s/\.\.+/\,/g;                      $t{$lb}=~s/\.\.+/\,/g;
                       # Replace 'A0' with the value from 'A0'
                     $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;                      $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
                       # Replace parameters
                     $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;                      $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
                 }                  }
       }        }
Line 789  sub sett { Line 824  sub sett {
             }              }
         }          }
     }      }
       # For some reason 'A0' gets special treatment...  This seems superfluous
       # but I imagine it is here for a reason.
     $t{'A0'}=$f{'A0'};      $t{'A0'}=$f{'A0'};
     $t{'A0'}=~s/\.\.+/\,/g;      $t{'A0'}=~s/\.\.+/\,/g;
     $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;      $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
Line 796  sub sett { Line 833  sub sett {
 }  }
   
 sub calc {  sub calc {
     %v=();      undef %v;
     &sett();      &sett();
     my $notfinished=1;      my $notfinished=1;
     my $depth=0;      my $depth=0;
Line 804  sub calc { Line 841  sub calc {
  $notfinished=0;   $notfinished=0;
         foreach (keys(%t)) {          foreach (keys(%t)) {
             my $old=$v{$_};              my $old=$v{$_};
             $v{$_}=eval($t{$_});              $v{$_}=eval $t{$_};
     if ($@) {      if ($@) {
  %v=();   undef %v;
                 return $@;                  return $_.': '.$@;
             }              }
     if ($v{$_} ne $old) { $notfinished=1; }      if ($v{$_} ne $old) { $notfinished=1; }
         }          }
         $depth++;          $depth++;
         if ($depth>100) {          if ($depth>100) {
     %v=();      undef %v;
             return 'Maximum calculation depth exceeded';              return 'Maximum calculation depth exceeded';
         }          }
     }      }
Line 839  sub outrowassess { Line 876  sub outrowassess {
     my @cols=();      my @cols=();
     if ($n) {      if ($n) {
        my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});         my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
         if ($rl{$usy}) {
        $cols[0]=$rl{$usy}.'<br>'.         $cols[0]=$rl{$usy}.'<br>'.
                 '<select name="sel_'.$n.'" onChange="changesheet('.$n.                  '<select name="sel_'.$n.'" onChange="changesheet('.$n.
                 ')"><option name="default">Default</option>';                  ')"><option name="default">Default</option>';
         } else { $cols[0]=''; }
        foreach (@os) {         foreach (@os) {
            $cols[0].='<option name="'.$_.'"';             $cols[0].='<option name="'.$_.'"';
             if ($ufn eq $_) {              if ($ufn eq $_) {
Line 930  sub setrowlabels { Line 969  sub setrowlabels {
   
 sub calcsheet {  sub calcsheet {
     my $safeeval=shift;      my $safeeval=shift;
     $safeeval->reval('&calc();');      return $safeeval->reval('&calc();');
 }  }
   
 # ------------------------------------------------------------------ Get values  # ------------------------------------------------------------------ Get values
Line 1286  sub readsheet { Line 1325  sub readsheet {
           } else {            } else {
               $fn = $tmphash{'spreadsheet_default_'.$stype};                $fn = $tmphash{'spreadsheet_default_'.$stype};
           }             } 
             unless (($fn) && ($fn!~/^error\:/)) {
         $fn='default_'.$stype;
             }
           $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;             $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
       }        }
   }    }
Line 1439  sub tmpread { Line 1481  sub tmpread {
     $fn=$tmpdir.$fn.'.tmp';      $fn=$tmpdir.$fn.'.tmp';
     my $fh;      my $fh;
     my %fo=();      my %fo=();
       my $countrows=0;
     if ($fh=Apache::File->new($fn)) {      if ($fh=Apache::File->new($fn)) {
         my $name;          my $name;
         while ($name=<$fh>) {          while ($name=<$fh>) {
Line 1446  sub tmpread { Line 1489  sub tmpread {
             my $value=<$fh>;              my $value=<$fh>;
             chomp($value);              chomp($value);
             $fo{$name}=$value;              $fo{$name}=$value;
               if ($name=~/^A(\d+)$/) {
    if ($1>$countrows) {
       $countrows=$1;
                   }
               }
         }          }
     }      }
     if ($nform eq 'changesheet') {      if ($nform eq 'changesheet') {
Line 1453  sub tmpread { Line 1501  sub tmpread {
         unless ($ENV{'form.sel_'.$nfield} eq 'Default') {          unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
     $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};      $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
         }          }
       } elsif ($nfield eq 'insertrow') {
           $countrows++;
           my $newrow=substr('000000'.$countrows,-7);
           if ($nform eq 'top') {
       $fo{'A'.$countrows}='--- '.$newrow;
           } else {
               $fo{'A'.$countrows}='~~~ '.$newrow;
           }
     } else {      } else {
        if ($nfield) { $fo{$nfield}=$nform; }         if ($nfield) { $fo{$nfield}=$nform; }
     }      }
Line 2373  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2429  $tmpdir=$r->dir_config('lonDaemons').'/t
   
 # --------------------------- Get query string for limited number of parameters  # --------------------------- Get query string for limited number of parameters
   
     foreach (split(/&/,$ENV{'QUERY_STRING'})) {      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
        my ($name, $value) = split(/=/,$_);                                              ['uname','udom','usymb','ufn']);
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        if (($name eq 'uname') || ($name eq 'udom') ||   
            ($name eq 'usymb') || ($name eq 'ufn')) {  
            unless ($ENV{'form.'.$name}) {  
               $ENV{'form.'.$name}=$value;  
    }  
        }  
     }  
   
     if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {      if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
  $ENV{'form.ufn'}='default_'.$1;   $ENV{'form.ufn'}='default_'.$1;
Line 2434  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2481  $tmpdir=$r->dir_config('lonDaemons').'/t
         document.sheet.submit();          document.sheet.submit();
     }      }
   
       function insertrow(cn) {
    document.sheet.unewfield.value='insertrow';
           document.sheet.unewformula.value=cn;
           document.sheet.submit();
       }
   
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     $r->print('</head><body bgcolor="#FFFFFF">'.      $r->print('</head><body bgcolor="#FFFFFF">'.
Line 2657  ENDSCRIPT Line 2710  ENDSCRIPT
        if ($ENV{'form.showcsv'}) { $r->print(' checked'); }         if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
        $r->print('>');         $r->print('>');
     }      }
   
   # ------------------------------------------------------------------ Insertrows
   
      $r->print(<<ENDINSERTBUTTONS);
   <br>
   <input type='button' onClick='insertrow("top");' 
   value='Insert Row Top'>
   <input type='button' onClick='insertrow("bottom");' 
   value='Insert Row Bottom'><br>
   ENDINSERTBUTTONS
   
 # ------------------------------------------------------------- Print out sheet  # ------------------------------------------------------------- Print out sheet
   
     &outsheet($r,$asheet);      &outsheet($r,$asheet);
Removed from v.1.87  
changed lines
  Added in v.1.96

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