loncom/interface/lonspreadsheet.pm - diff

Return to lonspreadsheet.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.33 and 1.41

version 1.33, 2001/01/03 14:27:30	version 1.41, 2001/03/10 16:46:52
Line 3	Line 3
#	#
# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,	# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,
# 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30,	# 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30,
# 01/01/01,02/01,03/01 Gerd Kortemeyer	# 01/01/01,02/01,03/01,19/01,20/01,22/01,
	# 03/05,03/08,03/10 Gerd Kortemeyer

package Apache::lonspreadsheet;	package Apache::lonspreadsheet;

use strict;	use strict;
use Safe;	use Safe;
use Safe::Hole;	use Safe::Hole;
Line 17 use GDBM_File;	Line 18 use GDBM_File;
use HTML::TokeParser;	use HTML::TokeParser;

#	#
	# Cache for stores of an individual user
	#

	my $cachedassess;
	my %cachedstores;

	#
# These cache hashes need to be independent of user, resource and course	# These cache hashes need to be independent of user, resource and course
# (user and course can/should be in the keys)	# (user and course can/should be in the keys)
#	#
Line 25 my %spreadsheets;	Line 33 my %spreadsheets;
my %courserdatas;	my %courserdatas;
my %userrdatas;	my %userrdatas;
my %defaultsheets;	my %defaultsheets;
	my %updatedata;

#	#
# These global hashes are dependent on user, course and resource,	# These global hashes are dependent on user, course and resource,
Line 43 my $tmpdir;	Line 52 my $tmpdir;
# ===================================== Implements an instance of a spreadsheet	# ===================================== Implements an instance of a spreadsheet

sub initsheet {	sub initsheet {
my $safeeval = new Safe;	my $safeeval = new Safe(shift);
my $safehole = new Safe::Hole;	my $safehole = new Safe::Hole;
$safeeval->permit("entereval");	$safeeval->permit("entereval");
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
Line 60 sub initsheet {	Line 69 sub initsheet {
# c: preloaded constants (A-column)	# c: preloaded constants (A-column)
# rl: row label	# rl: row label

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

$maxrow=0;	$maxrow=0;
$sheettype='';	$sheettype='';
Line 308 sub sett {	Line 317 sub sett {
$t{$lb}=~s/\#/$trow/g;	$t{$lb}=~s/\#/$trow/g;
$t{$lb}=~s/\.\.+/\,/g;	$t{$lb}=~s/\.\.+/\,/g;
$t{$lb}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;	$t{$lb}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
	$t{$lb}=~s/(^\|[^\"\'])\[(\w+)\]/$1\$c\{\'$2\'\}/g;
}	}
}	}
} keys %f;	} keys %f;
Line 324 sub sett {	Line 334 sub sett {
$t{$_}=$f{$_};	$t{$_}=$f{$_};
$t{$_}=~s/\.\.+/\,/g;	$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;	$t{$_}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
	$t{$_}=~s/(^\|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;
}	}
}	}
} keys %f;	} keys %f;
$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;
	$t{'A0'}=~s/(^\|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;
}	}

