Return to lonspreadsheet.pm CVS log

Up to [LON-CAPA] / loncom / interface

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

# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler
#
# 11/11,11/15,11/27,12/04 Gerd Kortemeyer

package Apache::lonspreadsheet;

use strict;
use Safe;
use Safe::Hole;
use Opcode;
use Apache::lonnet;
use Apache::Constants qw(:common);
use HTML::TokeParser;

#
# f: formulas
# t: intermediate format (from f after sett)
# v: output values (from t after calcv)
#

use vars qw(%v %t %f);


sub deffunc {
    my $safeeval=shift;
    my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space

sub mask {
    my ($lower,$upper)=@_;

    $lower=~/([A-Z]|\*)(\d+|\*)/;
    my $la=$1;
    my $ld=$2;

    $upper=~/([A-Z]|\*)(\d+|\*)/;
    my $ua=$1;
    my $ud=$2;
    my $alpha='';
    my $num='';

    if (($la eq '*') || ($ua eq '*')) {
       $alpha='[A-Z]';
    } else {
       $alpha='['.$la.'-'.$ua.']';
    }   

    if (($ld eq '*') || ($ud eq '*')) {
	$num='\d+';
    } else {
        if (length($ld)!=length($ud)) {
           $num.='(';
	   map {
              $num.='['.$_.'-9]';
           } ($ld=~m/\d/g);
           if (length($ud)-length($ld)>1) {
              $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
	   }
           $num.='|';
           map {
               $num.='[0-'.$_.']';
           } ($ud=~m/\d/g);
           $num.=')';
       } else {
           my @lda=($ld=~m/\d/g);
           my @uda=($ud=~m/\d/g);
           my $i; $j=0;
           for ($i=0;$i<=$#lda;$i++) {
               if ($lda[$i]==$uda[$i]) {
		   $num.=$lda[$i];
                   $j=$i;
               }
           }
           if ($j<$#lda-1) {
	       $num.='('.$lda[$j+1];
               for ($i=$j+2;$i<=$#lda;$i++) {
                   $num.='['.$lda[$i].'-9]';
               }
               if ($uda[$j+1]-$lda[$j+1]>1) {
		   $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
                   ($#lda-$j-1).'}';
               }
	       $num.='|'.$uda[$j+1];
               for ($i=$j+2;$i<=$#uda;$i++) {
                   $num.='[0-'.$uda[$i].']';
               }
               $num.=')';
           } else {
               $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
           }
       }
    }
    return '^'.$alpha.$num.'$';
}


sub NUM {
    my $mask=mask(@_);
    my $num=0;
    map {
        $num++;
    } grep /$mask/,keys %v;
    return $num;   
}

sub BIN {
    my ($low,$high,$lower,$upper)=@_;
    my $mask=mask($lower,$upper);
    my $num=0;
    map {
        if (($v{$_}>=$low) && ($v{$_}<=$high)) {
            $num++;
        }
    } grep /$mask/,keys %v;
    return $num;   
}


sub SUM {
    my $mask=mask(@_);
    my $sum=0;
    map {
        $sum+=$v{$_};
    } grep /$mask/,keys %v;
    return $sum;   
}

sub MEAN {
    my $mask=mask(@_);
    my $sum=0; my $num=0;
    map {
        $sum+=$v{$_};
        $num++;
    } grep /$mask/,keys %v;
    if ($num) {
       return $sum/$num;
    } else {
       return undef;
    }   
}

sub STDDEV {
    my $mask=mask(@_);
    my $sum=0; my $num=0;
    map {
        $sum+=$v{$_};
        $num++;
    } grep /$mask/,keys %v;
    unless ($num>1) { return undef; }
    my $mean=$sum/$num;
    $sum=0;
    map {
        $sum+=($v{$_}-$mean)**2;
    } grep /$mask/,keys %v;
    return sqrt($sum/($num-1));    
}

sub PROD {
    my $mask=mask(@_);
    my $prod=1;
    map {
        $prod*=$v{$_};
    } grep /$mask/,keys %v;
    return $prod;   
}

sub MAX {
    my $mask=mask(@_);
    my $max='-';
    map {
        unless ($max) { $max=$v{$_}; }
        if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
    } grep /$mask/,keys %v;
    return $max;   
}

sub MIN {
    my $mask=mask(@_);
    my $min='-';
    map {
        unless ($max) { $max=$v{$_}; }
        if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
    } grep /$mask/,keys %v;
    return $min;   
}

sub SUMMAX {
    my ($num,$lower,$upper)=@_;
    my $mask=mask($lower,$upper);
    my @inside=();
    map {
	$inside[$#inside+1]=$v{$_};
    } grep /$mask/,keys %v;
    @inside=sort(@inside);
    my $sum=0; my $i;
    for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
        $sum+=$inside[$i];
    }
    return $sum;   
}

sub SUMMIN {
    my ($num,$lower,$upper)=@_;
    my $mask=mask($lower,$upper);
    my @inside=();
    map {
	$inside[$#inside+1]=$v{$_};
    } grep /$mask/,keys %v;
    @inside=sort(@inside);
    my $sum=0; my $i;
    for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 
        $sum+=$inside[$i];
    }
    return $sum;   
}


# ------------------------------------------- End of "Inside of the safe space"
ENDDEFS
    $safeeval->reval($code);
}

# --------------------------------------------------------- Initialize t from f

sub sett {
    %t=();
    map {
	if ($f{$_}) {
	    $t{$_}=$f{$_};
            $t{$_}=~s/\.+/\,/g;
            $t{$_}=~s/(^|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;
        }
    } keys %f;
}

# ------------------------------------------------------------ Calculate values

sub calcv {
    my $safeeval=shift;
    %v=();
    my $notfinished=1;
    my $depth=0;
    while ($notfinished) {
	$notfinished=0;
        map {
            my $old=$v{$_};
            $v{$_}=$safeeval->reval($t{$_});
	    if ($@) {
		%v=();
                return $@;
            }
	    if ($v{$_} ne $old) { $notfinished=1; }
        } keys %t;
        $depth++;
        if ($depth>100) {
	    %v=();
            return 'Maximum calculation depth exceeded';
        }
    }
    return '';
}

# ------------------------------------------------------------ Read spreadsheet

sub readf {
    my $fn=shift;
    %f=();
    my $content;
    {
      my $fh=Apache::File->new($fn);
      $content=join('',<$fh>);
    }
    {
      my $parser=HTML::TokeParser->new(\$content);
      my $token;
      while ($token=$parser->get_token) {
         if ($token->[0] eq 'S') {
	     if ($token->[1] eq 'field') {
		 $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
		     $parser->get_text('/field');
	     }
         }
      }
    }
}

# --------------------------------------------------------------- Read metadata

sub readmeta {
    my $fn=shift;
    unless ($fn=~/\.meta$/) { $fn.='meta'; }
    my $content;
    my %returnhash=();
    {
      my $fh=Apache::File->new($fn);
      $content=join('',<$fh>);
    }
   my $parser=HTML::TokeParser->new(\$content);
   my $token;
   while ($token=$parser->get_token) {
      if ($token->[0] eq 'S') {
         my $entry=$token->[1];
         if (($entry eq 'stores') || ($entry eq 'parameter')) {
             my $unikey=$entry;
             $unikey.='_'.$token->[2]->{'part'}; 
             $unikey.='_'.$token->[2]->{'name'}; 
             $returnhash{$unikey}=$token->[2]->{'display'};
         }
     }
  }
    return %returnhash;
}


# ------------------------------------------------------------ Returns safeeval

sub init {

    %v=();
    %t=();
    %f=();
    my $safeeval = new Safe;
    my $safehole = new Safe::Hole;
    $safeeval->permit("entereval");
    $safeeval->permit(":base_math");
    $safeeval->permit("sort");
    $safeeval->deny(":base_io");
    $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
    $safeeval->share('%v','%t','%f');
    &deffunc($safeeval);

    return $safeeval;
}

# -----------------------------------------------------------------------------

sub handler {

    my $r=shift;

  $r->content_type('text/html');
  $r->send_http_header;

  $r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');
  $r->print('<body bgcolor="#FFFFFF">');
 
    my $safeeval=init();

    $f{'A3'}=5;
    $f{'A4'}=3;
    $f{'A5'}=8;
    $f{'E100'}=5;
    $f{'C3'}='A3+6';
    $f{'B4'}='8+int(C3/3)';
    $f{'C7'}='A3+B4';
    $f{'G8'}='MEAN("E*")';
    $f{'G5'}='A3+SUMMIN(2,"A*")';
    $f{'G6'}='A3+SUM("A*")';
    $f{'G7'}='STDDEV("A*")';
    $f{'G9'}='NUM("G*")';
    $f{'H10'}='MEAN("E*")';
    $f{'G10'}='BIN(3,5,"A*")';
    &sett();
    $r->print(&calcv($safeeval)."\n");
    $r->print($v{'C7'}."\n");
    $r->print($t{'G5'}.' - '.$v{'G5'}."\n");
    $r->print($t{'G6'}.' - '.$v{'G6'}."\n");
    $r->print($t{'G7'}.' - '.$v{'G7'}."\n");
    $r->print($t{'G8'}.' - '.$v{'G8'}."\n");
    $r->print($t{'G9'}.' - '.$v{'G9'}."\n");
    $r->print($t{'G10'}.' - '.$v{'G10'}."\n");

    $r->print('</body></html>');
    return OK;
}

1;
__END__