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.6 and 1.10

version 1.6, 2000/12/06 14:50:47	version 1.10, 2000/12/09 19:14:20
Line 1	Line 1
# The LearningOnline Network with CAPA	# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler	# Spreadsheet/Grades Display Handler
#	#
# 11/11,11/15,11/27,12/04,12/05,12/06 Gerd Kortemeyer	# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,12/08,12/09 Gerd Kortemeyer

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

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

Line 48 $filename='';	Line 49 $filename='';
sub mask {	sub mask {
my ($lower,$upper)=@_;	my ($lower,$upper)=@_;

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

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

if (($la eq '') \|\| ($ua eq '')) {	if (($la eq '') \|\| ($ua eq '')) {
$alpha='[A-Z]';	$alpha='[A-Za-z]';
} else {	} else {
$alpha='['.$la.'-'.$ua.']';	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 '')) {	if (($ld eq '') \|\| ($ud eq '')) {
Line 83 sub mask {	Line 89 sub mask {
} else {	} else {
my @lda=($ld=~m/\d/g);	my @lda=($ld=~m/\d/g);
my @uda=($ud=~m/\d/g);	my @uda=($ud=~m/\d/g);
my $i; $j=0;	my $i; $j=0; $notdone=1;
for ($i=0;$i<=$#lda;$i++) {	for ($i=0;($i<=$#lda)&&($notdone);$i++) {
if ($lda[$i]==$uda[$i]) {	if ($lda[$i]==$uda[$i]) {
$num.=$lda[$i];	$num.=$lda[$i];
$j=$i;	$j=$i;
	} else {
	$notdone=0;
}	}
}	}
if ($j<$#lda-1) {	if ($j<$#lda-1) {
Line 105 sub mask {	Line 113 sub mask {
}	}
$num.=')';	$num.=')';
} else {	} else {
$num.='['.$lda[$#lda].'-'.$uda[$#uda].']';	if ($lda[$#lda]!=$uda[$#uda]) {
	$num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
	}
}	}
}	}
}	}
Line 242 sub sett {	Line 252 sub sett {
}	}
} else {	} else {
$t{$_}=$f{$_};	$t{$_}=$f{$_};
$t{$_}=~s/\.+/\,/g;	$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^\|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;	$t{$_}=~s/(^\|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
}	}
}	}
} keys %f;	} keys %f;
Line 287 sub outrow {	Line 297 sub outrow {
$fm=~s/[\'\"]/\&\#34;/g;	$fm=~s/[\'\"]/\&\#34;/g;
$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};	$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
} ('A','B','C','D','E','F','G','H','I','J','K','L','M',	} ('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');	'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;	return @cols;
}	}

Line 388 sub getfilename {	Line 400 sub getfilename {

sub rown {	sub rown {
my ($safeeval,$n)=@_;	my ($safeeval,$n)=@_;
	my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";	my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
my $showf=0;	my $showf=0;
map {	map {
	my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);	my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
if ($showf==0) { $vl=$_; }	if ($showf==0) { $vl=$_; }
	if ($showf<=1) { $bgcolor='#FFDDDD'; }
	if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
if ($showf>1) {	if ($showf>1) {
if ($vl eq '') {	if ($vl eq '') {
$vl='<font size=+2 color=white>#</font>';	$vl='<font size=+2 color='.$bgcolor.'>#</font>';
}	}
$rowdata.=	$rowdata.=
'<td><a href="javascript:prompt('.$fm.');">'.$vl.	'<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
'</a></td>';	'</a></td>';
} else {	} else {
$rowdata.='<td> '.$vl.' </td>';	$rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
}	}
$showf++;	$showf++;
} $safeeval->reval('&outrow('.$n.')');	} $safeeval->reval('&outrow('.$n.')');
Line 412 sub rown {	Line 428 sub rown {

sub outsheet {	sub outsheet {
my $safeeval=shift;	my $safeeval=shift;
my $tabledata='<table border=2><tr><td colspan=2> </td>';	my $tabledata='<table border=2><tr><td colspan=2> </td>'.
	'<td bgcolor=#FFDDDD><b>A Import</b></td>';
map {	map {
$tabledata.="<td><b><font size=+1>$_</font></b></td>";	$tabledata.="<td><b><font size=+1>$_</font></b></td>";
} ('A<br>Import','B','C','D','E','F','G','H','I','J','K','L','M',	} ('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');	'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>';	$tabledata.='</tr>';
my $row;	my $row;
my $maxrow=&getmaxrow($safeeval);	my $maxrow=&getmaxrow($safeeval);
Line 431 sub outsheet {	Line 450 sub outsheet {
# --------------------------------------- Read spreadsheet formulas from a file	# --------------------------------------- Read spreadsheet formulas from a file

sub readsheet {	sub readsheet {
my ($safeeval,$fn)=shift;	my ($safeeval,$fn)=@_;
&setfilename($safeeval,$fn);	&setfilename($safeeval,$fn);
$fn=~/\.(\w+)/;	$fn=~/\.(\w+)/;
&settype($safeeval,$1);	&settype($safeeval,$1);
my %f=();	my %f=();
my $content;	unless ($spreadsheets{$fn}) {
{	$spreadsheets{$fn}='';
my $fh=Apache::File->new($fn);	{
$content=join('',<$fh>);	my $fh;
	if ($fh=Apache::File->new($fn)) {
	$spreadsheets{$fn}=join('',<$fh>);
	}
	}
}	}
{	{
my $parser=HTML::TokeParser->new(\$content);	my $parser=HTML::TokeParser->new(\$spreadsheets{$fn});
my $token;	my $token;
while ($token=$parser->get_token) {	while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
Line 456 sub readsheet {	Line 479 sub readsheet {
&setformulas($safeeval,%f);	&setformulas($safeeval,%f);
}	}

	# ----------------------------------------------- Make a temp copy of the sheet

	sub tmpwrite {
	my ($safeeval,$tmpdir,$uname,$udom,$symb)=@_;
	my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
	$fn=~s/\W/\_/g;
	$fn=$tmpdir.$fn.'.tmp';
	my $fh;
	if ($fh=Apache::File->new('>'.$fn)) {
	print $fh join("\n",&getformulas($safeeval));
	}
	}

	# ---------------------------------------------------------- Read the temp copy

	sub tmpread {
	my ($safeeval,$tmpdir,$uname,$udom,$symb,$nfield,$nform)=@_;
	my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
	$fn=~s/\W/\_/g;
	$fn=$tmpdir.$fn.'.tmp';
	my $fh;
	my %fo=();
	if ($fh=Apache::File->new($fn)) {
	my $name;
	while ($name=<$fh>) {
	chomp($name);
	my $value=<$fh>;
	chomp($value);
	$fo{$name}=$value;
	}
	}
	$fo{$nfield}=$nform;
	&setformulas($safeeval,%fo);
	}

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

sub readmeta {	sub readmeta {
Line 510 sub updaterows {	Line 568 sub updaterows {
'___'.$resid.'___'.	'___'.$resid.'___'.
&Apache::lonnet::declutter($srcf);	&Apache::lonnet::declutter($srcf);
$allassess{$symb}=$bighash{'title_'.$id};	$allassess{$symb}=$bighash{'title_'.$id};

if ($stype eq 'assesscalc') {	if ($stype eq 'assesscalc') {
map {	map {
if ($_=~/^stores\_(.*)/) {	if ($_=~/^stores\_(.*)/) {
Line 520 sub updaterows {	Line 579 sub updaterows {
$display=	$display=
&Apache::lonnet::metadata($srcf,$key.'.name');	&Apache::lonnet::metadata($srcf,$key.'.name');
}	}


$allkeys{$key}=$display;	$allkeys{$key}=$display;
}	}
} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));	} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
Line 612 sub rowaassess {	Line 673 sub rowaassess {
&setconstants($safeeval,%c);	&setconstants($safeeval,%c);
}	}

	# --------------------------------------------------------- Various form fields

sub handler {	sub textfield {
	my ($title,$name,$value)=@_;
	return "\n<p><b>$title:</b><br>".
	'<input type=text name="'.$name.'" size=80 value="'.$value.'">';
	}

	sub hiddenfield {
	my ($name,$value)=@_;
	return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
	}

	sub selectbox {
	my ($title,$name,$value,%options)=@_;
	my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
	map {
	$selout.='<option value="'.$_.'"';
	if ($_ eq $value) { $selout.=' selected'; }
	$selout.='>'.$options{$_}.'</option>';
	} sort keys %options;
	return $selout.'</select>';
	}

	# ---------------------------------------------------------------- Main handler

	sub handler {
my $r=shift;	my $r=shift;

$r->content_type('text/html');	if ($r->header_only) {
$r->send_http_header;	$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')) {

	# --------------------------- Get query string for limited number of parameters
	map {
	my ($name, $value) = split(/=/,$_);
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	if (($name='uname') \|\| ($name='udom') \|\| ($name='usymb')) {
	unless ($ENV{'form.'.$name}) {
	$ENV{'form.'.$name}=$value;
	}
	}
	} (split(/&/,$ENV{'QUERY_STRING'}));

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

$r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');	unless ($ENV{'form.uname'}) {
$r->print('<body bgcolor="#FFFFFF">');	$ENV{'form.uname'}=$ENV{'user.name'};
	$ENV{'form.udom'}=$ENV{'user.domain'};
	}
	# ------------------------------------------------------------------- Open page

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

	$r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
	$r->print(<<ENDSCRIPT);
	<script language="JavaScript">

	function celledit(cn,cf) {
	var cnf=prompt(cn,cf);
	if (cnf!=null) {
	document.sheet.unewfield.value=cn;
	document.sheet.unewformula.value=cnf;
	document.sheet.submit();
	}
	}

	</script>
	ENDSCRIPT
	$r->print('</head><body bgcolor="#FFFFFF">'.
	'<form action="'.$r->uri.'" name=sheet method=post>'.
	&hiddenfield('uname',$ENV{'form.uname'}).
	&hiddenfield('udom',$ENV{'form.udom'}).
	&hiddenfield('usymb',$ENV{'form.usymb'}).
	&hiddenfield('unewfield','').
	&hiddenfield('unewformula',''));
my $sheetone=initsheet();	my $sheetone=initsheet();
&setformulas($sheetone,	if ($ENV{'form.unewfield'}) {
'B3' => 5, 'C4' => 6, 'C6' => 'B3+C4', 'C2' => 'C6+B5', 'B5'=>'&SUM("A*")',	$r->print('<h2>Modified Workcopy</h2>');
'A1' => 'a1', 'A2'=>'a2', 'A3'=>'a3','A4'=>'a4','A5'=>'a5','A6'=>'a6');	$ENV{'form.unewformula'}=~s/\'/\"/g;
&setrowlabels($sheetone,	$r->print('New formula: '.$ENV{'form.unewfield'}.'='.
'a1'=>'A Points','a2'=>'B Points','a3'=>'C Points',	$ENV{'form.unewformula'}.'<br>');
'a4'=>'Percentage Correct','a5'=>'Bonus Points','a6'=>'Points Awarded');	&tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
&setconstants($sheetone,	$ENV{'form.uname'},$ENV{'form.udom'},$ENV{'form.usymb'},
'A1' => '3', 'A2'=>'4', 'A3'=>'0','A4'=>'76','A5'=>'1.5','A6'=>'6');	$ENV{'form.unewfield'},$ENV{'form.unewformula'});
	&setfilename($sheetone,$r->filename);
&setmaxrow($sheetone,6);	$r->filename=~/\.(\w+)/;
	&settype($sheetone,$1);
	} else {
	&readsheet($sheetone,$r->filename);
	}
	&updaterows($sheetone);
	&tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
	$ENV{'form.uname'},$ENV{'form.udom'},$ENV{'form.usymb'});
&calcsheet($sheetone);	&calcsheet($sheetone);
$r->print(&outsheet($sheetone));	$r->print(&outsheet($sheetone));
$r->print('</body></html>');
	$r->print('</form></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;	return OK;
}	}

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

Removed from v.1.6
changed lines
	Added in v.1.10