Return to lonspreadsheet.pm CVS log

Up to [LON-CAPA] / loncom / interface

New columns with lower case chars, bug in mask fixed

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

package Apache::lonspreadsheet;

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

# =============================================================================
# ===================================== Implements an instance of a spreadsheet

sub initsheet {
    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');
    my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space

#
# f: formulas
# t: intermediate format (variable references expanded)
# v: output values
# c: preloaded constants (A-column)
# rl: row label

%v=(); 
%t=();
%f=();
%c=();
%rl=();

$maxrow=0;
$sheettype='';
$filename='';

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

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

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

    if (($la eq '*') || ($ua eq '*')) {
       $alpha='[A-Za-z]';
    } else {
       if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
           ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
          $alpha='['.$la.'-'.$ua.']';
       } else {
          $alpha='['.$la.'-Za-'.$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; $notdone=1;
           for ($i=0;($i<=$#lda)&&($notdone);$i++) {
               if ($lda[$i]==$uda[$i]) {
		   $num.=$lda[$i];
                   $j=$i;
               } else {
                   $notdone=0;
               }
           }
           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 {
               if ($lda[$#lda]!=$uda[$#uda]) {
                  $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;   
}

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

sub calc {
    %v=();
    &sett();
    my $notfinished=1;
    my $depth=0;
    while ($notfinished) {
	$notfinished=0;
        map {
            my $old=$v{$_};
            $v{$_}=eval($t{$_});
	    if ($@) {
		%v=();
                return $@;
            }
	    if ($v{$_} ne $old) { $notfinished=1; }
        } keys %t;
        $depth++;
        if ($depth>100) {
	    %v=();
            return 'Maximum calculation depth exceeded';
        }
    }
    return '';
}

sub outrow {
    my $n=shift;
    my @cols=();
    if ($n) {
       $cols[0]=$rl{$f{'A'.$n}};
    } else {
       $cols[0]='<b><font size=+1>Export</font></b>';
    }
    map {
        my $fm=$f{$_.$n};
        $fm=~s/[\'\"]/\&\#34;/g;
        $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
    } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
       'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
       'a','b','c','d','e','f','g','h','i','j','k','l','m',
       'n','o','p','q','r','s','t','u','v','w','x','y','z');
    return @cols;
}

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

# ------------------------------------------------ Add or change formula values

sub setformulas {
    my ($safeeval,@f)=@_;
    $safeeval->reval('%f='."('".join("','",@f)."');");
}

# ------------------------------------------------ Add or change formula values

sub setconstants {
    my ($safeeval,@c)=@_;
    $safeeval->reval('%c='."('".join("','",@c)."');");
}

# ------------------------------------------------ Add or change formula values

sub setrowlabels {
    my ($safeeval,@rl)=@_;
    $safeeval->reval('%rl='."('".join("','",@rl)."');");
}

# ------------------------------------------------------- Calculate spreadsheet

sub calcsheet {
    my $safeeval=shift;
    $safeeval->reval('&calc();');
}

# ------------------------------------------------------------------ Get values

sub getvalues {
    my $safeeval=shift;
    return $safeeval->reval('%v');
}

# ---------------------------------------------------------------- Get formulas

sub getformulas {
    my $safeeval=shift;
    return $safeeval->reval('%f');
}

# -------------------------------------------------------------------- Set type

sub settype {
    my ($safeeval,$type)=@_;
    $safeeval->reval('$sheettype='.$type.';');
}

# -------------------------------------------------------------------- Get type

sub gettype {
    my $safeeval=shift;
    return $safeeval->reval('$sheettype');
}
# ------------------------------------------------------------------ Set maxrow

sub setmaxrow {
    my ($safeeval,$row)=@_;
    $safeeval->reval('$maxrow='.$row.';');
}

# ------------------------------------------------------------------ Get maxrow

sub getmaxrow {
    my $safeeval=shift;
    return $safeeval->reval('$maxrow');
}

# ---------------------------------------------------------------- Set filename

sub setfilename {
    my ($safeeval,$fn)=@_;
    $safeeval->reval('$filename='.$fn.';');
}

# ---------------------------------------------------------------- Get filename

sub getfilename {
    my $safeeval=shift;
    return $safeeval->reval('$filename');
}
    
# ========================================================== End of Spreadsheet
# =============================================================================


# --------------------------------------------- Produce output row n from sheet

sub rown {
    my ($safeeval,$n)=@_;
    my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
    my $showf=0;
    map {
       my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
       if ($showf==0) { $vl=$_; }
       if ($showf>1) {
	   if ($vl eq '') {
	       $vl='<font size=+2 color=white>&#35;</font>';
           }
           $rowdata.=
           '<td><a href="javascript:prompt('.$fm.');">'.$vl.
	       '</a></td>';
       } else {
           $rowdata.='<td>&nbsp;'.$vl.'&nbsp;</td>';
       }
       $showf++;
    } $safeeval->reval('&outrow('.$n.')');
    return $rowdata.'</tr>';
}

# ------------------------------------------------------------- Print out sheet

sub outsheet {
    my $safeeval=shift;
    my $tabledata='<table border=2><tr><td colspan=2>&nbsp;</td>';
    map {
        $tabledata.="<td><b><font size=+1>$_</font></b></td>";
    } ('A<br>Import','B','C','D','E','F','G','H','I','J','K','L','M',
       'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
       'a','b','c','d','e','f','g','h','i','j','k','l','m',
       'n','o','p','q','r','s','t','u','v','w','x','y','z');
    $tabledata.='</tr>';
    my $row;
    my $maxrow=&getmaxrow($safeeval);
    for ($row=0;$row<=$maxrow;$row++) {
        $tabledata.=&rown($safeeval,$row);
    }
    $tabledata.='</table>';
}



# --------------------------------------- Read spreadsheet formulas from a file

sub readsheet {
    my ($safeeval,$fn)=shift;
    &setfilename($safeeval,$fn);
    $fn=~/\.(\w+)/;
    &settype($safeeval,$1);
    my %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');
	     }
         }
      }
    }
    &setformulas($safeeval,%f);
}

# --------------------------------------------------------------- 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;
}

# ----------------------------------------------------------------- Update rows

sub updaterows {
    my $safeeval=shift;
    my %bighash;
# -------------------------------------------------------------------- Tie hash
      if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                       &GDBM_READER,0640)) {
# --------------------------------------------------------- Get all assessments

	my %allkeys=();
        my %allassess=();

        my $stype=&gettype($safeeval);

        map {
	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
	       my $mapid=$1;
               my $resid=$2;
               my $id=$mapid.'.'.$resid;
               my $srcf=$bighash{$_};
               if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                 my $symb=
                     &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
			    '___'.$resid.'___'.
			    &Apache::lonnet::declutter($srcf);
		 $allassess{$symb}=$bighash{'title_'.$id};
                 if ($stype eq 'assesscalc') {
                   map {
                       if ($_=~/^stores\_(.*)/) {
			  my $key=$_;
                          my $display=
			      &Apache::lonnet::metadata($srcf,$key.'.display');
                          unless ($display) {
                              $display=
			         &Apache::lonnet::metadata($srcf,$key.'.name');
                          }
                          $allkeys{$key}=$display;
		       }
                   } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
	         }
	      }
	   }
        } keys %bighash;
        untie(%bighash);
    
#
# %allkeys has a list of storage displays by unikey
# %allassess has a list of all resource displays by symb
#
# -------------------- Find discrepancies between the course row table and this
#
        my %f=&getformulas($safeeval);
        my $changed=0;

        my %current=();
        if ($stype eq 'assesscalc') {
	    %current=%allkeys;
        } elsif ($stype eq 'studentcalc') {
            %current=%allassess;
        }

        my $maxrow=0;
        my %existing=();

# ----------------------------------------------------------- Now obsolete rows
	map {
	    if ($_=~/^A(\d+)/) {
                $maxrow=($1>$maxrow)?$1:$maxrow;
                $existing{$f{$_}}=1;
		unless (defined($current{$f{$_}})) {
		   $f{$_}='!!! Obsolete';
                   $changed=1;
                }
            }
        } keys %f;

# -------------------------------------------------------- New and unknown keys
     
        map {
            unless ($existing{$_}) {
		$changed=1;
                $maxrow++;
                $f{'A'.$maxrow}=$_;
            }
        } keys %current;        
     
        if ($changed) { &setformulas($safeeval,%f); }

        &setmaxrow($safeeval,$maxrow);
        &setrowlabels($safeeval,%current);

    } else {
        return 'Could not access course data';
    }
}

# ------------------------------------------------ Load data for one assessment

sub rowaassess {
    my ($safeeval,$uname,$udom,$symb)=@_;
    my $uhome=&Apache::lonnet::homeserver($uname,$udom);
    my $namespace;
    unless ($namespace=$ENV{'request.course.id'}) { return ''; }
    my $answer=reply("restore:$udom:$uname:$namespace:$symb",$uhome);
    my %returnhash=();
    map {
	my ($name,$value)=split(/\=/,$_);
        $returnhash{&unescape($name)}=&unescape($value);
    } split(/\&/,$answer);
    my $version;
    for ($version=1;$version<=$returnhash{'version'};$version++) {
       map {
          $returnhash{$_}=$returnhash{$version.':'.$_};
       } split(/\:/,$returnhash{$version.':keys'});
    }

    my %c=();
    my %f=&getformulas($safeeval);
    map {
	if ($_=~/^A/) {
            unless ($f{$_}=~/^\!/) {
	       $c{$_}=$returnhash{$f{$_}};
	    }
        }
    } keys %f;
    &setconstants($safeeval,%c);
}


sub handler {
    my $r=shift;

   if ($r->header_only) {
      $r->content_type('text/html');
      $r->send_http_header;
      return OK;
   }

# ----------------------------------------------------- Needs to be in a course

  if (($ENV{'request.course.fn'}) || 
      ($ENV{'request.state'} eq 'construct')) { 
 
    $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 $sheetone=initsheet();
    &setformulas($sheetone,
   'B3' => 5, 'C4' => 6, 'C6' => 'B3+C4', 'C2' => 'C6+B5', 'B5'=>'&SUM("A*")',
   'A1' => 'da1', 'A2'=>'da2', 'A3'=>'da3','A4'=>'da4','A5'=>'da5','A6'=>'da6',
   'a1' => '28.7', 'a2' => 'C4+a1','G1'=>'&SUM("*25")');
    &setrowlabels($sheetone,
   'da1'=>'A Points','da2'=>'B Points','da3'=>'C Points',
   'da4'=>'Percentage Correct','da5'=>'Bonus Points','da6'=>'Points Awarded');
    &setconstants($sheetone,
   'A1' => '3', 'A2'=>'4', 'A3'=>'0','A4'=>'76','A5'=>'1.5','A6'=>'6');
   
    &setmaxrow($sheetone,6);
    &calcsheet($sheetone);
    $r->print(&outsheet($sheetone));
    $r->print('</body></html>');

  } else {
# ----------------------------- Not in a course, or not allowed to modify parms
      $ENV{'user.error.msg'}=
        $r->uri.":opa:0:0:Cannot modify spreadsheet";
      return HTTP_NOT_ACCEPTABLE; 
  }
    return OK;
}

1;
__END__