sub calc {	sub calc {
Line 427 ENDDEFS	Line 439 ENDDEFS
# ------------------------------------------------ Add or change formula values	# ------------------------------------------------ Add or change formula values

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

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

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

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

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

# ------------------------------------------------------- Calculate spreadsheet	# ------------------------------------------------------- Calculate spreadsheet
Line 463 sub getvalues {	Line 475 sub getvalues {

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

# -------------------------------------------------------------------- Get type	# -------------------------------------------------------------------- Get type
Line 778 sub readsheet {	Line 790 sub readsheet {

sub makenewsheet {	sub makenewsheet {
my ($uname,$udom,$stype,$usymb)=@_;	my ($uname,$udom,$stype,$usymb)=@_;
my $safeeval=initsheet();	my $safeeval=initsheet($stype);
$safeeval->reval(	$safeeval->reval(
'$uname="'.$uname.	'$uname="'.$uname.
'";$udom="'.$udom.	'";$udom="'.$udom.
Line 1060 sub updateclasssheet {	Line 1072 sub updateclasssheet {
sub updatestudentassesssheet {	sub updatestudentassesssheet {
my $safeeval=shift;	my $safeeval=shift;
my %bighash;	my %bighash;
	my $stype=&gettype($safeeval);
	my %current=();
	unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {
# -------------------------------------------------------------------- Tie hash	# -------------------------------------------------------------------- Tie hash
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',	if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
&GDBM_READER,0640)) {	&GDBM_READER,0640)) {
Line 1068 sub updatestudentassesssheet {	Line 1083 sub updatestudentassesssheet {
my %allkeys=();	my %allkeys=();
my %allassess=();	my %allassess=();

my $stype=&gettype($safeeval);

map {	map {
if ($_=~/^src\_(\d+)\.(\d+)$/) {	if ($_=~/^src\_(\d+)\.(\d+)$/) {
my $mapid=$1;	my $mapid=$1;
Line 1081 sub updatestudentassesssheet {	Line 1094 sub updatestudentassesssheet {
&Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).	&Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
'___'.$resid.'___'.	'___'.$resid.'___'.
&Apache::lonnet::declutter($srcf);	&Apache::lonnet::declutter($srcf);
$allassess{$symb}=$bighash{'title_'.$id};	$allassess{$symb}=
	'<a href="/adm/assesscalc?usymb='.$symb.'">'.$bighash{'title_'.$id}.'</a>';
if ($stype eq 'assesscalc') {	if ($stype eq 'assesscalc') {
map {	map {
if (($_=~/^stores\_(.)/) \|\| ($_=~/^parameter\_(.)/)) {	if (($_=~/^stores\_(.)/) \|\| ($_=~/^parameter\_(.)/)) {
Line 1090 sub updatestudentassesssheet {	Line 1103 sub updatestudentassesssheet {
my $display=	my $display=
&Apache::lonnet::metadata($srcf,$key.'.display');	&Apache::lonnet::metadata($srcf,$key.'.display');
unless ($display) {	unless ($display) {
$display=	$display.=
&Apache::lonnet::metadata($srcf,$key.'.name');	&Apache::lonnet::metadata($srcf,$key.'.name');
}	}
	$display.='<br>'.$key;
$allkeys{$key}=$display;	$allkeys{$key}=$display;
}	}
} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));	} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
Line 1106 sub updatestudentassesssheet {	Line 1120 sub updatestudentassesssheet {
# %allkeys has a list of storage and parameter displays by unikey	# %allkeys has a list of storage and parameter displays by unikey
# %allassess has a list of all resource displays by symb	# %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') {	if ($stype eq 'assesscalc') {
%current=%allkeys;	%current=%allkeys;
} elsif ($stype eq 'studentcalc') {	} elsif ($stype eq 'studentcalc') {
%current=%allassess;	%current=%allassess;
}	}
	$updatedata{$ENV{'request.course.fn'}.'_'.$stype}=
	join('___;___',%current);
	} else {
	return 'Could not access course data';
	}
	# ------------------------------------------------------ Get current from cache
	} else {
	%current=split(/\_\_\_\;\_\_\_/,
	$updatedata{$ENV{'request.course.fn'}.'_'.$stype});
	}
	# -------------------- Find discrepancies between the course row table and this
	#
	my %f=&getformulas($safeeval);
	my $changed=0;

my $maxrow=0;	my $maxrow=0;
my %existing=();	my %existing=();
Line 1142 sub updatestudentassesssheet {	Line 1165 sub updatestudentassesssheet {
$f{'A'.$maxrow}=$_;	$f{'A'.$maxrow}=$_;
}	}
} keys %current;	} keys %current;

if ($changed) { &setformulas($safeeval,%f); }	if ($changed) { &setformulas($safeeval,%f); }

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

} else {	undef %current;
return 'Could not access course data';	undef %existing;
}
}	}

# ------------------------------------------------ Load data for one assessment	# ------------------------------------------------ Load data for one assessment
Line 1159 sub loadstudent {	Line 1181 sub loadstudent {
my $safeeval=shift;	my $safeeval=shift;
my %c=();	my %c=();
my %f=&getformulas($safeeval);	my %f=&getformulas($safeeval);
	$cachedassess=&getuname($safeeval).':'.&getudom($safeeval);
	%cachedstores=();
	{
	my $reply=&Apache::lonnet::reply('dump:'.&getudom($safeeval).':'.
	&getuname($safeeval).':'.
	&getcid($safeeval),
	&getuhome($safeeval));
	unless ($reply=~/^error\:/) {
	map {
	my ($name,$value)=split(/\=/,$_);
	$cachedstores{&Apache::lonnet::unescape($name)}=
	&Apache::lonnet::unescape($value);
	} split(/\&/,$reply);
	}
	}
	my @assessdata=();
map {	map {
if ($_=~/^A(\d+)/) {	if ($_=~/^A(\d+)/) {
my $row=$1;	my $row=$1;
unless ($f{$_}=~/^\!/) {	unless ($f{$_}=~/^\!/) {
my @assessdata=&exportsheet(&getuname($safeeval),	@assessdata=&exportsheet(&getuname($safeeval),
&getudom($safeeval),	&getudom($safeeval),
'assesscalc',$f{$_});	'assesscalc',$f{$_});
my $index=0;	my $index=0;
map {	map {
if ($assessdata[$index]) {	if ($assessdata[$index]) {
$c{$_.$row}=$assessdata[$index];	my $col=$_;
unless ($_ eq 'A') {	if ($assessdata[$index]=~/\D/) {
$f{$_.$row}='import';	$c{$col.$row}="'".$assessdata[$index]."'";
	} else {
	$c{$col.$row}=$assessdata[$index];
	}
	unless ($col eq 'A') {
	$f{$col.$row}='import';
}	}
}	}
$index++;	$index++;
Line 1180 sub loadstudent {	Line 1223 sub loadstudent {
}	}
}	}
} keys %f;	} keys %f;
	$cachedassess='';
	undef %cachedstores;
&setformulas($safeeval,%f);	&setformulas($safeeval,%f);
&setconstants($safeeval,%c);	&setconstants($safeeval,%c);
}	}
Line 1187 sub loadstudent {	Line 1232 sub loadstudent {
# --------------------------------------------------- Load data for one student	# --------------------------------------------------- Load data for one student

sub loadcourse {	sub loadcourse {
my $safeeval=shift;	my ($safeeval,$r)=@_;
my %c=();	my %c=();
my %f=&getformulas($safeeval);	my %f=&getformulas($safeeval);
	my $total=0;
	map {
	if ($_=~/^A(\d+)/) {
	unless ($f{$_}=~/^\!/) { $total++; }
	}
	} keys %f;
	my $now=0;
	my $since=time;
	$r->print(<<ENDPOP);
	<script>
	popwin=open('','popwin','width=400,height=100');
	popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+
	'<h1>Spreadsheet Calculation Progress</h1>'+
	'<form name=popremain>'+
	'<input type=text size=35 name=remaining value=Starting></form>'+
	'</body></html>');
	popwin.document.close;
	</script>
	ENDPOP
	$r->rflush();
map {	map {
if ($_=~/^A(\d+)/) {	if ($_=~/^A(\d+)/) {
my $row=$1;	my $row=$1;
unless (($f{$_}=~/^\!/)	unless ($f{$_}=~/^\!/) {
	my @studentdata=&exportsheet(split(/\:/,$f{$_}),
\|\| ($row>200))

{
my @studentdata=&exportsheet(&getuname($safeeval),
&getudom($safeeval),
'studentcalc');	'studentcalc');
undef %userrdatas;	undef %userrdatas;
	$now++;
	$r->print('<script>popwin.document.popremain.remaining.value="'.
	$now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
	' secs remaining";</script>');
	$r->rflush();

my $index=0;	my $index=0;
map {	map {
if ($studentdata[$index]) {	if ($studentdata[$index]) {
$c{$_.$row}=$studentdata[$index];	my $col=$_;
unless ($_ eq 'A') {	if ($studentdata[$index]=~/\D/) {
$f{$_.$row}='import';	$c{$col.$row}="'".$studentdata[$index]."'";
	} else {
	$c{$col.$row}=$studentdata[$index];
	}
	unless ($col eq 'A') {
	$f{$col.$row}='import';
}	}
}	}
$index++;	$index++;
Line 1218 sub loadcourse {	Line 1289 sub loadcourse {
} keys %f;	} keys %f;
&setformulas($safeeval,%f);	&setformulas($safeeval,%f);
&setconstants($safeeval,%c);	&setconstants($safeeval,%c);
	$r->print('<script>popwin.close</script>');
	$r->rflush();
}	}

# ------------------------------------------------ Load data for one assessment	# ------------------------------------------------ Load data for one assessment
Line 1238 sub loadassessment {	Line 1311 sub loadassessment {
unless ($namespace=$cid) { return ''; }	unless ($namespace=$cid) { return ''; }

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

	my %returnhash=();

	if ($cachedassess eq $uname.':'.$udom) {
	#
	# get data out of the dumped stores
	#

	my $version=$cachedstores{'version:'.$symb};
	my $scope;
	for ($scope=1;$scope<=$version;$scope++) {
	map {
	$returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
	} split(/\:/,$cachedstores{$scope.':keys:'.$symb});
	}

	} else {
	#
	# restore individual
	#

my $answer=&Apache::lonnet::reply(	my $answer=&Apache::lonnet::reply(
"restore:$udom:$uname:".	"restore:$udom:$uname:".
&Apache::lonnet::escape($namespace).":".	&Apache::lonnet::escape($namespace).":".
&Apache::lonnet::escape($symb),$uhome);	&Apache::lonnet::escape($symb),$uhome);
my %returnhash=();
map {	map {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$returnhash{&Apache::lonnet::unescape($name)}=	$returnhash{&Apache::lonnet::unescape($name)}=
Line 1254 sub loadassessment {	Line 1347 sub loadassessment {
$returnhash{$_}=$returnhash{$version.':'.$_};	$returnhash{$_}=$returnhash{$version.':'.$_};
} split(/\:/,$returnhash{$version.':keys'});	} split(/\:/,$returnhash{$version.':keys'});
}	}
	}
# ----------------------------- returnhash now has all stores for this resource	# ----------------------------- returnhash now has all stores for this resource

# ---------------------------- initialize coursedata and userdata for this user	# ---------------------------- initialize coursedata and userdata for this user
Line 1277 sub loadassessment {	Line 1371 sub loadassessment {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}=	$courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);	&Apache::lonnet::unescape($value);
} split(/\&/,$courserdatas{$ENV{'request.course.id'}});	} split(/\&/,$courserdatas{$cid});
# --------------------------------------------------- Get userdata (if present)	# --------------------------------------------------- Get userdata (if present)
unless	unless
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {	((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
Line 1294 sub loadassessment {	Line 1388 sub loadassessment {
&Apache::lonnet::unescape($value);	&Apache::lonnet::unescape($value);
} split(/\&/,$userrdatas{$uname.'___'.$udom});	} split(/\&/,$userrdatas{$uname.'___'.$udom});
}	}

# ----------------- now courseopt, useropt initialized for this user and course	# ----------------- now courseopt, useropt initialized for this user and course
# (used by parmval)	# (used by parmval)

Line 1307 sub loadassessment {	Line 1400 sub loadassessment {
if ($_=~/^A/) {	if ($_=~/^A/) {
unless ($f{$_}=~/^\!/) {	unless ($f{$_}=~/^\!/) {
if ($f{$_}=~/^parameter/) {	if ($f{$_}=~/^parameter/) {
$c{$_}=&parmval($f{$_},$safeeval);	my $val=&parmval($f{$_},$safeeval);
	$c{$_}=$val;
	$c{$f{$_}}=$val;
} else {	} else {
my $key=$f{$_};	my $key=$f{$_};
	my $ckey=$key;
$key=~s/^stores\_/resource\./;	$key=~s/^stores\_/resource\./;
$key=~s/\_/\./;	$key=~s/\_/\./;
$c{$_}=$returnhash{$key};	$c{$_}=$returnhash{$key};
	$c{$ckey}=$returnhash{$key};
}	}
}	}
}	}
Line 1366 sub updatesheet {	Line 1463 sub updatesheet {
# Import the data for rows	# Import the data for rows
#	#

sub loadrows() {	sub loadrows {
my $safeeval=shift;	my ($safeeval,$r)=@_;
my $stype=&gettype($safeeval);	my $stype=&gettype($safeeval);
if ($stype eq 'classcalc') {	if ($stype eq 'classcalc') {
&loadcourse($safeeval);	&loadcourse($safeeval,$r);
} elsif ($stype eq 'studentcalc') {	} elsif ($stype eq 'studentcalc') {
&loadstudent($safeeval);	&loadstudent($safeeval);
} else {	} else {
Line 1384 sub loadrows() {	Line 1481 sub loadrows() {
#	#

sub exportsheet {	sub exportsheet {

my ($uname,$udom,$stype,$usymb,$fn)=@_;	my ($uname,$udom,$stype,$usymb,$fn)=@_;
my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);	my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);
&readsheet($thissheet,$fn);	&readsheet($thissheet,$fn);
&updatesheet($thissheet);	&updatesheet($thissheet);
&loadrows($thissheet);	&loadrows($thissheet);
&calcsheet($thissheet);	&calcsheet($thissheet);
my @returnthis=&exportdata($thissheet);	return &exportdata($thissheet);
undef $thissheet;
return @returnthis;
}	}

# ================================================================ Main handler	# ================================================================ Main handler
Line 1566 ENDSCRIPT	Line 1662 ENDSCRIPT

# ----------------------------------------------------- Update sheet, load rows	# ----------------------------------------------------- Update sheet, load rows

	$r->print("Loaded sheet, updating rows ...<br>\n");
	$r->rflush();

&updatesheet($asheet);	&updatesheet($asheet);
&loadrows($asheet);

	$r->print("Updated rows, loading row data ...<br>\n");
	$r->rflush();

	&loadrows($asheet,$r);

	$r->print("Loaded row data, calculating sheet ...<br>\n");
	$r->rflush();

my $calcoutput=&calcsheet($asheet);	my $calcoutput=&calcsheet($asheet);
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');	$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
Line 1576 ENDSCRIPT	Line 1681 ENDSCRIPT
&outsheet($r,$asheet);	&outsheet($r,$asheet);
$r->print('</form></body></html>');	$r->print('</form></body></html>');

# --------------------------------- We know this leaks, so terminate this child

$r->child_terminate();

# ------------------------------------------------------------------------ Done	# ------------------------------------------------------------------------ Done
} else {	} else {
# ----------------------------- Not in a course, or not allowed to modify parms	# ----------------------------- Not in a course, or not allowed to modify parms

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

Removed from v.1.33
changed lines
	Added in v.1.41