Return to lonspreadsheet.pm CVS log

Up to [LON-CAPA] / loncom / interface

Now runs as a handler, has routines to read spreadsheet and metadata

    1: # The LearningOnline Network with CAPA
    2: # Spreadsheet/Grades Display Handler
    3: #
    4: # 11/11,11/15,11/27,12/04 Gerd Kortemeyer
    5: 
    6: package Apache::lonspreadsheet;
    7: 
    8: use strict;
    9: use Safe;
   10: use Safe::Hole;
   11: use Opcode;
   12: use Apache::lonnet;
   13: use Apache::Constants qw(:common);
   14: use HTML::TokeParser;
   15: 
   16: #
   17: # f: formulas
   18: # t: intermediate format (from f after sett)
   19: # v: output values (from t after calcv)
   20: #
   21: 
   22: use vars qw(%v %t %f);
   23: 
   24: 
   25: sub deffunc {
   26:     my $safeeval=shift;
   27:     my $code=<<'ENDDEFS';
   28: # ---------------------------------------------------- Inside of the safe space
   29: 
   30: sub mask {
   31:     my ($lower,$upper)=@_;
   32: 
   33:     $lower=~/([A-Z]|\*)(\d+|\*)/;
   34:     my $la=$1;
   35:     my $ld=$2;
   36: 
   37:     $upper=~/([A-Z]|\*)(\d+|\*)/;
   38:     my $ua=$1;
   39:     my $ud=$2;
   40:     my $alpha='';
   41:     my $num='';
   42: 
   43:     if (($la eq '*') || ($ua eq '*')) {
   44:        $alpha='[A-Z]';
   45:     } else {
   46:        $alpha='['.$la.'-'.$ua.']';
   47:     }   
   48: 
   49:     if (($ld eq '*') || ($ud eq '*')) {
   50: 	$num='\d+';
   51:     } else {
   52:         if (length($ld)!=length($ud)) {
   53:            $num.='(';
   54: 	   map {
   55:               $num.='['.$_.'-9]';
   56:            } ($ld=~m/\d/g);
   57:            if (length($ud)-length($ld)>1) {
   58:               $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
   59: 	   }
   60:            $num.='|';
   61:            map {
   62:                $num.='[0-'.$_.']';
   63:            } ($ud=~m/\d/g);
   64:            $num.=')';
   65:        } else {
   66:            my @lda=($ld=~m/\d/g);
   67:            my @uda=($ud=~m/\d/g);
   68:            my $i; $j=0;
   69:            for ($i=0;$i<=$#lda;$i++) {
   70:                if ($lda[$i]==$uda[$i]) {
   71: 		   $num.=$lda[$i];
   72:                    $j=$i;
   73:                }
   74:            }
   75:            if ($j<$#lda-1) {
   76: 	       $num.='('.$lda[$j+1];
   77:                for ($i=$j+2;$i<=$#lda;$i++) {
   78:                    $num.='['.$lda[$i].'-9]';
   79:                }
   80:                if ($uda[$j+1]-$lda[$j+1]>1) {
   81: 		   $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
   82:                    ($#lda-$j-1).'}';
   83:                }
   84: 	       $num.='|'.$uda[$j+1];
   85:                for ($i=$j+2;$i<=$#uda;$i++) {
   86:                    $num.='[0-'.$uda[$i].']';
   87:                }
   88:                $num.=')';
   89:            } else {
   90:                $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
   91:            }
   92:        }
   93:     }
   94:     return '^'.$alpha.$num.'$';
   95: }
   96: 
   97: 
   98: sub NUM {
   99:     my $mask=mask(@_);
  100:     my $num=0;
  101:     map {
  102:         $num++;
  103:     } grep /$mask/,keys %v;
  104:     return $num;   
  105: }
  106: 
  107: sub BIN {
  108:     my ($low,$high,$lower,$upper)=@_;
  109:     my $mask=mask($lower,$upper);
  110:     my $num=0;
  111:     map {
  112:         if (($v{$_}>=$low) && ($v{$_}<=$high)) {
  113:             $num++;
  114:         }
  115:     } grep /$mask/,keys %v;
  116:     return $num;   
  117: }
  118: 
  119: 
  120: sub SUM {
  121:     my $mask=mask(@_);
  122:     my $sum=0;
  123:     map {
  124:         $sum+=$v{$_};
  125:     } grep /$mask/,keys %v;
  126:     return $sum;   
  127: }
  128: 
  129: sub MEAN {
  130:     my $mask=mask(@_);
  131:     my $sum=0; my $num=0;
  132:     map {
  133:         $sum+=$v{$_};
  134:         $num++;
  135:     } grep /$mask/,keys %v;
  136:     if ($num) {
  137:        return $sum/$num;
  138:     } else {
  139:        return undef;
  140:     }   
  141: }
  142: 
  143: sub STDDEV {
  144:     my $mask=mask(@_);
  145:     my $sum=0; my $num=0;
  146:     map {
  147:         $sum+=$v{$_};
  148:         $num++;
  149:     } grep /$mask/,keys %v;
  150:     unless ($num>1) { return undef; }
  151:     my $mean=$sum/$num;
  152:     $sum=0;
  153:     map {
  154:         $sum+=($v{$_}-$mean)**2;
  155:     } grep /$mask/,keys %v;
  156:     return sqrt($sum/($num-1));    
  157: }
  158: 
  159: sub PROD {
  160:     my $mask=mask(@_);
  161:     my $prod=1;
  162:     map {
  163:         $prod*=$v{$_};
  164:     } grep /$mask/,keys %v;
  165:     return $prod;   
  166: }
  167: 
  168: sub MAX {
  169:     my $mask=mask(@_);
  170:     my $max='-';
  171:     map {
  172:         unless ($max) { $max=$v{$_}; }
  173:         if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
  174:     } grep /$mask/,keys %v;
  175:     return $max;   
  176: }
  177: 
  178: sub MIN {
  179:     my $mask=mask(@_);
  180:     my $min='-';
  181:     map {
  182:         unless ($max) { $max=$v{$_}; }
  183:         if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
  184:     } grep /$mask/,keys %v;
  185:     return $min;   
  186: }
  187: 
  188: sub SUMMAX {
  189:     my ($num,$lower,$upper)=@_;
  190:     my $mask=mask($lower,$upper);
  191:     my @inside=();
  192:     map {
  193: 	$inside[$#inside+1]=$v{$_};
  194:     } grep /$mask/,keys %v;
  195:     @inside=sort(@inside);
  196:     my $sum=0; my $i;
  197:     for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
  198:         $sum+=$inside[$i];
  199:     }
  200:     return $sum;   
  201: }
  202: 
  203: sub SUMMIN {
  204:     my ($num,$lower,$upper)=@_;
  205:     my $mask=mask($lower,$upper);
  206:     my @inside=();
  207:     map {
  208: 	$inside[$#inside+1]=$v{$_};
  209:     } grep /$mask/,keys %v;
  210:     @inside=sort(@inside);
  211:     my $sum=0; my $i;
  212:     for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 
  213:         $sum+=$inside[$i];
  214:     }
  215:     return $sum;   
  216: }
  217: 
  218: 
  219: # ------------------------------------------- End of "Inside of the safe space"
  220: ENDDEFS
  221:     $safeeval->reval($code);
  222: }
  223: 
  224: # --------------------------------------------------------- Initialize t from f
  225: 
  226: sub sett {
  227:     %t=();
  228:     map {
  229: 	if ($f{$_}) {
  230: 	    $t{$_}=$f{$_};
  231:             $t{$_}=~s/\.+/\,/g;
  232:             $t{$_}=~s/(^|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;
  233:         }
  234:     } keys %f;
  235: }
  236: 
  237: # ------------------------------------------------------------ Calculate values
  238: 
  239: sub calcv {
  240:     my $safeeval=shift;
  241:     %v=();
  242:     my $notfinished=1;
  243:     my $depth=0;
  244:     while ($notfinished) {
  245: 	$notfinished=0;
  246:         map {
  247:             my $old=$v{$_};
  248:             $v{$_}=$safeeval->reval($t{$_});
  249: 	    if ($@) {
  250: 		%v=();
  251:                 return $@;
  252:             }
  253: 	    if ($v{$_} ne $old) { $notfinished=1; }
  254:         } keys %t;
  255:         $depth++;
  256:         if ($depth>100) {
  257: 	    %v=();
  258:             return 'Maximum calculation depth exceeded';
  259:         }
  260:     }
  261:     return '';
  262: }
  263: 
  264: # ------------------------------------------------------------ Read spreadsheet
  265: 
  266: sub readf {
  267:     my $fn=shift;
  268:     %f=();
  269:     my $content;
  270:     {
  271:       my $fh=Apache::File->new($fn);
  272:       $content=join('',<$fh>);
  273:     }
  274:     {
  275:       my $parser=HTML::TokeParser->new(\$content);
  276:       my $token;
  277:       while ($token=$parser->get_token) {
  278:          if ($token->[0] eq 'S') {
  279: 	     if ($token->[1] eq 'field') {
  280: 		 $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
  281: 		     $parser->get_text('/field');
  282: 	     }
  283:          }
  284:       }
  285:     }
  286: }
  287: 
  288: # --------------------------------------------------------------- Read metadata
  289: 
  290: sub readmeta {
  291:     my $fn=shift;
  292:     unless ($fn=~/\.meta$/) { $fn.='meta'; }
  293:     my $content;
  294:     my %returnhash=();
  295:     {
  296:       my $fh=Apache::File->new($fn);
  297:       $content=join('',<$fh>);
  298:     }
  299:    my $parser=HTML::TokeParser->new(\$content);
  300:    my $token;
  301:    while ($token=$parser->get_token) {
  302:       if ($token->[0] eq 'S') {
  303:          my $entry=$token->[1];
  304:          if (($entry eq 'stores') || ($entry eq 'parameter')) {
  305:              my $unikey=$entry;
  306:              $unikey.='_'.$token->[2]->{'part'}; 
  307:              $unikey.='_'.$token->[2]->{'name'}; 
  308:              $returnhash{$unikey}=$token->[2]->{'display'};
  309:          }
  310:      }
  311:   }
  312:     return %returnhash;
  313: }
  314: 
  315: 
  316: # ------------------------------------------------------------ Returns safeeval
  317: 
  318: sub init {
  319: 
  320:     %v=();
  321:     %t=();
  322:     %f=();
  323:     my $safeeval = new Safe;
  324:     my $safehole = new Safe::Hole;
  325:     $safeeval->permit("entereval");
  326:     $safeeval->permit(":base_math");
  327:     $safeeval->permit("sort");
  328:     $safeeval->deny(":base_io");
  329:     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
  330:     $safeeval->share('%v','%t','%f');
  331:     &deffunc($safeeval);
  332: 
  333:     return $safeeval;
  334: }
  335: 
  336: # -----------------------------------------------------------------------------
  337: 
  338: sub handler {
  339: 
  340:     my $r=shift;
  341: 
  342:   $r->content_type('text/html');
  343:   $r->send_http_header;
  344: 
  345:   $r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');
  346:   $r->print('<body bgcolor="#FFFFFF">');
  347:  
  348:     my $safeeval=init();
  349: 
  350:     $f{'A3'}=5;
  351:     $f{'A4'}=3;
  352:     $f{'A5'}=8;
  353:     $f{'E100'}=5;
  354:     $f{'C3'}='A3+6';
  355:     $f{'B4'}='8+int(C3/3)';
  356:     $f{'C7'}='A3+B4';
  357:     $f{'G8'}='MEAN("E*")';
  358:     $f{'G5'}='A3+SUMMIN(2,"A*")';
  359:     $f{'G6'}='A3+SUM("A*")';
  360:     $f{'G7'}='STDDEV("A*")';
  361:     $f{'G9'}='NUM("G*")';
  362:     $f{'H10'}='MEAN("E*")';
  363:     $f{'G10'}='BIN(3,5,"A*")';
  364:     &sett();
  365:     $r->print(&calcv($safeeval)."\n");
  366:     $r->print($v{'C7'}."\n");
  367:     $r->print($t{'G5'}.' - '.$v{'G5'}."\n");
  368:     $r->print($t{'G6'}.' - '.$v{'G6'}."\n");
  369:     $r->print($t{'G7'}.' - '.$v{'G7'}."\n");
  370:     $r->print($t{'G8'}.' - '.$v{'G8'}."\n");
  371:     $r->print($t{'G9'}.' - '.$v{'G9'}."\n");
  372:     $r->print($t{'G10'}.' - '.$v{'G10'}."\n");
  373: 
  374:     $r->print('</body></html>');
  375:     return OK;
  376: }
  377: 
  378: 1;
  379: __END__
  380: 
  381: 
  382: 
  383: 
  384: 
  385: 
  386: 
  387: 
  388: 
  389: 
  390: 
  391: 
  392: 
  393: 
  394: 
  395: