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.28 and 1.46

version 1.28, 2001/01/02 16:03:14	version 1.46, 2001/03/17 20:43:57
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 Gerd Kortemeyer	# 01/01/01,02/01,03/01,19/01,20/01,22/01,
	# 03/05,03/08,03/10,03/12,03/13,03/15,03/17 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;

#	#
	# Caches for previously calculated spreadsheets
	#

	my %oldsheets;
	my %loadedcaches;

	#
	# 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)
#	#
use vars qw(%spreadsheets %courserdatas %userrdatas %defaultsheets);
	my %spreadsheets;
	my %courserdatas;
	my %userrdatas;
	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 39 my $tmpdir;	Line 59 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 56 sub initsheet {	Line 76 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 81 $chome='';	Line 101 $chome='';
$cnum='';	$cnum='';
$cdom='';	$cdom='';
$cid='';	$cid='';
	$cfn='';

# symb	# symb

Line 303 sub sett {	Line 324 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 311 sub sett {	Line 333 sub sett {
} keys %f;	} keys %f;
map {	map {
if (($f{$_}) && ($_!~/template\_/)) {	if (($f{$_}) && ($_!~/template\_/)) {
if ($_=~/^$pattern/) {	my $matches=($_=~/^$pattern(\d+)/);
	if (($matches) && ($1)) {
unless ($f{$_}=~/^\!/) {	unless ($f{$_}=~/^\!/) {
$t{$_}=$c{$_};	$t{$_}=$c{$_};
}	}
Line 319 sub sett {	Line 342 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 422 ENDDEFS	Line 447 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 458 sub getvalues {	Line 483 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 495 sub getfilename {	Line 520 sub getfilename {
my $safeeval=shift;	my $safeeval=shift;
return $safeeval->reval('$filename');	return $safeeval->reval('$filename');
}	}

# --------------------------------------------------------------- Get course ID	# --------------------------------------------------------------- Get course ID

sub getcid {	sub getcid {
Line 502 sub getcid {	Line 528 sub getcid {
return $safeeval->reval('$cid');	return $safeeval->reval('$cid');
}	}

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

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

# ----------------------------------------------------------- Get course number	# ----------------------------------------------------------- Get course number

sub getcnum {	sub getcnum {
Line 765 sub readsheet {	Line 798 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.
';$sheettype='.$stype.	'";$uhome="'.&Apache::lonnet::homeserver($uname,$udom).
';$usymb='.$usymb.	'";$sheettype="'.$stype.
';$cid='.$ENV{'request.course.id'}.	'";$usymb="'.$usymb.
';$cnum='.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.	'";$csec="'.&Apache::lonnet::usection($udom,$uname,
';$cdom='.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.	$ENV{'request.course.id'}).
';$chome='.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.';');	'";$cid="'.$ENV{'request.course.id'}.
	'";$cfn="'.$ENV{'request.course.fn'}.
	'";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
	'";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
	'";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";');
return $safeeval;	return $safeeval;
}	}

Line 804 sub writesheet {	Line 841 sub writesheet {
$sheetdata,$chome);	$sheetdata,$chome);
if ($reply eq 'ok') {	if ($reply eq 'ok') {
$reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.	$reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
&stype.'_spreadsheets:'.	$stype.'_spreadsheets:'.
&Apache::lonnet::escape($fn).'='.$ENV{'user.name'},	&Apache::lonnet::escape($fn).'='.$ENV{'user.name'},
$chome);	$chome);
if ($reply eq 'ok') {	if ($reply eq 'ok') {
Line 870 sub tmpread {	Line 907 sub tmpread {
# ================================================================== Parameters	# ================================================================== Parameters
# -------------------------------------------- Figure out a cascading parameter	# -------------------------------------------- Figure out a cascading parameter
#	#
	# For this function to work
	#
	# * parmhash needs to be tied
	# * courseopt and useropt need to be initialized for this user and course
	#

sub parmval {	sub parmval {
my ($what,$safeeval)=@_;	my ($what,$safeeval)=@_;
Line 890 sub parmval {	Line 932 sub parmval {

my $symbparm=$symb.'.'.$what;	my $symbparm=$symb.'.'.$what;
my $mapparm=$mapname.'___(all).'.$what;	my $mapparm=$mapname.'___(all).'.$what;
my $usercourseprefix=$cid.'_'.$uname.'_'.$udom;	my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;

my $seclevel=	my $seclevel=
$usercourseprefix.'.['.	$usercourseprefix.'.['.
Line 984 sub updateclasssheet {	Line 1026 sub updateclasssheet {
my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.	my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
':environment:firstname&middlename&lastname&generation',	':environment:firstname&middlename&lastname&generation',
&Apache::lonnet::homeserver($sname,$sdom));	&Apache::lonnet::homeserver($sname,$sdom));
$rowlabel=$ssec.' '.$reply{$sname}.'<br>';	$rowlabel='<a href="/adm/studentcalc?uname='.$sname.
	'&udom='.$sdom.'">'.
	$ssec.' '.$reply{$sname}.'<br>';
map {	map {
$rowlabel.=&Apache::lonnet::unescape($_).' ';	$rowlabel.=&Apache::lonnet::unescape($_).' ';
} split(/\&/,$reply);	} split(/\&/,$reply);
	$rowlabel.='</a>';
}	}
$currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;	$currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
}	}
Line 1038 sub updateclasssheet {	Line 1083 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 1046 sub updatestudentassesssheet {	Line 1094 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 1059 sub updatestudentassesssheet {	Line 1105 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 1068 sub updatestudentassesssheet {	Line 1114 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 1084 sub updatestudentassesssheet {	Line 1131 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 1120 sub updatestudentassesssheet {	Line 1176 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

sub rowazstudent {	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{$_}=~/^\!/) \|\| ($row==0)) {
my @assessdata=split(/\_\_\_\;\_\_\_/,	@assessdata=&exportsheet(&getuname($safeeval),
&Apache::lonnet::ssi(	&getudom($safeeval),
'/adm/assesscalc',('utarget' => 'export',	'assesscalc',$f{$_});
'uname' => $uname,
'udom' => $udom,
'usymb' => $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 1161 sub rowazstudent {	Line 1234 sub rowazstudent {
}	}
}	}
} keys %f;	} keys %f;
	$cachedassess='';
	undef %cachedstores;
&setformulas($safeeval,%f);	&setformulas($safeeval,%f);
&setconstants($safeeval,%c);	&setconstants($safeeval,%c);
}	}

# --------------------------------------------------- Load data for one student	# --------------------------------------------------- Load data for one student

sub rowazclass {	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{$_}=~/^\!/) \|\| ($row==0)) {
my ($tname,$tdom)=split(/\:/,$_);	my @studentdata=&exportsheet(split(/\:/,$f{$_}),
my @assessdata=split(/\_\_\_\;\_\_\_/,	'studentcalc');
&Apache::lonnet::ssi(	undef %userrdatas;
'/adm/studentcalc',('utarget' => 'export',	$now++;
'uname' => $tname,	$r->print('<script>popwin.document.popremain.remaining.value="'.
'udom' => $tdom)));	$now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
	' secs remaining";</script>');
	$r->rflush();

my $index=0;	my $index=0;
map {	map {
if ($assessdata[$index]) {	if ($studentdata[$index]) {
$c{$_.$row}=$assessdata[$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 1197 sub rowazclass {	Line 1300 sub rowazclass {
} 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

sub rowaassess {	sub loadassessment {
my ($safeeval,$symb)=@_;	my $safeeval=shift;
my $uhome=&Apache::lonnet::homeserver($uname,$udom);
	my $uhome=&getuhome($safeeval);
	my $uname=&getuname($safeeval);
	my $udom=&getudom($safeeval);
	my $symb=&getusymb($safeeval);
	my $cid=&getcid($safeeval);
	my $cnum=&getcnum($safeeval);
	my $cdom=&getcdom($safeeval);
	my $chome=&getchome($safeeval);

my $namespace;	my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { 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 1224 sub rowaassess {	Line 1358 sub rowaassess {
$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
%courseopt=();	undef %courseopt;
%useropt=();	undef %useropt;
my $uhome=&Apache::lonnet::homeserver($uname,$udom);
	my $userprefix=$uname.'_'.$udom.'_';

unless ($uhome eq 'no_host') {	unless ($uhome eq 'no_host') {
# -------------------------------------------------------------- Get coursedata	# -------------------------------------------------------------- Get coursedata
unless	unless
((time-$courserdatas{$ENV{'request.course.id'}.'.last_cache'})<120) {	((time-$courserdatas{$cid.'.last_cache'})<240) {
my $reply=&Apache::lonnet::reply('dump:'.	my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.	':resourcedata',$chome);
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
$ENV{'course.'.$ENV{'request.course.id'}.'.home'});
if ($reply!~/^error\:/) {	if ($reply!~/^error\:/) {
$courserdatas{$ENV{'request.course.id'}}=$reply;	$courserdatas{$cid}=$reply;
$courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;	$courserdatas{$cid.'.last_cache'}=time;
}	}
}	}
map {	map {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$courseopt{&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'})<120) {	((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
my $reply=	my $reply=
&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);	&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
if ($reply!~/^error\:/) {	if ($reply!~/^error\:/) {
Line 1260 sub rowaassess {	Line 1395 sub rowaassess {
}	}
map {	map {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
$useropt{&Apache::lonnet::unescape($name)}=	$useropt{$userprefix.&Apache::lonnet::unescape($name)}=
&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 (used parmval)	# ----------------- now courseopt, useropt initialized for this user and course
	# (used by parmval)

my %c=();	my %c=();

	if (tie(%parmhash,'GDBM_File',
	&getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {
my %f=&getformulas($safeeval);	my %f=&getformulas($safeeval);
map {	map {
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};
}	}
}	}
}	}
} keys %f;	} keys %f;
	untie(%parmhash);
&setconstants($safeeval,%c);	}
	&setconstants($safeeval,%c);
}	}

# --------------------------------------------------------- Various form fields	# --------------------------------------------------------- Various form fields
Line 1330 sub updatesheet {	Line 1474 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($thissheet);	&loadcourse($safeeval,$r);
} elsif ($stype eq 'studentcalc') {	} elsif ($stype eq 'studentcalc') {
&loadstudent($thissheet);	&loadstudent($safeeval);
} else {	} else {
&loadassessment($thissheet);	&loadassessment($safeeval);
}	}
}	}

Line 1348 sub loadrows() {	Line 1492 sub loadrows() {
#	#

sub exportsheet {	sub exportsheet {
my ($uname,$udom,$stype,$usymb,$fn)=@_;	my ($uname,$udom,$stype,$usymb,$fn)=@_;
my $thissheet=($uname,$udom,$stype,$usymb);	my @exportarr=();
	#
	# Check if cached
	#

	my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
	my $found='';

	if ($oldsheets{$key}) {
	map {
	my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
	if ($name eq $fn) {
	$found=$value;
	}
	} split(/\_\_\_\&\_\_\_/,$oldsheets{$key});
	}

	unless ($found) {
	&cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
	if ($oldsheets{$key}) {
	map {
	my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
	if ($name eq $fn) {
	$found=$value;
	}
	} split(/\_\_\_\&\_\_\_/,$oldsheets{$key});
	}
	}

	if ($found) {
	#
	# Return what was cached
	#
	@exportarr=split(/\_\_\_\;\_\_\_/,$found);

	} else {
	#
	# Not cached
	#

	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);
return &exportdata($thissheet);	@exportarr=&exportdata($thissheet);
	#
	# Store now
	#
	my $cid=$ENV{'request.course.id'};
	my $current=();
	if ($stype eq 'studentcalc') {
	$current=&Apache::lonnet::reply('get:'.
	$ENV{'course.'.$cid.'.domain'}.':'.
	$ENV{'course.'.$cid.'.num'}.
	':nohist_calculatedsheets:'.
	&Apache::lonnet::escape($key),
	$ENV{'course.'.$cid.'.home'});
	} else {
	$current=&Apache::lonnet::reply('get:'.
	&getudom($thissheet).':'.
	&getuname($thissheet).
	':nohist_calculatedsheets_'.
	$ENV{'request.course.id'}.':'.
	&Apache::lonnet::escape($key),
	&getuhome($thissheet));

	}
	my %currentlystored=();
	unless ($current=~/^error\:/) {
	map {
	my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
	$currentlystored{$name}=$value;
	} split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current));
	}
	$currentlystored{$fn}=join('___;___',@exportarr);

	my $newstore='';
	map {
	if ($newstore) { $newstore.='___&___'; }
	$newstore.=$_.'___=___'.$currentlystored{$_};
	} keys %currentlystored;
	if ($stype eq 'studentcalc') {
	&Apache::lonnet::reply('put:'.
	$ENV{'course.'.$cid.'.domain'}.':'.
	$ENV{'course.'.$cid.'.num'}.
	':nohist_calculatedsheets:'.
	&Apache::lonnet::escape($key).'='.
	&Apache::lonnet::escape($newstore),
	$ENV{'course.'.$cid.'.home'});
	} else {
	&Apache::lonnet::reply('put:'.
	&getudom($thissheet).':'.
	&getuname($thissheet).
	':nohist_calculatedsheets_'.
	$ENV{'request.course.id'}.':'.
	&Apache::lonnet::escape($key).'='.
	&Apache::lonnet::escape($newstore),
	&getuhome($thissheet));
	}
	}
	return @exportarr;
	}

	# ===================================================== Calculated sheets cache
	#
	# Load previously cached student spreadsheets for this course
	#

	sub cachedcsheets {
	my $cid=$ENV{'request.course.id'};
	my $reply=&Apache::lonnet::reply('dump:'.
	$ENV{'course.'.$cid.'.domain'}.':'.
	$ENV{'course.'.$cid.'.num'}.
	':nohist_calculatedsheets',
	$ENV{'course.'.$cid.'.home'});
	unless ($reply=~/^error\:/) {
	map {
	my ($name,$value)=split(/\=/,$_);
	$oldsheets{&Apache::lonnet::unescape($name)}
	=&Apache::lonnet::unescape($value);
	} split(/\&/,$reply);
	}
	}

	# ===================================================== Calculated sheets cache
	#
	# Load previously cached assessment spreadsheets for this student
	#

	sub cachedssheets {
	my ($sname,$sdom,$shome)=@_;
	unless (($loadedcaches{$sname.'_'.$sdom}) \|\| ($shome eq 'no_host')) {
	my $cid=$ENV{'request.course.id'};
	my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.
	':nohist_calculatedsheets_'.
	$ENV{'request.course.id'},
	$shome);
	unless ($reply=~/^error\:/) {
	map {
	my ($name,$value)=split(/\=/,$_);
	$oldsheets{&Apache::lonnet::unescape($name)}
	=&Apache::lonnet::unescape($value);
	} split(/\&/,$reply);
	}
	$loadedcaches{$sname.'_'.$sdom}=1;
	}
}	}

	# ===================================================== Calculated sheets cache
	#
	# Load previously cached assessment spreadsheets for this student
	#

# ================================================================ Main handler	# ================================================================ Main handler
#	#
# Interactive call to screen	# Interactive call to screen
Line 1375 sub handler {	Line 1665 sub handler {

# ---------------------------------------------------- Global directory configs	# ---------------------------------------------------- Global directory configs

$includedir=r->dir_config('lonIncludes');	$includedir=$r->dir_config('lonIncludes');
$tmpdir=$r->dir_config('lonDaemons').'/tmp/';	$tmpdir=$r->dir_config('lonDaemons').'/tmp/';

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

if (($ENV{'request.course.fn'}) \|\|	if ($ENV{'request.course.fn'}) {
($ENV{'request.state'} eq 'construct')) {

# --------------------------- Get query string for limited number of parameters	# --------------------------- Get query string for limited number of parameters

Line 1398 $tmpdir=$r->dir_config('lonDaemons').'/t	Line 1687 $tmpdir=$r->dir_config('lonDaemons').'/t
} (split(/&/,$ENV{'QUERY_STRING'}));	} (split(/&/,$ENV{'QUERY_STRING'}));

# ------------------------------------------- Nothing there? Must be login user	# ------------------------------------------- Nothing there? Must be login user

	my $aname;
	my $adom;

unless ($ENV{'form.uname'}) {	unless ($ENV{'form.uname'}) {
$uname=$ENV{'user.name'};	$aname=$ENV{'user.name'};
$udom=$ENV{'user.domain'};	$adom=$ENV{'user.domain'};
} else {	} else {
$uname=$ENV{'form.uname'};	$aname=$ENV{'form.uname'};
$udom=$ENV{'form.udom'};	$adom=$ENV{'form.udom'};
}	}
# ----------------------------------------------------------- Change of target?

my $reroute=($ENV{'form.utarget'} eq 'export');

# ------------------------------------------------------------------- Open page	# ------------------------------------------------------------------- Open page

Line 1418 $tmpdir=$r->dir_config('lonDaemons').'/t	Line 1708 $tmpdir=$r->dir_config('lonDaemons').'/t

# --------------------------------------------------------------- Screen output	# --------------------------------------------------------------- Screen output

unless ($reroute) {
$r->print('<html><head><title>LON-CAPA Spreadsheet</title>');	$r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
$r->print(<<ENDSCRIPT);	$r->print(<<ENDSCRIPT);
<script language="JavaScript">	<script language="JavaScript">
Line 1443 ENDSCRIPT	Line 1732 ENDSCRIPT
&hiddenfield('usymb',$ENV{'form.usymb'}).	&hiddenfield('usymb',$ENV{'form.usymb'}).
&hiddenfield('unewfield','').	&hiddenfield('unewfield','').
&hiddenfield('unewformula',''));	&hiddenfield('unewformula',''));
}
	# ---------------------- Make sure that this gets out, even if user hits "stop"

$r->rflush();	$r->rflush();

# ---------------------------------------- Read new sheet or modified worksheet	# ---------------------------------------- Read new sheet or modified worksheet

my $sheetone=initsheet();
$r->uri=~/\/(\w+)$/;	$r->uri=~/\/(\w+)$/;
&settype($sheetone,$1);
	my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});

	# ------------------------ If a new formula had been entered, go from work copy

if ($ENV{'form.unewfield'}) {	if ($ENV{'form.unewfield'}) {
$r->print('<h2>Modified Workcopy</h2>');	$r->print('<h2>Modified Workcopy</h2>');
$ENV{'form.unewformula'}=~s/\'/\"/g;	$ENV{'form.unewformula'}=~s/\'/\"/g;
$r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.	$r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
$ENV{'form.unewformula'}.'<p>');	$ENV{'form.unewformula'}.'<p>');
&setfilename($sheetone,$ENV{'form.ufn'});	&setfilename($asheet,$ENV{'form.ufn'});
&tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',	&tmpread($asheet,
$ENV{'form.usymb'},
$ENV{'form.unewfield'},$ENV{'form.unewformula'});	$ENV{'form.unewfield'},$ENV{'form.unewformula'});
} elsif ($ENV{'form.saveas'}) {
&setfilename($sheetone,$ENV{'form.ufn'});	} elsif ($ENV{'form.saveas'}) {
&tmpread($sheetone,,	&setfilename($asheet,$ENV{'form.ufn'});
$ENV{'form.usymb'});	&tmpread($asheet);
} else {	} else {
unless ($ENV{'form.ufn'}) {	&readsheet($asheet,$ENV{'form.ufn'});
}	}

if (&gettype($sheetone) eq 'classcalc') {	# -------------------------------------------------- Print out user information
# ---------------------------------- For course view: get courselist and update
&updatestudentrows($sheetone);	unless (&gettype($asheet) eq 'classcalc') {
} else {	$r->print('<p><b>User:</b> '.&getuname($asheet).
# ----------------- For assessment and student: See if all import rows uptodate	'<br><b>Domain:</b> '.&getudom($asheet));
	if (&getcsec($asheet) eq '-1') {
	$r->print('<h3><font color=red>'.
	'Not a student in this course</font></h3>');
	} else {
	$r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));
	}
	}

	# ---------------------------------------------------------------- Course title

	$r->print('<h1>'.
	$ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1>');


if (tie(%parmhash,'GDBM_File',
$ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
$csec=&Apache::lonnet::usection($udom,$uname,$ENV{'request.course.id'});
if ($csec eq '-1') {
$r->print('<h3><font color=red>'.
"User '$uname' at domain '$udom' not a student in this course</font></h3>");
}
&updaterows($sheetone);
untie(%parmhash);
} else {
$r->print('<h3><font color=red>'.
'Could not initialize import fields (not in a course)</font></h3>');
}
}
# ---------------------------------------------------- See if something to save	# ---------------------------------------------------- See if something to save

if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {	if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
my $fname='';	my $fname='';
if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {	if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
$fname=~s/\W/\_/g;	$fname=~s/\W/\_/g;
if ($fname eq 'default') { $fname='course_default'; }	if ($fname eq 'default') { $fname='course_default'; }
$fname.='_'.&gettype($sheetone);	$fname.='_'.&gettype($asheet);
&setfilename($sheetone,$fname);	&setfilename($asheet,$fname);
$ENV{'form.ufn'}=$fname;	$ENV{'form.ufn'}=$fname;
my $reply=&writesheet($sheetone);	$r->print('<p>Saving spreadsheet: '.
unless ($reroute) {	&writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');
$r->print('<p>Saving spreadsheet: '.$reply.'<p>');	}
}
if ($ENV{'form.makedefufn'}) {
my $reply=&Apache::lonnet::reply('put:'.
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
':environment:spreadsheet_default_'.
&gettype($sheetone).'='.
&Apache::lonnet::escape($fname),
$ENV{'course.'.$ENV{'request.course.id'}.'.home'});
unless ($reroute) {
$r->print('<p>Making default spreadsheet: '.$reply.'<p>');
}
}
}
}	}

# ------------------------------------------------ Write the modified worksheet	# ------------------------------------------------ Write the modified worksheet

&tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',	$r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');
$ENV{'form.usymb'});
	&tmpwrite($asheet);

	# ----------------------------------------------------------------- Save dialog


# ----------------------------------------------------- Print user, course, etc
unless ($reroute) {
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {	if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
my $fname=$ENV{'form.ufn'};	my $fname=$ENV{'form.ufn'};
$fname=~s/\_[^\_]+$//;	$fname=~s/\_[^\_]+$//;
Line 1529 ENDSCRIPT	Line 1812 ENDSCRIPT
'<input type=text size=20 name=newfn value="'.$fname.	'<input type=text size=20 name=newfn value="'.$fname.
'"> (make default: <input type=checkbox name="makedefufn">)<p>');	'"> (make default: <input type=checkbox name="makedefufn">)<p>');
}	}
$r->print(&hiddenfield('ufn',$ENV{'form.ufn'}));
unless (&gettype($sheetone) eq 'classcalc') {
$r->print('<br><b>User:</b> '.$uname.'<br><b>Domain:</b> '.$udom);
}
$r->print('<h1>'.
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1>');
if ($csec) {
$r->print('<h3>Group/Section: '.$csec.'</h3>');
}
}
# -------------------------------------------------------- Import and calculate

if (&gettype($sheetone) eq 'assesscalc') {	$r->print(&hiddenfield('ufn',&getfilename($asheet)));
&rowaassess($sheetone,$ENV{'form.usymb'});
} elsif (&gettype($sheetone) eq 'studentcalc') {	# --------------------------------------------------------------- Cached sheets
&rowazstudent($sheetone);
} else {	undef %oldsheets;
&rowazclass($sheetone);	undef %loadedcaches;
}
my $calcoutput=&calcsheet($sheetone);	if (&gettype($asheet) eq 'classcalc') {
unless ($reroute) {	$r->print("Loading previously calculated student sheets ...<br>\n");
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');	$r->rflush();
	&cachedcsheets();
	} elsif (&gettype($asheet) eq 'studentcalc') {
	$r->print("Loading previously calculated assessment sheets ...<br>\n");
	$r->rflush();
	&cachedssheets(&getuname($asheet),&getudom($asheet),
	&getuhome($asheet));
}	}

# ------------------------------------------------------- Print or export sheet	# ----------------------------------------------------- Update sheet, load rows
unless ($reroute) {
&outsheet($r,$sheetone);	$r->print("Loaded sheet(s), updating rows ...<br>\n");
	$r->rflush();

	&updatesheet($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);
	$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');

	&outsheet($r,$asheet);
$r->print('</form></body></html>');	$r->print('</form></body></html>');
} else {
$r->print(&exportrow($sheetone));
}
# ------------------------------------------------------------------------ Done	# ------------------------------------------------------------------------ Done
} else {	} else {
# ----------------------------- Not in a course, or not allowed to modify parms	# ----------------------------- Not in a course, or not allowed to modify parms
Line 1570 ENDSCRIPT	Line 1861 ENDSCRIPT
}	}
return OK;	return OK;

$bombnomatterwhat='yes';
}	}

1;	1;
__END__	__END__

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

Removed from v.1.28
changed lines
	Added in v.1.46