--- loncom/interface/Attic/lonspreadsheet.pm 2002/10/22 13:13:15 1.121 +++ loncom/interface/Attic/lonspreadsheet.pm 2003/02/13 19:07:46 1.168 @@ -1,5 +1,5 @@ # -# $Id: lonspreadsheet.pm,v 1.121 2002/10/22 13:13:15 matthew Exp $ +# $Id: lonspreadsheet.pm,v 1.168 2003/02/13 19:07:46 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -50,18 +50,453 @@ built-in functions. =cut + package Apache::lonspreadsheet; use strict; +use Apache::Constants qw(:common :http); +use Apache::lonnet; +use Apache::lonhtmlcommon; +use HTML::Entities(); + +# --------------------------------------------------------- Various form fields + +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.'">'; + foreach (sort keys(%options)) { + $selout.='<option value="'.$_.'"'; + if ($_ eq $value) { $selout.=' selected'; } + $selout.='>'.$options{$_}.'</option>'; + } + return $selout.'</select>'; +} + +my %oldsheets; +my %loadedcaches; + +# ================================================================ Main handler +# +# Interactive call to screen +# +# +sub handler { + my $r=shift; + + my ($sheettype) = ($r->uri=~/\/(\w+)$/); + + if (! exists($ENV{'form.Status'})) { + $ENV{'form.Status'} = 'Active'; + } + if ( ! exists($ENV{'form.output'}) || + ($sheettype ne 'classcalc' && + lc($ENV{'form.output'}) eq 'recursive excel')) { + $ENV{'form.output'} = 'HTML'; + } + # + # Overload checking + # + # Check this server + my $loaderror=&Apache::lonnet::overloaderror($r); + if ($loaderror) { return $loaderror; } + # Check the course homeserver + $loaderror= &Apache::lonnet::overloaderror($r, + $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); + if ($loaderror) { return $loaderror; } + # + # HTML Header + # + if ($r->header_only) { + $r->content_type('text/html'); + $r->send_http_header; + return OK; + } + # + # Roles Checking + # + # Needs to be in a course + if (! $ENV{'request.course.fn'}) { + # 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; + } + # + # Get query string for limited number of parameters + # + &Apache::loncommon::get_unprocessed_cgi + ($ENV{'QUERY_STRING'},['uname','udom','usymb','ufn','mapid','resid']); + # + # Deal with restricted student permissions + # + if ($ENV{'request.role'} =~ /^st\./) { + delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'})); + delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'})); + } + # + # Look for special assessment spreadsheets - '_feedback', etc. + # + if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'} || + $ENV{'form.ufn'} eq '' || + $ENV{'form.ufn'} eq 'default')) { + $ENV{'form.ufn'}='default_'.$1; + } + if (!$ENV{'form.ufn'} || $ENV{'form.ufn'} eq 'default') { + $ENV{'form.ufn'}='course_default_'.$sheettype; + } + # + # Interactive loading of specific sheet? + # + if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { + $ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; + } + # + # Determine the user name and domain for the sheet. + my $aname; + my $adom; + unless ($ENV{'form.uname'}) { + $aname=$ENV{'user.name'}; + $adom=$ENV{'user.domain'}; + } else { + $aname=$ENV{'form.uname'}; + $adom=$ENV{'form.udom'}; + } + # + # Open page, try to prevent browser cache. + # + $r->content_type('text/html'); + $r->header_out('Cache-control','no-cache'); + $r->header_out('Pragma','no-cache'); + $r->send_http_header; + # + # Header.... + # + $r->print('<html><head><title>LON-CAPA Spreadsheet</title>'); + my $nothing = "''"; + if ($ENV{'browser.type'} eq 'explorer') { + $nothing = "'javascript:void(0);'"; + } + + if ($ENV{'request.role'} !~ /^st\./) { + $r->print(<<ENDSCRIPT); +<script language="JavaScript"> + + var editwin; + + function celledit(cellname,cellformula) { + var edit_text = ''; + // cellformula may contain less-than and greater-than symbols, so + // we need to escape them? + edit_text +='<html><head><title>Cell Edit Window</title></head><body>'; + edit_text += '<form name="editwinform">'; + edit_text += '<center><h3>Cell '+cellname+'</h3>'; + edit_text += '<textarea name="newformula" cols="40" rows="6"'; + edit_text += ' wrap="off" >'+cellformula+'</textarea>'; + edit_text += '</br>'; + edit_text += '<input type="button" name="accept" value="Accept"'; + edit_text += ' onClick=\\\'javascript:'; + edit_text += 'opener.document.sheet.unewfield.value='; + edit_text += '"'+cellname+'";'; + edit_text += 'opener.document.sheet.unewformula.value='; + edit_text += 'document.editwinform.newformula.value;'; + edit_text += 'opener.document.sheet.submit();'; + edit_text += 'self.close()\\\' />'; + edit_text += ' '; + edit_text += '<input type="button" name="abort" '; + edit_text += 'value="Discard Changes"'; + edit_text += ' onClick="javascript:self.close()" />'; + edit_text += '</center></body></html>'; + + if (editwin != null && !(editwin.closed) ) { + editwin.close(); + } + + editwin = window.open($nothing,'CellEditWin','height=200,width=350,scrollbars=no,resizeable=yes,alwaysRaised=yes,dependent=yes',true); + editwin.document.write(edit_text); + } + + function changesheet(cn) { + document.sheet.unewfield.value=cn; + document.sheet.unewformula.value='changesheet'; + document.sheet.submit(); + } + + function insertrow(cn) { + document.sheet.unewfield.value='insertrow'; + document.sheet.unewformula.value=cn; + document.sheet.submit(); + } + +</script> +ENDSCRIPT + } + $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet'). + '<form action="'.$r->uri.'" name="sheet" method="post">'); + $r->print(&hiddenfield('uname',$ENV{'form.uname'}). + &hiddenfield('udom',$ENV{'form.udom'}). + &hiddenfield('usymb',$ENV{'form.usymb'}). + &hiddenfield('unewfield',''). + &hiddenfield('unewformula','')); + $r->rflush(); + # + # Full recalc? + # + # Read new sheet or modified worksheet + my $sheet=Apache::lonspreadsheet::Spreadsheet->new($aname,$adom,$sheettype,$ENV{'form.usymb'}); + if ($ENV{'form.forcerecalc'}) { + $r->print('<h4>Completely Recalculating Sheet ...</h4>'); + $sheet->complete_recalc(); + } + # + # Global directory configs + # + $sheet->includedir($r->dir_config('lonIncludes')); + $sheet->tmpdir($r->dir_config('lonDaemons').'/tmp/'); + # + # Check user permissions + if (($sheet->{'type'} eq 'classcalc' ) || + ($sheet->{'uname'} ne $ENV{'user.name'} ) || + ($sheet->{'udom'} ne $ENV{'user.domain'})) { + unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) { + $r->print('<h1>Access Permission Denied</h1>'. + '</form></body></html>'); + return OK; + } + } + # Print out user information + $r->print('<h2>'.$sheet->{'coursedesc'}.'</h2>'); + if ($sheet->{'type'} ne 'classcalc') { + $r->print('<h2>'.$sheet->gettitle().'</h2><p>'); + } + if ($sheet->{'type'} eq 'assesscalc') { + $r->print('<b>User:</b> '.$sheet->{'uname'}. + '<br /><b>Domain:</b> '.$sheet->{'udom'}.'<br />'); + } + if ($sheet->{'type'} eq 'studentcalc' || + $sheet->{'type'} eq 'assesscalc') { + $r->print('<b>Section/Group:</b>'.$sheet->{'csec'}.'</p>'); + } + # + # If a new formula had been entered, go from work copy + if ($ENV{'form.unewfield'}) { + $r->print('<h2>Modified Workcopy</h2>'); + #$ENV{'form.unewformula'}=~s/\'/\"/g; + $r->print('<p>Cell '.$ENV{'form.unewfield'}.' = <pre>'); + $r->print(&HTML::Entities::encode($ENV{'form.unewformula'}). + '</pre></p>'); + $sheet->{'filename'} = $ENV{'form.ufn'}; + $sheet->tmpread($ENV{'form.unewfield'},$ENV{'form.unewformula'}); + } elsif ($ENV{'form.saveas'}) { + $sheet->{'filename'} = $ENV{'form.ufn'}; + $sheet->tmpread(); + } else { + $sheet->readsheet($ENV{'form.ufn'}); + } + # Additional options + if ($sheet->{'type'} eq 'assesscalc') { + $r->print('<p><font size=+2>'. + '<a href="/adm/studentcalc?'. + 'uname='.$sheet->{'uname'}. + '&udom='.$sheet->{'udom'}.'">'. + 'Level up: Student Sheet</a></font></p>'); + } + if (($sheet->{'type'} eq 'studentcalc') && + (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) { + $r->print ('<p><font size=+2><a href="/adm/classcalc">'. + 'Level up: Course Sheet</a></font></p>'); + } + # Recalc button + $r->print('<br />'. + '<input type="submit" name="forcerecalc" '. + 'value="Completely Recalculate Sheet"></p>'); + # Save dialog + if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { + my $fname=$ENV{'form.ufn'}; + $fname=~s/\_[^\_]+$//; + if ($fname eq 'default') { $fname='course_default'; } + $r->print('<input type=submit name=saveas value="Save as ...">'. + '<input type=text size=20 name=newfn value="'.$fname.'">'. + 'make default: <input type=checkbox name="makedefufn"><p>'); + } + $r->print(&hiddenfield('ufn',$sheet->{'filename'})); + # Load dialog + if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { + $r->print('<p><input type=submit name=load value="Load ...">'. + '<select name="loadthissheet">'. + '<option name="default">Default</option>'); + foreach ($sheet->othersheets()) { + $r->print('<option name="'.$_.'"'); + if ($ENV{'form.ufn'} eq $_) { + $r->print(' selected'); + } + $r->print('>'.$_.'</option>'); + } + $r->print('</select><p>'); + if ($sheet->{'type'} eq 'studentcalc') { + $sheet->setothersheets($sheet->othersheets('assesscalc')); + } + } + # + # Set up caching mechanisms + # + &Apache::lonspreadsheet::Spreadsheet::load_spreadsheet_expirationdates(); + # Clear out old caches if we have not seen this class before. + if (exists($oldsheets{'course'}) && + $oldsheets{'course'} ne $sheet->{'cid'}) { + undef %oldsheets; + undef %loadedcaches; + } + $oldsheets{'course'} = $sheet->{'cid'}; + # + if ($sheet->{'type'} eq 'classcalc') { + $r->print("Loading previously calculated student sheets ...\n"); + $r->rflush(); + &Apache::lonspreadsheet::Spreadsheet::cachedcsheets(); + } elsif ($sheet->{'type'} eq 'studentcalc') { + $r->print("Loading previously calculated assessment sheets ...\n"); + $r->rflush(); + $sheet->cachedssheets(); + } + # Update sheet, load rows + $r->print("Loaded sheet(s), updating rows ...<br>\n"); + $r->rflush(); + # + $sheet->updatesheet(); + $r->print("Updated rows, loading row data ...\n"); + $r->rflush(); + # + $sheet->loadrows($r); + $r->print("Loaded row data, calculating sheet ...<br>\n"); + $r->rflush(); + # + my $calcoutput=$sheet->calcsheet(); + $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); + # See if something to save + if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { + my $fname=''; + if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { + $fname=~s/\W/\_/g; + if ($fname eq 'default') { $fname='course_default'; } + $fname.='_'.$sheet->{'type'}; + $sheet->{'filename'} = $fname; + $ENV{'form.ufn'}=$fname; + $r->print('<p>Saving spreadsheet: '. + $sheet->writesheet($ENV{'form.makedefufn'}). + '<p>'); + } + } + # + # Write the modified worksheet + $r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'</p>'); + $sheet->tmpwrite(); + if ($sheet->{'type'} eq 'assesscalc') { + $r->print('<p>Show rows with empty A column: '); + } else { + $r->print('<p>Show empty rows: '); + } + # + $r->print(&hiddenfield('userselhidden','true'). + '<input type="checkbox" name="showall" onClick="submit()"'); + # + if ($ENV{'form.showall'}) { + $r->print(' checked'); + } else { + unless ($ENV{'form.userselhidden'}) { + unless + ($ENV{'course.'.$sheet->{'cid'}.'.hideemptyrows'} eq 'yes') { + $r->print(' checked'); + $ENV{'form.showall'}=1; + } + } + } + $r->print('>'); + # + # output format select box + $r->print(' Output as <select name="output" size="1" onChange="submit()">'. + "\n"); + foreach my $mode (qw/HTML CSV Excel/) { + $r->print('<option value="'.$mode.'"'); + if ($ENV{'form.output'} eq $mode) { + $r->print(' selected '); + } + $r->print('>'.$mode.'</option>'."\n"); + } +# +# Mulit-sheet excel takes too long and does not work at all for large +# classes. Future inclusion of this option may be possible with the +# Spreadsheet::WriteExcel::Big and speed improvements. +# +# if ($sheet->{'type'} eq 'classcalc') { +# $r->print('<option value="recursive excel"'); +# if ($ENV{'form.output'} eq 'recursive excel') { +# $r->print(' selected '); +# } +# $r->print(">Multi-Sheet Excel</option>\n"); +# } + $r->print("</select>\n"); + # + if ($sheet->{'type'} eq 'classcalc') { + $r->print(' Student Status: '. + &Apache::lonhtmlcommon::StatusOptions + ($ENV{'form.Status'},'sheet')); + } + # + # Buttons to insert rows +# $r->print(<<ENDINSERTBUTTONS); +#<br> +#<input type='button' onClick='insertrow("top");' +#value='Insert Row Top'> +#<input type='button' onClick='insertrow("bottom");' +#value='Insert Row Bottom'><br> +#ENDINSERTBUTTONS + # Print out sheet + $sheet->outsheet($r); + $r->print('</form></body></html>'); + # Done + return OK; +} + +1; + +############################################################# +############################################################# +############################################################# + +package Apache::lonspreadsheet::Spreadsheet; + +use strict; +use Apache::Constants qw(:common :http); +use Apache::lonnet; +use Apache::loncoursedata; +use Apache::File(); use Safe; use Safe::Hole; use Opcode; -use Apache::lonnet; -use Apache::Constants qw(:common :http); use GDBM_File; +use HTML::Entities(); use HTML::TokeParser; -use Apache::lonhtmlcommon; -use Apache::loncoursedata; +use Spreadsheet::WriteExcel; +use Time::HiRes; + +# +# These global hashes are dependent on user, course and resource, +# and need to be initialized every time when a sheet is calculated +# +my %courseopt; +my %useropt; +my %parmhash; + # # Caches for coursewide information # @@ -70,71 +505,309 @@ my %Section; # # Caches for previously calculated spreadsheets # - -my %oldsheets; -my %loadedcaches; my %expiredates; # # Cache for stores of an individual user # - my $cachedassess; my %cachedstores; # -# These cache hashes need to be independent of user, resource and course -# (user and course can/should be in the keys) +# Some hashes for stats on timing and performance # +my %starttimes; +my %usedtimes; +my %numbertimes; + +# +# Directories +# +my $includedir; +my $tmpdir; + +sub includedir { + my $self = shift; + $includedir = shift; +} + +sub tmpdir { + my $self = shift; + $tmpdir = shift; +} my %spreadsheets; +#my %loadedcaches; my %courserdatas; my %userrdatas; my %defaultsheets; -my %updatedata; +my %rowlabel_cache; +#my %oldsheets; + +sub complete_recalc { + my $self = shift; + undef %spreadsheets; + undef %courserdatas; + undef %userrdatas; + undef %defaultsheets; + undef %rowlabel_cache; +} + +sub get_sheet { + my $self = shift; + my $sheet_id = shift; + my $formulas; + # if we already have the file loaded and parsed, return the formulas + if (exists($self->{'sheets'}->{$sheet_id})) { + $formulas = $self->{'sheets'}->{$sheet_id}; + $self->debug('retrieved '.$sheet_id); + } else { + # load the file + # set $error and return undef if there is an error loading + # parse it + # set $error and return undef if there is an error parsing + } + return $formulas; +} # -# These global hashes are dependent on user, course and resource, -# and need to be initialized every time when a sheet is calculated +# Load previously cached student spreadsheets for this course # -my %courseopt; -my %useropt; -my %parmhash; +sub load_spreadsheet_expirationdates { + undef %expiredates; + my $cid=$ENV{'request.course.id'}; + my @tmp = &Apache::lonnet::dump('nohist_expirationdates', + $ENV{'course.'.$cid.'.domain'}, + $ENV{'course.'.$cid.'.num'}); + if (lc($tmp[0]) !~ /^error/){ + %expiredates = @tmp; + } +} +# ===================================================== Calculated sheets cache # -# Some hashes for stats on timing and performance +# Load previously cached student spreadsheets for this course # +sub cachedcsheets { + my $cid=$ENV{'request.course.id'}; + my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets', + $ENV{'course.'.$cid.'.domain'}, + $ENV{'course.'.$cid.'.num'}); + if ($tmp[0] !~ /^error/) { + my %StupidTempHash = @tmp; + while (my ($key,$value) = each %StupidTempHash) { + $Apache::lonspreadsheet::oldsheets{$key} = $value; + } + } +} -my %starttimes; -my %usedtimes; -my %numbertimes; +# +# Load previously cached assessment spreadsheets for this student +# +sub cachedssheets { + my $self = shift; + my ($uname,$udom) = @_; + $uname = $uname || $self->{'uname'}; + $udom = $udom || $self->{'udom'}; + if (! exists($Apache::lonspreadsheet::loadedcaches{$uname.'_'.$udom})) { + my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. + $ENV{'request.course.id'}, + $self->{'udom'}, + $self->{'uname'}); + if ($tmp[0] !~ /^error/) { + my %TempHash = @tmp; + my $count = 0; + while (my ($key,$value) = each %TempHash) { + $Apache::lonspreadsheet::oldsheets{$key} = $value; + $count++; + } + $Apache::lonspreadsheet::loadedcaches{$self->{'uname'}.'_'.$self->{'udom'}}=1; + } + } +} -# Stuff that only the screen handler can know +# ======================================================= Forced recalculation? +sub checkthis { + my ($keyname,$time)=@_; + if (! exists($expiredates{$keyname})) { + return 0; + } else { + return ($time<$expiredates{$keyname}); + } +} -my $includedir; -my $tmpdir; +sub forcedrecalc { + my ($uname,$udom,$stype,$usymb)=@_; + my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; + my $time=$Apache::lonspreadsheet::oldsheets{$key.'.time'}; + if ($ENV{'form.forcerecalc'}) { return 1; } + unless ($time) { return 1; } + if ($stype eq 'assesscalc') { + my $map=(split(/___/,$usymb))[0]; + if (&checkthis('::assesscalc:',$time) || + &checkthis('::assesscalc:'.$map,$time) || + &checkthis('::assesscalc:'.$usymb,$time) || + &checkthis($uname.':'.$udom.':assesscalc:',$time) || + &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) || + &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) { + return 1; + } + } else { + if (&checkthis('::studentcalc:',$time) || + &checkthis($uname.':'.$udom.':studentcalc:',$time)) { + return 1; + } + } + return 0; +} -# ============================================================================= -# ===================================== Implements an instance of a spreadsheet + +################################################## +################################################## + +=pod + +=item &parmval() + +Determine the value of a parameter. + +Inputs: $what, the parameter needed, $symb, $uname, $udom, $csec + +Returns: The value of a parameter, or '' if none. + +This function cascades through the possible levels searching for a value for +a parameter. The levels are checked in the following order: +user, course (at section level and course level), map, and lonnet::metadata. +This function uses %parmhash, which must be tied prior to calling it. +This function also requires %courseopt and %useropt to be initialized for +this user and course. + +=cut + +################################################## +################################################## +sub parmval { + my ($what,$symb,$uname,$udom,$csec)=@_; + return '' if (!$symb); + # + my $cid = $ENV{'request.course.id'}; + my $result=''; + # + my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); + # Cascading lookup scheme + my $rwhat=$what; + $what =~ s/^parameter\_//; + $what =~ s/\_([^\_]+)$/\.$1/; + # + my $symbparm = $symb.'.'.$what; + my $mapparm = $mapname.'___(all).'.$what; + my $usercourseprefix = $uname.'_'.$udom.'_'.$cid; + # + my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; + my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; + my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; + # + my $courselevel = $usercourseprefix.'.'.$what; + my $courselevelr = $usercourseprefix.'.'.$symbparm; + my $courselevelm = $usercourseprefix.'.'.$mapparm; + # fourth, check user + if (defined($uname)) { + return $useropt{$courselevelr} if (defined($useropt{$courselevelr})); + return $useropt{$courselevelm} if (defined($useropt{$courselevelm})); + return $useropt{$courselevel} if (defined($useropt{$courselevel})); + } + # third, check course + if (defined($csec)) { + return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); + return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); + return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); + } + # + return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); + return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); + return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); + # second, check map parms + my $thisparm = $parmhash{$symbparm}; + return $thisparm if (defined($thisparm)); + # first, check default + return &Apache::lonnet::metadata($fn,$rwhat.'.default'); +} + +# +# new: Make a new spreadsheet +# +sub new { + my $this = shift; + my $class = ref($this) || $this; + # + my ($uname,$udom,$stype,$usymb)=@_; + # + my $self = { + uname => $uname, + udom => $udom, + type => $stype, + usymb => $usymb, + errorlog => '', + maxrow => '', + mapid => $ENV{'form.mapid'}, + resid => $ENV{'form.resid'}, + cid => $ENV{'request.course.id'}, + csec => $Section{$uname.':'.$udom}, + cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, + cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'}, + coursefilename => $ENV{'request.course.fn'}, + coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, + rows => [], + template_cells => [], + }; + $self->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom); + # + # + $self->{'formulas'} = {}; + $self->{'constants'} = {}; + $self->{'othersheets'} = []; + $self->{'rowlabel'} = {}; + # + # + $self->{'safe'} = &initsheet($self->{'type'}); + $self->{'root'} = $self->{'safe'}->root(); + # + # Place some of the %$self items into the safe space except the safe space + # itself + my $initstring = ''; + foreach (qw/uname udom type usymb cid csec coursefilename + cnum cdom chome uhome/) { + $initstring.= qq{\$$_="$self->{$_}";}; + } + $self->{'safe'}->reval($initstring); + bless($self,$class); + return $self; +} ## ## mask - used to reside in the safe space. ## +{ + +my %memoizer; + 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 $key = $lower.'_'.$upper; + if (exists($memoizer{$key})) { + return $memoizer{$key}; + } + $upper = $lower if (! defined($upper)); + # + my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/); + my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/); + # my $alpha=''; my $num=''; - + # if (($la eq '*') || ($ua eq '*')) { - $alpha='[A-Za-z]'; + $alpha='[A-Za-z]'; } else { if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { @@ -188,91 +861,22 @@ sub mask { } $num.=')'; } else { - if ($lda[$#lda]!=$uda[$#uda]) { - $num.='['.$lda[$#lda].'-'.$uda[$#uda].']'; + if ($lda[-1]!=$uda[-1]) { + $num.='['.$lda[-1].'-'.$uda[-1].']'; } } } } - return '^'.$alpha.$num."\$"; + my $expression ='^'.$alpha.$num."\$"; + $memoizer{$key} = $expression; + return $expression; } +} - -sub initsheet { - my $safeeval = new Safe(shift); - 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'); - $safehole->wrap(\&Apache::lonspreadsheet::mask,$safeeval,'&mask'); - $safehole->wrap(\&Apache::lonspreadsheet::templaterow,$safeeval,'&templaterow'); - $safeeval->share('$@'); - 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 -# os: other spreadsheets (for student spreadsheet only) - -undef %sheet_values; # Holds the (computed, final) values for the sheet - # This is only written to by &calc, the spreadsheet computation routine. - # It is read by many functions -undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, - # which does the translation of strings like C5 into the value in C5. - # Used in &calc - %t holds the values that are actually eval'd. -undef %f; # Holds the formulas for each cell. This is the users - # (spreadsheet authors) data for each cell. - # set by &setformulas and returned by &getformulas - # &setformulas is called by &readsheet, &tmpread, &updateclasssheet, - # &updatestudentassesssheet, &loadstudent, &loadcourse - # &getformulas is called by &writesheet, &tmpwrite, &updateclasssheet, - # &updatestudentassesssheet, &loadstudent, &loadcourse, &loadassessment, -undef %c; # Holds the constants for a sheet. In the assessment - # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, - # &sett, and &setconstants. There is no &getconstants. - # &setconstants is called by &loadstudent, &loadcourse, &load assessment, -undef %rowlabel; # Holds the 'prefix' for each row. Set by &setrowlabels. - # &setrowlabels is called by &updateclasssheet, &updatestudentassesssheet, -undef @os; # Holds the names of other spreadsheets - this is used to specify - # the spreadsheets that are available for the assessment sheet. - # Set by &setothersheets. &setothersheets is called by &handler. A - # related subroutine is &othersheets. - -$maxrow = 0; -$sheettype = ''; - -# filename/reference of the sheet -$filename = ''; - -# user data -$uname = ''; -$uhome = ''; -$udom = ''; - -# course data - -$csec = ''; -$chome= ''; -$cnum = ''; -$cdom = ''; -$cid = ''; -$coursefilename = ''; - -# symb - -$usymb = ''; - -# error messages -$errormsg = ''; - - +sub add_hash_to_safe { + my $self = shift; + my $code = <<'END'; #------------------------------------------------------- =item UWCALC(hashname,modules,units,date) @@ -539,6 +1143,75 @@ sub HASH { } return $Values[-1]; } +END + $self->{'safe'}->reval($code); + return; +} + +sub initsheet { + my $safeeval = new Safe(shift); + 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'); + $safehole->wrap(\&mask,$safeeval,'&mask'); + $safeeval->share('$@'); + 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 +# os: other spreadsheets (for student spreadsheet only) + +undef %sheet_values; # Holds the (computed, final) values for the sheet + # This is only written to by &calc, the spreadsheet computation routine. + # It is read by many functions +undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, + # which does the translation of strings like C5 into the value in C5. + # Used in &calc - %t holds the values that are actually eval'd. +undef %f; # Holds the formulas for each cell. This is the users + # (spreadsheet authors) data for each cell. +undef %c; # Holds the constants for a sheet. In the assessment + # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, + # &sett, and &constants. There is no &getconstants. + # &constants is called by &loadstudent, &loadcourse, &load assessment, +undef @os; # Holds the names of other spreadsheets - this is used to specify + # the spreadsheets that are available for the assessment sheet. + # Set by &setothersheets. &setothersheets is called by &handler. A + # related subroutine is &othersheets. +$errorlog = ''; + +$maxrow = 0; +$type = ''; + +# filename/reference of the sheet +$filename = ''; + +# user data +$uname = ''; +$uhome = ''; +$udom = ''; + +# course data + +$csec = ''; +$chome= ''; +$cnum = ''; +$cdom = ''; +$cid = ''; +$coursefilename = ''; + +# symb + +$usymb = ''; + +# error messages +$errormsg = ''; #------------------------------------------------------- @@ -550,14 +1223,14 @@ returns the number of items in the range #------------------------------------------------------- sub NUM { - my $mask=mask(@_); + my $mask=&mask(@_); my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; return $num; } sub BIN { my ($low,$high,$lower,$upper)=@_; - my $mask=mask($lower,$upper); + my $mask=&mask($lower,$upper); my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { @@ -578,7 +1251,7 @@ returns the sum of items in the range. #------------------------------------------------------- sub SUM { - my $mask=mask(@_); + my $mask=&mask(@_); my $sum=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; @@ -596,8 +1269,10 @@ compute the average of the items in the #------------------------------------------------------- sub MEAN { - my $mask=mask(@_); - my $sum=0; my $num=0; + my $mask=&mask(@_); +# $errorlog.='(mask = '.$mask.' )'; + my $sum=0; + my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; $num++; @@ -619,7 +1294,8 @@ compute the standard deviation of the it #------------------------------------------------------- sub STDDEV { - my $mask=mask(@_); + my $mask=&mask(@_); +# $errorlog.='(mask = '.$mask.' )'; my $sum=0; my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; @@ -644,7 +1320,7 @@ compute the product of the items in the #------------------------------------------------------- sub PROD { - my $mask=mask(@_); + my $mask=&mask(@_); my $prod=1; foreach (grep /$mask/,keys(%sheet_values)) { $prod*=$sheet_values{$_}; @@ -662,7 +1338,7 @@ compute the maximum of the items in the #------------------------------------------------------- sub MAX { - my $mask=mask(@_); + my $mask=&mask(@_); my $max='-'; foreach (grep /$mask/,keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } @@ -681,7 +1357,7 @@ compute the minimum of the items in the #------------------------------------------------------- sub MIN { - my $mask=mask(@_); + my $mask=&mask(@_); my $min='-'; foreach (grep /$mask/,keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } @@ -704,7 +1380,7 @@ compute the sum of the largest 'num' ite #------------------------------------------------------- sub SUMMAX { my ($num,$lower,$upper)=@_; - my $mask=mask($lower,$upper); + my $mask=&mask($lower,$upper); my @inside=(); foreach (grep /$mask/,keys(%sheet_values)) { push (@inside,$sheet_values{$_}); @@ -729,7 +1405,7 @@ compute the sum of the smallest 'num' it #------------------------------------------------------- sub SUMMIN { my ($num,$lower,$upper)=@_; - my $mask=mask($lower,$upper); + my $mask=&mask($lower,$upper); my @inside=(); foreach (grep /$mask/,keys(%sheet_values)) { $inside[$#inside+1]=$sheet_values{$_}; @@ -788,20 +1464,58 @@ sub MAXPARM { return $max; } -#-------------------------------------------------------- +sub calc { +# $errorlog .= "\%t has ".(keys(%t))." keys\n"; + %sheet_values = %t; # copy %t into %sheet_values. +# $errorlog .= "\%sheet_values has ".(keys(%sheet_values))." keys\n"; + my $notfinished=1; + my $lastcalc=''; + my $depth=0; + while ($notfinished) { + $notfinished=0; + while (my ($cell,$value) = each(%t)) { + my $old=$sheet_values{$cell}; + $sheet_values{$cell}=eval $value; + if ($@) { + undef %sheet_values; + return $cell.': '.$@; + } + if ($sheet_values{$cell} ne $old) { + $notfinished=1; + $lastcalc=$cell; + } + } + $depth++; + if ($depth>100) { + undef %sheet_values; + return $lastcalc.': Maximum calculation depth exceeded'; + } + } + return ''; +} + +# ------------------------------------------- End of "Inside of the safe space" +ENDDEFS + $safeeval->reval($code); + return $safeeval; +} + + +# +# expandnamed used to reside in the safe space +# sub expandnamed { + my $self = shift; my $expression=shift; if ($expression=~/^\&/) { my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/); my @vars=split(/\W+/,$formula); my %values=(); - undef %values; - foreach ( @vars ) { - my $varname=$_; + foreach my $varname ( @vars ) { if ($varname=~/\D/) { $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; $varname=~s/$var/\(\\w\+\)/g; - foreach (keys(%c)) { + foreach (keys(%{$self->{'constants'}})) { if ($_=~/$varname/) { $values{$1}=1; } @@ -831,47 +1545,53 @@ sub expandnamed { my @matches = (); $#matches = -1; study $expression; - foreach $parameter (keys(%c)) { + my $parameter; + foreach $parameter (keys(%{$self->{'constants'}})) { push @matches,$parameter if ($parameter =~ /$expression/); } - if ($#matches == 0) { + if (scalar(@matches) == 0) { + $returnvalue = 'unmatched parameter: '.$parameter; + } elsif (scalar(@matches) == 1) { + # why do we not do this lookup here, instead of delaying it? $returnvalue = '$c{\''.$matches[0].'\'}'; - } elsif ($#matches > 0) { + } elsif (scalar(@matches) > 0) { # more than one match. Look for a concise one $returnvalue = "'non-unique parameter name : $expression'"; foreach (@matches) { if (/^$expression$/) { + # why do we not do this lookup here? $returnvalue = '$c{\''.$_.'\'}'; } } } else { - $returnvalue = "'bad parameter name : $expression'"; + # There was a negative number of matches, which indicates + # something is wrong with reality. Better warn the user. + $returnvalue = 'bizzare parameter: '.$parameter; } return $returnvalue; } } +# +# sett used to reside in the safe space +# sub sett { - %t=(); + my $self = shift; + my %t=(); my $pattern=''; - if ($sheettype eq 'assesscalc') { + if ($self->{'type'} eq 'assesscalc') { $pattern='A'; } else { $pattern='[A-Z]'; } # Deal with the template row - foreach (keys(%f)) { - next if ($_!~/template\_(\w)/); - my $col=$1; + foreach my $col ($self->template_cells()) { next if ($col=~/^$pattern/); - foreach (keys(%f)) { - next if ($_!~/A(\d+)/); - my $trow=$1; - next if (! $trow); + foreach my $trow ($self->rows()) { # Get the name of this cell my $lb=$col.$trow; # Grab the template declaration - $t{$lb}=$f{'template_'.$col}; + $t{$lb}=$self->formula('template_'.$col); # Replace '#' with the row number $t{$lb}=~s/\#/$trow/g; # Replace '....' with ',' @@ -879,395 +1599,1005 @@ sub sett { # Replace 'A0' with the value from 'A0' $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; # Replace parameters - $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; + $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; } } # Deal with the normal cells - foreach (keys(%f)) { - if (exists($f{$_}) && ($_!~/template\_/)) { - my $matches=($_=~/^$pattern(\d+)/); - if (($matches) && ($1)) { - unless ($f{$_}=~/^\!/) { - $t{$_}=$c{$_}; - } - } else { - $t{$_}=$f{$_}; - $t{$_}=~s/\.\.+/\,/g; - $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; - $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; + foreach ($self->formulas_keys()) { + next if ($_=~/template\_/); + if (($_=~/^$pattern(\d+)/) && ($1)) { + if ($self->formula($_) !~ /^\!/) { + $t{$_}=$self->{'constants'}->{$_}; } + } else { + $t{$_}=$self->formula($_); + $t{$_}=~s/\.\.+/\,/g; + $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; + $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; } } # For inserted lines, [B-Z] is also valid - unless ($sheettype eq 'assesscalc') { - foreach (keys(%f)) { - if ($_=~/[B-Z](\d+)/) { - if ($f{'A'.$1}=~/^[\~\-]/) { - $t{$_}=$f{$_}; - $t{$_}=~s/\.\.+/\,/g; - $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; - $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; - } - } - } + if ($self->{'type'} ne 'assesscalc') { + foreach ($self->formulas_keys()) { + next if ($_ !~ /[B-Z](\d+)/); + next if ($self->formula('A'.$1) !~ /^[\~\-]/); + $t{$_}=$self->formula($_); + $t{$_}=~s/\.\.+/\,/g; + $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; + $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; + } } # For some reason 'A0' gets special treatment... This seems superfluous # but I imagine it is here for a reason. - $t{'A0'}=$f{'A0'}; + $t{'A0'}=$self->formula('A0'); $t{'A0'}=~s/\.\.+/\,/g; $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; - $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; + $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; + # Put %t into the safe space + %{$self->{'safe'}->varglob('t')}=%t; } -sub calc { - undef %sheet_values; - &sett(); - my $notfinished=1; - my $lastcalc=''; - my $depth=0; - while ($notfinished) { - $notfinished=0; - foreach (keys(%t)) { - my $old=$sheet_values{$_}; - $sheet_values{$_}=eval $t{$_}; - if ($@) { - undef %sheet_values; - return $_.': '.$@; - } - if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; } - } - $depth++; - if ($depth>100) { - undef %sheet_values; - return $lastcalc.': Maximum calculation depth exceeded'; - } - } - return ''; -} +########################################### +### Row output routines ### +########################################### # -# This is actually used for the student spreadsheet, not the assessment sheet -# Do not be fooled by the name! +# get_row: Produce output row n from sheet by calling the appropriate routine # +sub get_row { + my $self = shift; + my ($n) = @_; + my ($rowlabel,@rowdata); + if ($n eq '-') { + ($rowlabel,@rowdata) = $self->templaterow(); + } elsif ($self->{'type'} eq 'studentcalc') { + ($rowlabel,@rowdata) = $self->outrowassess($n); + } else { + ($rowlabel,@rowdata) = $self->outrow($n); + } + return ($rowlabel,@rowdata); +} + +sub templaterow { + my $self = shift; + my @cols=(); + my $rowlabel = 'Template</td><td> '; + foreach my $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') { + push(@cols,{ name => 'template_'.$_, + formula => $self->formula('template_'.$n), + value => $self->value('template_'.$n) }); + } + return ($rowlabel,@cols); +} + sub outrowassess { + my $self = shift; # $n is the current row number - my $n=shift; - my $csv = shift; + my ($n) = @_; my @cols=(); + my $rowlabel=''; if ($n) { - my ($usy,$ufn)=split(/__&&&\__/,$f{'A'.$n}); - if ($rowlabel{$usy}) { - $cols[0]=$rowlabel{$usy}; - if (! $csv) { - $cols[0].='<br>'. - '<select name="sel_'.$n.'" onChange="changesheet('.$n.')">'. - '<option name="default">Default</option>'; - } + my ($usy,$ufn)=split(/__&&&\__/,$self->formula('A'.$n)); + if (exists($self->{'rowlabel'}->{$usy})) { + # This is dumb, but we need the information when we output + # the html version of the studentcalc spreadsheet for the + # links to the assesscalc sheets. + $rowlabel = $self->{'rowlabel'}->{$usy}.':'. + &Apache::lonnet::escape($ufn); } else { - $cols[0]=''; - } - if (! $csv) { - foreach (@os) { - $cols[0].='<option name="'.$_.'"'; - if ($ufn eq $_) { - $cols[0].=' selected'; - } - $cols[0].='>'.$_.'</option>'; - } - $cols[0].='</select>'; + $rowlabel = ''; } + } elsif ($ENV{'request.role'} =~ /^st\./) { + $rowlabel = 'Summary</td><td>0'; } else { - $cols[0]='<b><font size=+1>Export</font></b>'; + $rowlabel = 'Export</td><td>0'; } foreach ('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') { - my $fm=$f{$_.$n}; - $fm=~s/[\'\"]/\&\#34;/g; - push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n}); + push(@cols,{ name => $_.$n, + formula => $self->formula($_.$n), + value => $self->value($_.$n)}); } - return @cols; + return ($rowlabel,@cols); } sub outrow { - my $n=shift; + my $self = shift; + my ($n)=@_; my @cols=(); + my $rowlabel; if ($n) { - $cols[0]=$rowlabel{$f{'A'.$n}}; + $rowlabel = $self->{'rowlabel'}->{$self->formula('A'.$n)}; } else { - $cols[0]='<b><font size=+1>Export</font></b>'; + if ($self->{'type'} eq 'classcalc') { + $rowlabel = 'Summary</td><td>0'; + } else { + $rowlabel = 'Export</td><td>0'; + } } foreach ('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') { - my $fm=$f{$_.$n}; - $fm=~s/[\'\"]/\&\#34;/g; - push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n}); + push(@cols,{ name => $_.$n, + formula => $self->formula($_.$n), + value => $self->value($_.$n)}); } - return @cols; + return ($rowlabel,@cols); } -sub templaterow { - my @cols=(); - $cols[0]='<b><font size=+1>Template</font></b>'; - foreach ('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') { - my $fm=$f{'template_'.$_}; - $fm=~s/[\'\"]/\&\#34;/g; - push(@cols,"'template_$_','$fm'".'___eq___'.$fm); - } - return @cols; +######################################################## +#### Spreadsheet calculation methods ##### +######################################################## +# +# calcsheet: makes all the calls to compute the spreadsheet. +# +sub calcsheet { + my $self = shift; + $self->sync_safe_space(); + $self->clear_errorlog(); + $self->sett(); + my $result = $self->{'safe'}->reval('&calc();'); + %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')}; +# $self->logthis($self->get_errorlog()); + return $result; } +## +## sync_safe_space: Called by calcsheet to make sure all the data we +# need to calculate is placed into the safe space +## +sub sync_safe_space { + my $self = shift; + # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'. + %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}}; + # 'constants' leads a peaceful hidden life of 'c'. + %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}}; + # 'othersheets' hides as 'os', a disguise few can penetrate. + @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}}; +} -# ------------------------------------------- End of "Inside of the safe space" -ENDDEFS - $safeeval->reval($code); - return $safeeval; +## +## Retrieve the error log from the safe space (used for debugging) +## +sub get_errorlog { + my $self = shift; + $self->{'errorlog'} = ${$self->{'safe'}->varglob('errorlog')}; + return $self->{'errorlog'}; } +## +## Clear the error log inside the safe space +## +sub clear_errorlog { + my $self = shift; + ${$self->{'safe'}->varglob('errorlog')} = ''; + $self->{'errorlog'} = ''; +} -# ------------------------------------------------ Add or change formula values -sub setformulas { - my ($sheet)=shift; - %{$sheet->{'safe'}->varglob('f')}=%{$sheet->{'f'}}; + +######################################################## +#### Spreadsheet content retrieval/setting methods ##### +######################################################## +## +## constants: either set or get the constants +## +## +sub constants { + my $self=shift; + my ($constants) = @_; + if (defined($constants)) { + if (! ref($constants)) { + my %tmp = @_; + $constants = \%tmp; + } + $self->{'constants'} = $constants; + return; + } else { + return %{$self->{'constants'}}; + } +} + +## +## formulas: either set or get the formulas +## +sub formulas { + my $self=shift; + my ($formulas) = @_; + if (defined($formulas)) { + if (! ref($formulas)) { + my %tmp = @_; + $formulas = \%tmp; + } + $self->{'formulas'} = $formulas; + $self->{'rows'} = []; + $self->{'template_cells'} = []; + return; + } else { + return %{$self->{'formulas'}}; + } } -# ------------------------------------------------ Add or change formula values -sub setconstants { - my ($sheet)=shift; - return %{$sheet->{'safe'}->varglob('c')}=%{$sheet->{'constants'}}; +## +## formulas_keys: Return the keys to the formulas hash. +## +sub formulas_keys { + my $self = shift; + my @keys = keys(%{$self->{'formulas'}}); + return keys(%{$self->{'formulas'}}); } -# --------------------------------------------- Set names of other spreadsheets -sub setothersheets { - my $sheet = shift; - my @othersheets = @_; - $sheet->{'othersheets'} = \@othersheets; - @{$sheet->{'safe'}->varglob('os')}=@othersheets; +## +## formula: Return the formula for a given cell in the spreadsheet +## returns '' if the cell does not have a formula or does not exist +## +sub formula { + my $self = shift; + my $cell = shift; + if (defined($cell) && exists($self->{'formulas'}->{$cell})) { + return $self->{'formulas'}->{$cell}; + } + return ''; +} + +## +## logthis: write the input to lonnet.log +## +sub logthis { + my $self = shift; + my $message = shift; + &Apache::lonnet::logthis($self->{'type'}.':'. + $self->{'uname'}.':'.$self->{'udom'}.':'. + $message); return; } -# ------------------------------------------------ Add or change formula values -sub setrowlabels { - my $sheet=shift; - %{$sheet->{'safe'}->varglob('rowlabel')}=%{$sheet->{'rowlabel'}}; +## +## dump_formulas_to_log: makes lonnet.log huge... +## +sub dump_formulas_to_log { + my $self =shift; + $self->logthis("Spreadsheet formulas"); + $self->logthis("--------------------------------------------------------"); + while (my ($cell, $formula) = each(%{$self->{'formulas'}})) { + $self->logthis(' '.$cell.' = '.$formula); + } + $self->logthis("--------------------------------------------------------");} + +## +## value: returns the computed value of a particular cell +## +sub value { + my $self = shift; + my $cell = shift; + if (defined($cell) && exists($self->{'values'}->{$cell})) { + return $self->{'values'}->{$cell}; + } + return ''; } -# ------------------------------------------------------- Calculate spreadsheet -sub calcsheet { - my $sheet=shift; - my $result = $sheet->{'safe'}->reval('&calc();'); - %{$sheet->{'values'}} = %{$sheet->{'safe'}->varglob('sheet_values')}; - return $result; +## +## dump_values_to_log: makes lonnet.log huge... +## +sub dump_values_to_log { + my $self =shift; + $self->logthis("Spreadsheet Values"); + $self->logthis("--------------------------------------------------------"); + while (my ($cell, $value) = each(%{$self->{'values'}})) { + $self->logthis(' '.$cell.' = '.$value); + } + $self->logthis("--------------------------------------------------------");} + +################################ +## Helper functions ## +################################ +## +## rebuild_stats: rebuilds the rows and template_cells arrays +## +sub rebuild_stats { + my $self = shift; + $self->{'rows'}=[]; + $self->{'template_cells'}=[]; + foreach my $cell($self->formulas_keys()) { + push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0); + push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/); + } + return; } -# ---------------------------------------------------------------- Get formulas -sub getformulas { - my $sheet = shift; - return %{$sheet->{'safe'}->varglob('f')}; +## +## template_cells returns a list of the cells defined in the template row +## +sub template_cells { + my $self = shift; + $self->rebuild_stats() if (!@{$self->{'template_cells'}}); + return @{$self->{'template_cells'}}; } -# ----------------------------------------------------- Get value of $f{'A'.$n} -sub getfa { - my $sheet = shift; - my ($n)=@_; - return $sheet->{'safe'}->reval('$f{"A'.$n.'"}'); +## +## rows returns a list of the names of cells defined in the A column +## +sub rows { + my $self = shift; + $self->rebuild_stats() if (!@{$self->{'rows'}}); + return @{$self->{'rows'}}; } -# ------------------------------------------------------------- Export of A-row +## +## Sigh.... +## +sub setothersheets { + my $self = shift; + my @othersheets = @_; + $self->{'othersheets'} = \@othersheets; +} + +## +## rowlabels: get or set the rowlabels hash from the spreadsheet. +## +sub rowlabels { + my $self = shift; + my ($rowlabel) = @_; + if (defined($rowlabel)) { + if (! ref($rowlabel)) { + my %tmp = @_; + $rowlabel = \%tmp; + } + $self->{'rowlabel'}=$rowlabel; + return; + } else { + return %{$self->{'rowlabel'}} if (defined($self->{'rowlabel'})); + } +} + +## +## gettitle: returns a title for the spreadsheet. +## +sub gettitle { + my $self = shift; + if ($self->{'type'} eq 'classcalc') { + return $self->{'coursedesc'}; + } elsif ($self->{'type'} eq 'studentcalc') { + return 'Grades for '.$self->{'uname'}.'@'.$self->{'udom'}; + } elsif ($self->{'type'} eq 'assesscalc') { + if (($self->{'usymb'} eq '_feedback') || + ($self->{'usymb'} eq '_evaluation') || + ($self->{'usymb'} eq '_discussion') || + ($self->{'usymb'} eq '_tutoring')) { + my $title = $self->{'usymb'}; + $title =~ s/^_//; + $title = ucfirst($title); + return $title; + } + return if (! defined($self->{'mapid'}) || + $self->{'mapid'} !~ /^\d+$/); + my $mapid = $self->{'mapid'}; + return if (! defined($self->{'resid'}) || + $self->{'resid'} !~ /^\d+$/); + my $resid = $self->{'resid'}; + my %course_db; + tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db', + &GDBM_READER(),0640); + return if (! tied(%course_db)); + my $key = 'title_'.$mapid.'.'.$resid; + my $title = ''; + if (exists($course_db{$key})) { + $title = $course_db{$key}; + } else { + $title = $self->{'usymb'}; + } + untie (%course_db); + return $title; + } +} + +# +# Export of A-row +# sub exportdata { - my $sheet=shift; + my $self=shift; my @exportarray=(); foreach ('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') { - push(@exportarray,$sheet->{'values'}->{$_.'0'}); + push(@exportarray,$self->value($_.'0')); } return @exportarray; } -# ========================================================== End of Spreadsheet -# ============================================================================= +## +## update_student_sheet: experimental function +## +sub update_student_sheet{ + my $self = shift; + my ($r,$c) = @_; + # Load in the studentcalc sheet + $self->readsheet('default_studentcalc'); + # Determine the structure (contained assessments, etc) of the sheet + $self->updatesheet(); + # Load in the cached sheets for this student + $self->cachedssheets(); + # Load in the (possibly cached) data from the assessment sheets + $self->loadstudent($r,$c); + # Compute the sheet + $self->calcsheet(); +} # -# Procedures for screen output +# sort_indicies: returns an ordered list of the rows of the spreadsheet # -# --------------------------------------------- Produce output row n from sheet +sub sort_indicies { + my $self = shift; + my @sortidx=(); + # + if ($self->{'type'} eq 'classcalc') { + my @sortby=(undef); + # Skip row 0 + for (my $row=1;$row<=$self->{'maxrow'};$row++) { + my (undef,$sname,$sdom,$fullname,$section,$id) = + split(':',$self->{'rowlabel'}->{$self->formula('A'.$row)}); + push (@sortby, lc($fullname)); + push (@sortidx, $row); + } + @sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx; + } elsif ($self->{'type'} eq 'studentcalc') { + my @sortby1=(undef); + my @sortby2=(undef); + # Skip row 0 + for (my $row=1;$row<=$self->{'maxrow'};$row++) { + my ($key,undef) = split(/__&&&\__/,$self->formula('A'.$row)); + my $rowlabel = $self->{'rowlabel'}->{$key}; + my (undef,$symb,$mapid,$resid,$title,$ufn) = + split(':',$rowlabel); + $ufn = &Apache::lonnet::unescape($ufn); + $symb = &Apache::lonnet::unescape($symb); + $title = &Apache::lonnet::unescape($title); + my ($sequence) = ($symb =~ /\/([^\/]*\.sequence)/); + if ($sequence eq '') { + $sequence = $symb; + } + push (@sortby1, $sequence); + push (@sortby2, $title); + push (@sortidx, $row); + } + @sortidx = sort { $sortby1[$a] cmp $sortby1[$b] || + $sortby2[$a] cmp $sortby2[$b] } @sortidx; + } else { + my @sortby=(undef); + # Skip row 0 + $self->sync_safe_space(); + for (my $row=1;$row<=$self->{'maxrow'};$row++) { + push (@sortby, $self->{'safe'}->reval('$f{"A'.$row.'"}')); + push (@sortidx, $row); + } + @sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx; + } + return @sortidx; +} + +############################################################# +### ### +### Spreadsheet Output Routines ### +### ### +############################################################# + +############################################ +## HTML output routines ## +############################################ +sub html_editable_cell { + my ($cell,$bgcolor) = @_; + my $result; + my ($name,$formula,$value); + if (defined($cell)) { + $name = $cell->{'name'}; + $formula = $cell->{'formula'}; + $value = $cell->{'value'}; + } + $name = '' if (! defined($name)); + $formula = '' if (! defined($formula)); + if (! defined($value)) { + $value = '<font color="'.$bgcolor.'">#</font>'; + if ($formula ne '') { + $value = '<i>undefined value</i>'; + } + } elsif ($value =~ /^\s*$/ ) { + $value = '<font color="'.$bgcolor.'">#</font>'; + } else { + $value = &HTML::Entities::encode($value) if ($value !~/ /); + } + # Make the formula safe for outputting + $formula =~ s/\'/\"/g; + # The formula will be parsed by the browser *twice* before being + # displayed to the user for editing. + $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula)); + # Escape newlines so they make it into the edit window + $formula =~ s/\n/\\n/gs; + # Glue everything together + $result .= "<a href=\"javascript:celledit(\'". + $name."','".$formula."');\">".$value."</a>"; + return $result; +} -sub rown { - my ($sheet,$n)=@_; - my $defaultbg; - my $rowdata=''; - my $dataflag=0; - unless ($n eq '-') { - $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF'; - } else { - $defaultbg='#E0FF'; - } - unless ($ENV{'form.showcsv'}) { - $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>"; - } else { - $rowdata.="\n".'"'.$n.'"'; +sub html_uneditable_cell { + my ($cell,$bgcolor) = @_; + my $value = (defined($cell) ? $cell->{'value'} : ''); + $value = &HTML::Entities::encode($value) if ($value !~/ /); + return ' '.$value.' '; +} + +sub outsheet_html { + my $self = shift; + my ($r) = @_; + my ($num_uneditable,$realm,$row_type); + my $requester_is_student = ($ENV{'request.role'} =~ /^st\./); + if ($self->{'type'} eq 'assesscalc') { + $num_uneditable = 1; + $realm = 'Assessment'; + $row_type = 'Item'; + } elsif ($self->{'type'} eq 'studentcalc') { + $num_uneditable = 26; + $realm = 'User'; + $row_type = 'Assessment'; + } elsif ($self->{'type'} eq 'classcalc') { + $num_uneditable = 26; + $realm = 'Course'; + $row_type = 'Student'; + } else { + return; # error + } + #################################### + # Print out header table + #################################### + my $num_left = 52-$num_uneditable; + my $tabledata =<<"END"; +<table border="2"> +<tr> + <th colspan="2" rowspan="2"><font size="+2">$realm</font></th> + <td bgcolor="#FFDDDD" colspan="$num_uneditable"> + <b><font size="+1">Import</font></b></td> + <td colspan="$num_left"> + <b><font size="+1">Calculations</font></b></td> +</tr><tr> +END + my $label_num = 0; + foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ + if ($label_num<$num_uneditable) { + $tabledata.='<td bgcolor="#FFDDDD">'; + } else { + $tabledata.='<td>'; + } + $tabledata.="<b><font size=+1>$_</font></b></td>"; + $label_num++; } - my $showf=0; - my $proc; - my $maxred=1; - my $sheettype=$sheet->{'sheettype'}; - if ($sheettype eq 'studentcalc') { - $proc='&outrowassess'; - $maxred=26; - } else { - $proc='&outrow'; + $tabledata.="</tr>\n"; + $r->print($tabledata); + #################################### + # Print out template row + #################################### + my ($num_cols_output,$row_html,$rowlabel,@rowdata); + + if (! $requester_is_student) { + ($rowlabel,@rowdata) = $self->get_row('-'); + $row_html = '<tr><td>'.$self->format_html_rowlabel($rowlabel).'</td>'; + $num_cols_output = 0; + foreach my $cell (@rowdata) { + if ($requester_is_student || + $num_cols_output++ < $num_uneditable) { + $row_html .= '<td bgcolor="#FFDDDD">'; + $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); + } else { + $row_html .= '<td bgcolor="#EOFFDD">'; + $row_html .= &html_editable_cell($cell,'#E0FFDD'); + } + $row_html .= '</td>'; + } + $row_html.= "</tr>\n"; + $r->print($row_html); } - if ($sheettype eq 'assesscalc') { - $maxred=1; - } else { - $maxred=26; + #################################### + # Print out summary/export row + #################################### + ($rowlabel,@rowdata) = $self->get_row('0'); + $row_html = '<tr><td>'.$self->format_html_rowlabel($rowlabel).'</td>'; + $num_cols_output = 0; + foreach my $cell (@rowdata) { + if ($num_cols_output++ < 26 && ! $requester_is_student) { + $row_html .= '<td bgcolor="#CCCCFF">'; + $row_html .= &html_editable_cell($cell,'#CCCCFF'); + } else { + $row_html .= '<td bgcolor="#DDCCFF">'; + $row_html .= &html_uneditable_cell($cell,'#CCCCFF'); + } + $row_html .= '</td>'; } - if (&getfa($sheet,$n)=~/^[\~\-]/) { $maxred=1; } - if ($n eq '-') { - $proc='&templaterow'; - $n=-1; - $dataflag=1; - } - foreach ($sheet->{'safe'}->reval($proc.'('.$n.','.$ENV{'form.showcsv'}.')')) { - my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD'); - my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_); - if ((($vl ne '') || ($vl eq '0')) && - (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; } - if ($showf==0) { $vl=$_; } - unless ($ENV{'form.showcsv'}) { - if ($showf<=$maxred) { $bgcolor='#FFDDDD'; } - if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; } - if (($showf>$maxred) || ((!$n) && ($showf>0))) { - if ($vl eq '') { - $vl='<font size=+2 color='.$bgcolor.'>#</font>'; + $row_html.= "</tr>\n"; + $r->print($row_html); + $r->print('</table>'); + #################################### + # Prepare to output rows + #################################### + my @Rows = $self->sort_indicies(); + # + # Loop through the rows and output them one at a time + my $rows_output=0; + foreach my $rownum (@Rows) { + my ($rowlabel,@rowdata) = $self->get_row($rownum); + next if ($rowlabel =~ /^\s*$/); + next if (($self->{'type'} eq 'assesscalc') && + (! $ENV{'form.showall'}) && + ($rowdata[0]->{'value'} =~ /^\s*$/)); + if (! $ENV{'form.showall'} && + $self->{'type'} =~ /^(studentcalc|classcalc)$/) { + my $row_is_empty = 1; + foreach my $cell (@rowdata) { + if ($cell->{'value'} !~ /^\s*$/) { + $row_is_empty = 0; + last; } - $rowdata.='<td bgcolor='.$bgcolor.'>'; - if ($ENV{'request.role'} =~ /^st\./) { - $rowdata.=$vl; - } else { - $rowdata.='<a href="javascript:celledit('.$fm.');">'. - $vl.'</a>'; + } + next if ($row_is_empty); + } + # + my $defaultbg='#E0FF'; + # + my $row_html ="\n".'<tr><td><b><font size=+1>'.$rownum. + '</font></b></td>'; + # + if ($self->{'type'} eq 'classcalc') { + $row_html.='<td>'.$self->format_html_rowlabel($rowlabel).'</td>'; + # Output links for each student? + # Nope, that is already done for us in format_html_rowlabel + # (for now) + } elsif ($self->{'type'} eq 'studentcalc') { + my $ufn = (split(/:/,$rowlabel))[5]; + $row_html.='<td>'.$self->format_html_rowlabel($rowlabel); + $row_html.= '<br>'. + '<select name="sel_'.$rownum.'" '. + 'onChange="changesheet('.$rownum.')">'. + '<option name="default">Default</option>'; + foreach (@{$self->{'othersheets'}}) { + $row_html.='<option name="'.$_.'"'; + if ($ufn eq $_) { + $row_html.=' selected'; } - $rowdata.='</td>'; - } else { - $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>'; + $row_html.='>'.$_.'</option>'; } - } else { - $rowdata.=',"'.$vl.'"'; + $row_html.='</select></td>'; + } elsif ($self->{'type'} eq 'assesscalc') { + $row_html.='<td>'.$self->format_html_rowlabel($rowlabel).'</td>'; } - $showf++; - } # End of foreach($safeval...) - if ($ENV{'form.showall'} || ($dataflag)) { - return $rowdata.($ENV{'form.showcsv'}?'':'</tr>'); - } else { - return ''; - } -} - -# ------------------------------------------------------------- Print out sheet - -sub outsheet { - my ($r,$sheet)=@_; - my $maxred = 26; # The maximum number of cells to show as - # red (uneditable) - # To make student sheets uneditable could we - # set $maxred = 52? - # - my $realm='Course'; # 'assessment', 'user', or 'course' sheet - if ($sheet->{'sheettype'} eq 'assesscalc') { - $maxred=1; - $realm='Assessment'; - } elsif ($sheet->{'sheettype'} eq 'studentcalc') { - $maxred=26; - $realm='User'; - } - # - # Column label - my $tabledata; - if ($ENV{'form.showcsv'}) { - $tabledata='<pre>'; - } else { - $tabledata='<table border=2><tr><th colspan=2 rowspan=2>'. - '<font size=+2>'.$realm.'</font></th>'. - '<td bgcolor=#FFDDDD colspan='.$maxred. - '><b><font size=+1>Import</font></b></td>'. - '<td colspan='.(52-$maxred). - '><b><font size=+1>Calculations</font></b></td></tr><tr>'; - my $showf=0; - foreach ('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') { - $showf++; - if ($showf<=$maxred) { - $tabledata.='<td bgcolor="#FFDDDD">'; + # + my $shown_cells = 0; + foreach my $cell (@rowdata) { + my $value = $cell->{'value'}; + my $formula = $cell->{'formula'}; + my $cellname = $cell->{'name'}; + # + my $bgcolor; + if ($shown_cells && ($shown_cells/5 == int($shown_cells/5))) { + $bgcolor = $defaultbg.'99'; + } else { + $bgcolor = $defaultbg.'DD'; + } + $bgcolor='#FFDDDD' if ($shown_cells < $num_uneditable); + # + $row_html.='<td bgcolor='.$bgcolor.'>'; + if ($requester_is_student || $shown_cells < $num_uneditable) { + $row_html .= &html_uneditable_cell($cell,$bgcolor); } else { - $tabledata.='<td>'; + $row_html .= &html_editable_cell($cell,$bgcolor); } - $tabledata.="<b><font size=+1>$_</font></b></td>"; + $row_html.='</td>'; + $shown_cells++; + } + if ($row_html) { + if ($rows_output % 25 == 0) { + $r->print("</table>\n<br>\n"); + $r->rflush(); + $r->print('<table border=2>'. + '<tr><td> <td>'.$row_type.'</td>'. + '<td>'. + join('</td><td>', + (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. + 'abcdefghijklmnopqrstuvwxyz'))). + "</td></tr>\n"); + } + $rows_output++; + $r->print($row_html); } - $tabledata.='</tr>'.&rown($sheet,'-'). - &rown($sheet,0); } - $r->print($tabledata); # + $r->print('</table>'); + # + # Debugging code (be sure to uncomment errorlog code in safe space): + # + # $r->print("\n<pre>"); + # $r->print(&geterrorlog($self)); + # $r->print("\n</pre>"); + return 1; +} + +############################################ +## csv output routines ## +############################################ +sub outsheet_csv { + my $self = shift; + my ($r) = @_; + my $csvdata = ''; + my @Values; + #################################### # Prepare to output rows - my $row; + #################################### + my @Rows = $self->sort_indicies(); # - my @sortby=(); - my @sortidx=(); - for ($row=1;$row<=$sheet->{'maxrow'};$row++) { - push (@sortby, $sheet->{'safe'}->reval('$f{"A'.$row.'"}')); - push (@sortidx, $row-1); - } - @sortidx=sort { lc($sortby[$a]) cmp lc($sortby[$b]); } @sortidx; - # - # Determine the type of child spreadsheets - my $what='Student'; - if ($sheet->{'sheettype'} eq 'assesscalc') { - $what='Item'; - } elsif ($sheet->{'sheettype'} eq 'studentcalc') { - $what='Assessment'; + # Loop through the rows and output them one at a time + my $rows_output=0; + foreach my $rownum (@Rows) { + my ($rowlabel,@rowdata) = $self->get_row($rownum); + next if ($rowlabel =~ /^\s*$/); + push (@Values,$self->format_csv_rowlabel($rowlabel)); + foreach my $cell (@rowdata) { + push (@Values,'"'.$cell->{'value'}.'"'); + } + $csvdata.= join(',',@Values)."\n"; + @Values = (); + } + # + # Write the CSV data to a file and serve up a link + # + my $filename = '/prtspool/'. + $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.csv'; + my $file; + unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) { + $r->log_error("Couldn't open $filename for output $!"); + $r->print("Problems occured in writing the csv file. ". + "This error has been logged. ". + "Please alert your LON-CAPA administrator."); + $r->print("<pre>\n".$csvdata."</pre>\n"); + return 0; + } + print $file $csvdata; + close($file); + $r->print('<br /><br />'. + '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n"); + # + return 1; +} + +############################################ +## Excel output routines ## +############################################ +sub outsheet_recursive_excel { + my $self = shift; + my ($r) = @_; + my $c = $r->connection; + return undef if ($self->{'type'} ne 'classcalc'); + my ($workbook,$filename) = $self->create_excel_spreadsheet($r); + return undef if (! defined($workbook)); + # + # Create main worksheet + my $main_worksheet = $workbook->addworksheet('main'); + # + # Figure out who the students are + my %f=$self->formulas(); + my $count = 0; + $r->print(<<END); +<p> +Compiling Excel Workbook with a worksheet for each student. +</p><p> +This operation may take longer than a complete recalculation of the +spreadsheet. +</p><p> +To abort this operation, hit the stop button on your browser. +</p><p> +A link to the spreadsheet will be available at the end of this process. +</p> +<p> +END + $r->rflush(); + my $starttime = time; + foreach my $rownum ($self->sort_indicies()) { + $count++; + my ($sname,$sdom) = split(':',$f{'A'.$rownum}); + my $student_excel_worksheet=$workbook->addworksheet($sname.'@'.$sdom); + # Create a new spreadsheet + my $studentsheet = &Apache::lonspreadsheet::Spreadsheet->new + ($sname,$sdom,'studentcalc',undef); + # Read in the spreadsheet definition + $studentsheet->update_student_sheet($r,$c); + # Stuff the sheet into excel + $studentsheet->export_sheet_as_excel($student_excel_worksheet); + my $totaltime = int((time - $starttime) / $count * $self->{'maxrow'}); + my $timeleft = int((time - $starttime) / $count * ($self->{'maxrow'} - $count)); + if ($count % 5 == 0) { + $r->print($count.' students completed.'. + ' Time remaining: '.$timeleft.' sec. '. + ' Estimated total time: '.$totaltime." sec <br />\n"); + $r->rflush(); + } + if(defined($c) && ($c->aborted())) { + last; + } + } + # + if(! $c->aborted() ) { + $r->print('All students spreadsheets completed!<br />'); + $r->rflush(); + # + # &export_sheet_as_excel fills $worksheet with the data from $sheet + $self->export_sheet_as_excel($main_worksheet); + # + $workbook->close(); + # Okay, the spreadsheet is taken care of, so give the user a link. + $r->print('<br /><br />'. + '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); + } else { + $workbook->close(); # Not sure how necessary this is. + #unlink('/home/httpd'.$filename); # No need to keep this around? + } + return 1; +} + +sub outsheet_excel { + my $self = shift; + my ($r) = @_; + my ($workbook,$filename) = $self->create_excel_spreadsheet($r); + return undef if (! defined($workbook)); + my $sheetname; + if ($self->{'type'} eq 'classcalc') { + $sheetname = 'Main'; + } elsif ($self->{'type'} eq 'studentcalc') { + $sheetname = $self->{'uname'}.'@'.$self->{'udom'}; + } elsif ($self->{'type'} eq 'assesscalc') { + $sheetname = $self->{'uname'}.'@'.$self->{'udom'}.' assessment'; + } + my $worksheet = $workbook->addworksheet($sheetname); + # + # &export_sheet_as_excel fills $worksheet with the data from $sheet + $self->export_sheet_as_excel($worksheet); + # + $workbook->close(); + # Okay, the spreadsheet is taken care of, so give the user a link. + $r->print('<br /><br />'. + '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); + return 1; +} + +sub create_excel_spreadsheet { + my $self = shift; + my ($r) = @_; + my $filename = '/prtspool/'. + $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.xls'; + my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); + if (! defined($workbook)) { + $r->log_error("Error creating excel spreadsheet $filename: $!"); + $r->print("Problems creating new Excel file. ". + "This error has been logged. ". + "Please alert your LON-CAPA administrator"); + return undef; + } + # + # The excel spreadsheet stores temporary data in files, then put them + # together. If needed we should be able to disable this (memory only). + # The temporary directory must be specified before calling 'addworksheet'. + # File::Temp is used to determine the temporary directory. + $workbook->set_tempdir('/home/httpd/perl/tmp'); + # + # Determine the name to give the worksheet + return ($workbook,$filename); +} + +sub export_sheet_as_excel { + my $self = shift; + my $worksheet = shift; + # + my $rows_output = 0; + my $cols_output = 0; + #################################### + # Write an identifying row # + #################################### + my @Headerinfo = ($self->{'coursedesc'}); + my $title = $self->gettitle(); + $cols_output = 0; + if (defined($title)) { + $worksheet->write($rows_output++,$cols_output++,$title); + } + #################################### + # Write the summary/export row # + #################################### + my ($rowlabel,@rowdata) = &get_row($self,'0'); + my $label = &format_excel_rowlabel($self,$rowlabel); + $cols_output = 0; + $worksheet->write($rows_output,$cols_output++,$label); + foreach my $cell (@rowdata) { + $worksheet->write($rows_output,$cols_output++,$cell->{'value'}); } + $rows_output+= 2; # Skip a row, just for fun + #################################### + # Prepare to output rows + #################################### + my @Rows = &sort_indicies($self); # # Loop through the rows and output them one at a time - my $n=0; - for ($row=0;$row<$sheet->{'maxrow'};$row++) { - my $thisrow=&rown($sheet,$sortidx[$row]+1); - if ($thisrow) { - if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) { - $r->print("</table>\n<br>\n"); - $r->rflush(); - $r->print('<table border=2><tr><td> <td>'.$what.'</td>'); - $r->print('<td>'. - join('</td><td>', - (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. - 'abcdefghijklmnopqrstuvwxyz'))). - "</td></tr>\n"); + foreach my $rownum (@Rows) { + my ($rowlabel,@rowdata) = &get_row($self,$rownum); + next if ($rowlabel =~ /^[\s]*$/); + $cols_output = 0; + my $label = &format_excel_rowlabel($self,$rowlabel); + if ( ! $ENV{'form.showall'} && + $self->{'type'} =~ /^(studentcalc|classcalc)$/) { + my $row_is_empty = 1; + foreach my $cell (@rowdata) { + if ($cell->{'value'} !~ /^\s*$/) { + $row_is_empty = 0; + last; + } } - $n++; - $r->print($thisrow); + next if ($row_is_empty); + } + $worksheet->write($rows_output,$cols_output++,$rownum); + $worksheet->write($rows_output,$cols_output++,$label); + if (ref($label)) { + $cols_output = (scalar(@$label)); } + foreach my $cell (@rowdata) { + $worksheet->write($rows_output,$cols_output++,$cell->{'value'}); + } + $rows_output++; + } + return; +} + +############################################ +## XML output routines ## +############################################ +sub outsheet_xml { + my $self = shift; + my ($r) = @_; + ## Someday XML + ## Will be rendered for the user + ## But not on this day +} + +## +## Outsheet - calls other outsheet_* functions +## +sub outsheet { + my $self = shift; + my ($r)=@_; + if (! exists($ENV{'form.output'})) { + $ENV{'form.output'} = 'HTML'; + } + if (lc($ENV{'form.output'}) eq 'csv') { + $self->outsheet_csv($r); + } elsif (lc($ENV{'form.output'}) eq 'excel') { + $self->outsheet_excel($r); + } elsif (lc($ENV{'form.output'}) eq 'recursive excel') { + $self->outsheet_recursive_excel($r); +# } elsif (lc($ENV{'form.output'}) eq 'xml' ) { +# $self->outsheet_xml($r); + } else { + $self->outsheet_html($r); } - $r->print($ENV{'form.showcsv'}?'</pre>':'</table>'); } # -# ----------------------------------------------- Read list of available sheets -# +# othersheets: Returns the list of other spreadsheets available +# sub othersheets { - my ($sheet,$stype)=@_; - $stype = $sheet->{'sheettype'} if (! defined($stype)); - # - my $cnum = $sheet->{'cnum'}; - my $cdom = $sheet->{'cdom'}; - my $chome = $sheet->{'chome'}; + my $self = shift; + my ($stype)=@_; + $stype = $self->{'type'} if (! defined($stype)); + # + my $cnum = $self->{'cnum'}; + my $cdom = $self->{'cdom'}; + my $chome = $self->{'chome'}; # my @alternatives=(); my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); @@ -1278,9 +2608,8 @@ sub othersheets { return @alternatives; } - # -# -------------------------------------- Parse a spreadsheet +# Parse a spreadsheet # sub parse_sheet { # $sheetxml is a scalar reference or a scalar @@ -1307,16 +2636,14 @@ sub parse_sheet { return \%f; } -# -# -------------------------------------- Read spreadsheet formulas for a course -# sub readsheet { - my ($sheet,$fn)=@_; + my $self = shift; + my ($fn)=@_; # - my $stype = $sheet->{'sheettype'}; - my $cnum = $sheet->{'cnum'}; - my $cdom = $sheet->{'cdom'}; - my $chome = $sheet->{'chome'}; + my $stype = $self->{'type'}; + my $cnum = $self->{'cnum'}; + my $cdom = $self->{'cdom'}; + my $chome = $self->{'chome'}; # if (! defined($fn)) { # There is no filename. Look for defaults in course and global, cache @@ -1337,13 +2664,13 @@ sub readsheet { } } # $fn now has a value - $sheet->{'filename'} = $fn; + $self->{'filename'} = $fn; # see if sheet is cached - my $fstring=''; - if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { - my %tmp = split(/___;___/,$fstring); - $sheet->{'f'} = \%tmp; - &setformulas($sheet); + if (exists($spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn})) { + + my %tmp = split(/___;___/, + $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}); + $self->formulas(\%tmp); } else { # Not cached, need to read my %f=(); @@ -1355,7 +2682,8 @@ sub readsheet { if ($fh=Apache::File->new($includedir.'/'.$dfn)) { $sheetxml=join('',<$fh>); } else { - $sheetxml='<field row="0" col="A">"Error"</field>'; + # $sheetxml='<field row="0" col="A">"Error"</field>'; + $sheetxml='<field row="0" col="A"></field>'; } %f=%{&parse_sheet(\$sheetxml)}; } elsif($fn=~/\/*\.spreadsheet$/) { @@ -1367,97 +2695,70 @@ sub readsheet { } %f=%{&parse_sheet(\$sheetxml)}; } else { - my $sheet=''; my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); my ($tmp) = keys(%tmphash); - unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { + if ($tmp !~ /^(con_lost|error|no_such_host)/i) { foreach (keys(%tmphash)) { $f{$_}=$tmphash{$_}; } + } else { + # Unable to grab the specified spreadsheet, + # so we get the default ones instead. + $fn = 'default_'.$stype; + $self->{'filename'} = $fn; + my $dfn = $fn; + $dfn =~ s/\_/\./g; + my $sheetxml; + if (my $fh=Apache::File->new($includedir.'/'.$dfn)) { + $sheetxml = join('',<$fh>); + } else { + $sheetxml='<field row="0" col="A">'. + '"Unable to load spreadsheet"</field>'; + } + %f=%{&parse_sheet(\$sheetxml)}; } } # Cache and set $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); - $sheet->{'f'}=\%f; - &setformulas($sheet); + $self->formulas(\%f); } } -# -------------------------------------------------------- Make new spreadsheet -sub makenewsheet { - my ($uname,$udom,$stype,$usymb)=@_; - my $sheet={}; - $sheet->{'uname'} = $uname; - $sheet->{'udom'} = $udom; - $sheet->{'sheettype'} = $stype; - $sheet->{'usymb'} = $usymb; - $sheet->{'cid'} = $ENV{'request.course.id'}; - $sheet->{'csec'} = $Section{$uname.':'.$udom}; - $sheet->{'coursefilename'} = $ENV{'request.course.fn'}; - $sheet->{'cnum'} = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - $sheet->{'cdom'} = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - $sheet->{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'}; - $sheet->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom); - # - # - $sheet->{'f'} = {}; - $sheet->{'constants'} = {}; - $sheet->{'othersheets'} = []; - $sheet->{'rowlabel'} = {}; - # - # - $sheet->{'safe'}=&initsheet($sheet->{'sheettype'}); - # - # Place all the %$sheet items into the safe space except the safe space - # itself - my $initstring = ''; - foreach (qw/uname udom sheettype usymb cid csec coursefilename - cnum cdom chome uhome/) { - $initstring.= qq{\$$_="$sheet->{$_}";}; - } - $sheet->{'safe'}->reval($initstring); - return $sheet; -} - # ------------------------------------------------------------ Save spreadsheet sub writesheet { - my ($sheet,$makedef)=@_; - my $cid=$sheet->{'cid'}; + my $self = shift; + my ($makedef)=@_; + my $cid=$self->{'cid'}; if (&Apache::lonnet::allowed('opa',$cid)) { - my %f=&getformulas($sheet); - my $stype= $sheet->{'sheettype'}; - my $cnum = $sheet->{'cnum'}; - my $cdom = $sheet->{'cdom'}; - my $chome= $sheet->{'chome'}; - my $fn = $sheet->{'filename'}; + my %f=$self->formulas(); + my $stype= $self->{'type'}; + my $cnum = $self->{'cnum'}; + my $cdom = $self->{'cdom'}; + my $chome= $self->{'chome'}; + my $fn = $self->{'filename'}; # Cache new sheet $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); # Write sheet - my $sheetdata=''; foreach (keys(%f)) { - unless ($f{$_} eq 'import') { - $sheetdata.=&Apache::lonnet::escape($_).'='. - &Apache::lonnet::escape($f{$_}).'&'; - } + delete($f{$_}) if ($f{$_} eq 'import'); } - $sheetdata=~s/\&$//; - my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. - $sheetdata,$chome); + my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum); if ($reply eq 'ok') { - $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'. - $stype.'_spreadsheets:'. - &Apache::lonnet::escape($fn). - '='.$ENV{'user.name'}.'@'. - $ENV{'user.domain'}, - $chome); + $reply = &Apache::lonnet::put($stype.'_spreadsheets', + {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, + $cdom,$cnum); if ($reply eq 'ok') { if ($makedef) { - return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum. - ':environment:'. - 'spreadsheet_default_'. - $stype.'='. - &Apache::lonnet::escape($fn), - $chome); + $reply = &Apache::lonnet::put('environment', + {'spreadsheet_default_'.$stype => $fn }, + $cdom,$cnum); + if ($reply eq 'ok' && + ($self->{'type'} eq 'studentcalc' || + $self->{'type'} eq 'assesscalc')) { + # Expire the spreadsheets of the other students. + &Apache::lonnet::expirespread('','','studentcalc',''); + } + return $reply; } return $reply; } @@ -1472,148 +2773,149 @@ sub writesheet { # "Modified workcopy" - interactive only # sub tmpwrite { - my ($sheet) = @_; + my $self = shift; my $fn=$ENV{'user.name'}.'_'. - $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'. - $sheet->{'filename'}; + $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. + $self->{'filename'}; $fn=~s/\W/\_/g; $fn=$tmpdir.$fn.'.tmp'; my $fh; if ($fh=Apache::File->new('>'.$fn)) { - print $fh join("\n",&getformulas($sheet)); + my %f = $self->formulas(); + while( my ($cell,$formula) = each(%f)) { + print $fh &Apache::lonnet::escape($cell)."=".&Apache::lonnet::escape($formula)."\n"; + } } } + # ---------------------------------------------------------- Read the temp copy sub tmpread { - my ($sheet,$nfield,$nform)=@_; + my $self = shift; + my ($nfield,$nform)=@_; my $fn=$ENV{'user.name'}.'_'. - $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'. - $sheet->{'filename'}; + $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. + $self->{'filename'}; $fn=~s/\W/\_/g; $fn=$tmpdir.$fn.'.tmp'; my $fh; my %fo=(); my $countrows=0; if ($fh=Apache::File->new($fn)) { - my $name; - while ($name=<$fh>) { - chomp($name); - my $value=<$fh>; - chomp($value); - $fo{$name}=$value; - if ($name=~/^A(\d+)$/) { - if ($1>$countrows) { - $countrows=$1; - } - } + while (<$fh>) { + chomp; + my ($cell,$formula) = split(/=/); + $cell = &Apache::lonnet::unescape($cell); + $formula = &Apache::lonnet::unescape($formula); + $fo{$cell} = $formula; } } if ($nform eq 'changesheet') { - $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0]; + $fo{'A'.$nfield}=(split(/__&&&\__/,$fo{'A'.$nfield}))[0]; unless ($ENV{'form.sel_'.$nfield} eq 'Default') { $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield}; } - } elsif ($nfield eq 'insertrow') { - $countrows++; - my $newrow=substr('000000'.$countrows,-7); - if ($nform eq 'top') { - $fo{'A'.$countrows}='--- '.$newrow; - } else { - $fo{'A'.$countrows}='~~~ '.$newrow; - } } else { if ($nfield) { $fo{$nfield}=$nform; } } - $sheet->{'f'}=\%fo; - &setformulas($sheet); + $self->formulas(\%fo); } -################################################## -################################################## - -=pod - -=item &parmval() - -Determine the value of a parameter. - -Inputs: $what, the parameter needed, $sheet, the safe space - -Returns: The value of a parameter, or '' if none. - -This function cascades through the possible levels searching for a value for -a parameter. The levels are checked in the following order: -user, course (at section level and course level), map, and lonnet::metadata. -This function uses %parmhash, which must be tied prior to calling it. -This function also requires %courseopt and %useropt to be initialized for -this user and course. - -=cut - -################################################## -################################################## -sub parmval { - my ($what,$sheet)=@_; - my $symb = $sheet->{'usymb'}; - unless ($symb) { return ''; } - # - my $cid = $sheet->{'cid'}; - my $csec = $sheet->{'csec'}; - my $uname = $sheet->{'uname'}; - my $udom = $sheet->{'udom'}; - my $result=''; - # - my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); - # Cascading lookup scheme - my $rwhat=$what; - $what =~ s/^parameter\_//; - $what =~ s/\_([^\_]+)$/\.$1/; - # - my $symbparm = $symb.'.'.$what; - my $mapparm = $mapname.'___(all).'.$what; - my $usercourseprefix = $uname.'_'.$udom.'_'.$cid; - # - my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; - my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; - my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; - # - my $courselevel = $usercourseprefix.'.'.$what; - my $courselevelr = $usercourseprefix.'.'.$symbparm; - my $courselevelm = $usercourseprefix.'.'.$mapparm; - # fourth, check user - if (defined($uname)) { - return $useropt{$courselevelr} if (defined($useropt{$courselevelr})); - return $useropt{$courselevelm} if (defined($useropt{$courselevelm})); - return $useropt{$courselevel} if (defined($useropt{$courselevel})); +################################################################## +## Row label formatting routines ## +################################################################## +sub format_html_rowlabel { + my $self = shift; + my $rowlabel = shift; + return '' if ($rowlabel eq ''); + my ($type,$labeldata) = split(':',$rowlabel,2); + my $result = ''; + if ($type eq 'symb') { + my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata); + $ufn = 'default' if (!defined($ufn) || $ufn eq ''); + $ufn = &Apache::lonnet::unescape($ufn); + $symb = &Apache::lonnet::unescape($symb); + $title = &Apache::lonnet::unescape($title); + $result = '<a href="/adm/assesscalc?usymb='.$symb. + '&uname='.$self->{'uname'}.'&udom='.$self->{'udom'}. + '&ufn='.$ufn. + '&mapid='.$mapid.'&resid='.$resid.'">'.$title.'</a>'; + } elsif ($type eq 'student') { + my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); + if ($fullname =~ /^\s*$/) { + $fullname = $sname.'@'.$sdom; + } + $result ='<a href="/adm/studentcalc?uname='.$sname. + '&udom='.$sdom.'">'; + $result.=$section.' '.$id." ".$fullname.'</a>'; + } elsif ($type eq 'parameter') { + $result = $labeldata; + } else { + $result = '<b><font size=+1>'.$rowlabel.'</font></b>'; } - # third, check course - if (defined($csec)) { - return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); - return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); - return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); + return $result; +} + +sub format_csv_rowlabel { + my $self = shift; + my $rowlabel = shift; + return '' if ($rowlabel eq ''); + my ($type,$labeldata) = split(':',$rowlabel,2); + my $result = ''; + if ($type eq 'symb') { + my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata); + $ufn = &Apache::lonnet::unescape($ufn); + $symb = &Apache::lonnet::unescape($symb); + $title = &Apache::lonnet::unescape($title); + $result = $title; + } elsif ($type eq 'student') { + my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); + $result = join('","',($sname,$sdom,$fullname,$section,$id)); + } elsif ($type eq 'parameter') { + $labeldata =~ s/<br>/ /g; + $result = $labeldata; + } else { + $result = $rowlabel; + } + return '"'.$result.'"'; +} + +sub format_excel_rowlabel { + my $self = shift; + my $rowlabel = shift; + return '' if ($rowlabel eq ''); + my ($type,$labeldata) = split(':',$rowlabel,2); + my $result = ''; + if ($type eq 'symb') { + my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata); + $ufn = &Apache::lonnet::unescape($ufn); + $symb = &Apache::lonnet::unescape($symb); + $title = &Apache::lonnet::unescape($title); + $result = $title; + } elsif ($type eq 'student') { + my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); + $section = '' if (! defined($section)); + $id = '' if (! defined($id)); + my @Data = ($sname,$sdom,$fullname,$section,$id); + $result = \@Data; + } elsif ($type eq 'parameter') { + $labeldata =~ s/<br>/ /g; + $result = $labeldata; + } else { + $result = $rowlabel; } - # - return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); - return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); - return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); - # second, check map parms - my $thisparm = $parmhash{$symbparm}; - return $thisparm if (defined($thisparm)); - # first, check default - return &Apache::lonnet::metadata($fn,$rwhat.'.default'); + return $result; } # ---------------------------------------------- Update rows for course listing sub updateclasssheet { - my ($sheet) = @_; - my $cnum =$sheet->{'cnum'}; - my $cdom =$sheet->{'cdom'}; - my $cid =$sheet->{'cid'}; - my $chome =$sheet->{'chome'}; + my $self = shift; + my $cnum =$self->{'cnum'}; + my $cdom =$self->{'cdom'}; + my $cid =$self->{'cid'}; + my $chome =$self->{'chome'}; # %Section = (); - # # Read class list and row labels my $classlist = &Apache::loncoursedata::get_classlist(); @@ -1625,135 +2927,145 @@ sub updateclasssheet { foreach my $student (keys(%$classlist)) { my ($studentDomain,$studentName,$end,$start,$id,$studentSection, $fullname,$status) = @{$classlist->{$student}}; + $Section{$studentName.':'.$studentDomain} = $studentSection; if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') { - my $rowlabel=''; - if ($ENV{'form.showcsv'}) { - $rowlabel= '"'.join('","',($studentName,$studentDomain, - $fullname,$studentSection,$id).'"'); - } else { - $rowlabel='<a href="/adm/studentcalc?uname='.$studentName. - '&udom='.$studentDomain.'">'; - $rowlabel.=$studentSection.' '.$id." ".$fullname; - $rowlabel.='</a>'; - } - $currentlist{$student}=$rowlabel; + $currentlist{$student}=join(':',('student',$studentName, + $studentDomain,$fullname, + $studentSection,$id)); } } # # Find discrepancies between the course row table and this # - my %f=&getformulas($sheet); + my %f=$self->formulas(); my $changed=0; # - $sheet->{'maxrow'}=0; + $self->{'maxrow'}=0; my %existing=(); # # Now obsolete rows - foreach (keys(%f)) { - if ($_=~/^A(\d+)/) { - if ($1 > $sheet->{'maxrow'}) { - $sheet->{'maxrow'}= $1; - } - $existing{$f{$_}}=1; - unless ((defined($currentlist{$f{$_}})) || (!$1) || - ($f{$_}=~/^(~~~|---)/)) { - $f{$_}='!!! Obsolete'; - $changed=1; - } + foreach my $rownum ($self->rows()) { + my $cell = 'A'.$rownum; + if ($rownum > $self->{'maxrow'}) { + $self->{'maxrow'}= $rownum; + } + $existing{$f{$cell}}=1; + if (! defined($currentlist{$f{$cell}}) && ($f{$cell}=~/^(~~~|---)/)) { + $f{$cell}='!!! Obsolete'; + $changed=1; } } # # New and unknown keys - foreach (sort keys(%currentlist)) { - unless ($existing{$_}) { - $changed=1; - $sheet->{'maxrow'}++; - $f{'A'.$sheet->{'maxrow'}}=$_; - } - } - if ($changed) { - $sheet->{'f'} = \%f; - &setformulas($sheet,%f); + foreach my $student (sort keys(%currentlist)) { + next if ($existing{$student}); + $changed=1; + $self->{'maxrow'}++; + $f{'A'.$self->{'maxrow'}}=$student; } + $self->formulas(\%f) if ($changed); # - $sheet->{'rowlabel'} = \%currentlist; - &setrowlabels($sheet); + $self->rowlabels(\%currentlist); } # ----------------------------------- Update rows for student and assess sheets -sub updatestudentassesssheet { - my ($sheet) = @_; - my %bighash; - my $stype=$sheet->{'sheettype'}; - my $uname=$sheet->{'uname'}; - my $udom =$sheet->{'udom'}; - $sheet->{'rowlabel'} = {}; - if ($updatedata - {$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) { - %{$sheet->{'rowlabel'}}=split(/___;___/, - $updatedata{$ENV{'request.course.fn'}. - '_'.$stype.'_'.$uname.'_'.$udom}); +sub get_student_rowlabels { + my $self = shift; + # + my %course_db; + # + my $stype = $self->{'type'}; + my $uname = $self->{'uname'}; + my $udom = $self->{'udom'}; + # + $self->{'rowlabel'} = {}; + # + my $identifier =$self->{'coursefilename'}.'_'.$stype; + if (exists($rowlabel_cache{$identifier})) { + my %tmp = split(/___;___/,$rowlabel_cache{$identifier}); + $self->rowlabels(\%tmp); } else { + # Get the data and store it in the cache # Tie hash - tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db', &GDBM_READER(),0640); - if (! tied(%bighash)) { + if (! tied(%course_db)) { return 'Could not access course data'; } - # Get all assessments - my %allkeys=('timestamp' => - 'Timestamp of Last Transaction<br>timestamp', - 'subnumber' => - 'Number of Submissions<br>subnumber', - 'tutornumber' => - 'Number of Tutor Responses<br>tutornumber', - 'totalpoints' => - 'Total Points Granted<br>totalpoints'); - my $adduserstr=''; - if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})){ - $adduserstr='&uname='.$uname.'&udom='.$udom; - } - my %allassess; - if (! $ENV{'form.showcsv'}) { - %allassess = - ('_feedback' =>'<a href="/adm/assesscalc?usymb=_feedback'. - $adduserstr.'">Feedback</a>', - '_evaluation' =>'<a href="/adm/assesscalc?usymb=_evaluation'. - $adduserstr.'">Evaluation</a>', - '_tutoring' =>'<a href="/adm/assesscalc?usymb=_tutoring'. - $adduserstr.'">Tutoring</a>', - '_discussion' =>'<a href="/adm/assesscalc?usymb=_discussion'. - $adduserstr.'">Discussion</a>' - ); - } else { - %allassess = - ('_feedback' => "Feedback", - '_evaluation' => "Evaluation", - '_tutoring' => "Tutoring", - '_discussion' => "Discussion", - ); - } - while (($_,undef) = each(%bighash)) { - next if ($_!~/^src\_(\d+)\.(\d+)$/); - my $mapid=$1; - my $resid=$2; - my $id=$mapid.'.'.$resid; - my $srcf=$bighash{$_}; + # + my %assesslist = (); + foreach ('Feedback','Evaluation','Tutoring','Discussion') { + my $symb = '_'.lc($_); + $assesslist{$symb} = join(':',('symb',$symb,0,0, + &Apache::lonnet::escape($_))); + } + # + while (my ($key,$srcf) = each(%course_db)) { + next if ($key !~ /^src_(\d+)\.(\d+)$/); + my $mapid = $1; + my $resid = $2; + my $id = $mapid.'.'.$resid; if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { my $symb= - &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). + &Apache::lonnet::declutter($course_db{'map_id_'.$mapid}). '___'.$resid.'___'.&Apache::lonnet::declutter($srcf); - if (! $ENV{'form.showcsv'}) { - $allassess{$symb}= - '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'. - $bighash{'title_'.$id}.'</a>'; - } else { - $allassess{$symb}=$bighash{'title_'.$id}; - } - next if ($stype ne 'assesscalc'); - foreach my $key (split(/\,/, - &Apache::lonnet::metadata($srcf,'keys') - )) { + $assesslist{$symb} ='symb:'.&Apache::lonnet::escape($symb).':' + .$mapid.':'.$resid.':'. + &Apache::lonnet::escape($course_db{'title_'.$id}); + } + } + untie(%course_db); + # Store away the data + $self->{'rowlabel'} = \%assesslist; + $rowlabel_cache{$identifier}=join('___;___',%{$self->{'rowlabel'}}); + } + +} + +sub get_assess_rowlabels { + my $self = shift; + # + my %course_db; + # + my $stype = $self->{'type'}; + my $uname = $self->{'uname'}; + my $udom = $self->{'udom'}; + my $usymb = $self->{'usymb'}; + # + $self->rowlabels({}); + my $identifier =$self->{'coursefilename'}.'_'.$stype.'_'.$usymb; + # + if (exists($rowlabel_cache{$identifier})) { + my %tmp = split('___;___',$rowlabel_cache{$identifier}); + $self->rowlabels(\%tmp); + } else { + # Get the data and store it in the cache + # Tie hash + tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db', + &GDBM_READER(),0640); + if (! tied(%course_db)) { + return 'Could not access course data'; + } + # + my %parameter_labels= + ('timestamp' => + 'parameter:Timestamp of Last Transaction<br>timestamp', + 'subnumber' => + 'parameter:Number of Submissions<br>subnumber', + 'tutornumber' => + 'parameter:Number of Tutor Responses<br>tutornumber', + 'totalpoints' => + 'parameter:Total Points Granted<br>totalpoints'); + while (my ($key,$srcf) = each(%course_db)) { + next if ($key !~ /^src_(\d+)\.(\d+)$/); + my $mapid = $1; + my $resid = $2; + my $id = $mapid.'.'.$resid; + if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { + # Loop through the metadata for this key + my @Metadata = split(/,/, + &Apache::lonnet::metadata($srcf,'keys')); + foreach my $key (@Metadata) { next if ($key !~ /^(stores|parameter)_/); my $display= &Apache::lonnet::metadata($srcf,$key.'.display'); @@ -1762,128 +3074,117 @@ sub updatestudentassesssheet { &Apache::lonnet::metadata($srcf,$key.'.name'); } $display.='<br>'.$key; - $allkeys{$key}=$display; + $parameter_labels{$key}='parameter:'.$display; } # end of foreach } - } # end of foreach (keys(%bighash)) - untie(%bighash); - # - # %allkeys has a list of storage and parameter displays by unikey - # %allassess has a list of all resource displays by symb - # - if ($stype eq 'assesscalc') { - $sheet->{'rowlabel'} = \%allkeys; - } elsif ($stype eq 'studentcalc') { - $sheet->{'rowlabel'} = \%allassess; - } - $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}= - join('___;___',%{$sheet->{'rowlabel'}}); - # Get current from cache + } + untie(%course_db); + # Store away the results + $self->rowlabels(\%parameter_labels); + $rowlabel_cache{$identifier}=join('___;___',%parameter_labels); } - # Find discrepancies between the course row table and this - # - my %f=&getformulas($sheet); +} + +sub updatestudentassesssheet { + my $self = shift; + if ($self->{'type'} eq 'studentcalc') { + $self->get_student_rowlabels(); + } else { + $self->get_assess_rowlabels(); + } + # Determine if any of the information has changed + my %f=$self->formulas(); my $changed=0; - - $sheet->{'maxrow'} = 0; + $self->{'maxrow'} = 0; my %existing=(); # Now obsolete rows - foreach (keys(%f)) { - next if ($_!~/^A(\d+)/); - if ($1 > $sheet->{'maxrow'}) { - $sheet->{'maxrow'} = $1; - } - my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); + foreach my $rownum ($self->rows()) { + my $cell = 'A'.$rownum; + my $formula = $f{$cell}; + $self->{'maxrow'} = $rownum if ($rownum > $self->{'maxrow'}); + my ($usy,$ufn)=split(/__&&&\__/,$formula); $existing{$usy}=1; - unless ((exists($sheet->{'rowlabel'}->{$usy}) && - (defined($sheet->{'rowlabel'}->{$usy})) || (!$1) || - ($f{$_}=~/^(~~~|---)/))){ - $f{$_}='!!! Obsolete'; + if ( ! exists($self->{'rowlabel'}->{$usy}) || + ! defined($self->{'rowlabel'}->{$usy}) || + ($formula =~ /^(~~~|---)/) || + ($formula =~ /^\s*$/)) { + $f{$cell}='!!! Obsolete'; $changed=1; - } elsif ($ufn) { - $sheet->{'rowlabel'}->{$usy} - =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; } } # New and unknown keys - foreach (keys(%{$sheet->{'rowlabel'}})) { + my %keys_hates_me = $self->rowlabels(); + foreach (keys(%keys_hates_me)) { unless ($existing{$_}) { $changed=1; - $sheet->{'maxrow'}++; - $f{'A'.$sheet->{'maxrow'}}=$_; + $self->{'maxrow'}++; + $f{'A'.$self->{'maxrow'}}=$_; } } - if ($changed) { - $sheet->{'f'} = \%f; - &setformulas($sheet); - } - &setrowlabels($sheet); - # - undef %existing; + $self->formulas(\%f) if ($changed); +# $self->dump_formulas_to_log(); } # ------------------------------------------------ Load data for one assessment - -sub loadstudent { - my ($sheet)=@_; - my %c=(); - my %f=&getformulas($sheet); - $cachedassess=$sheet->{'uname'}.':'.$sheet->{'udom'}; +sub loadstudent{ + my $self = shift; + my ($r,$c)=@_; + my %constants = (); + my %formulas = $self->formulas(); + $cachedassess = $self->{'uname'}.':'.$self->{'udom'}; # Get ALL the student preformance data - my @tmp = &Apache::lonnet::dump($sheet->{'cid'}, - $sheet->{'udom'}, - $sheet->{'uname'}, - undef); - if ($tmp[0] !~ /^error:/) { + my @tmp = &Apache::lonnet::currentdump($self->{'uname'}, + $self->{'udom'}, + $self->{'cid'}); + if ((scalar @tmp > 0) && ($tmp[0] !~ /^error:/)) { %cachedstores = @tmp; } undef @tmp; # my @assessdata=(); - foreach (keys(%f)) { - next if ($_!~/^A(\d+)/); - my $row=$1; - next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); - my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); - @assessdata=&exportsheet($sheet->{'uname'}, - $sheet->{'udom'}, - 'assesscalc',$usy,$ufn); + foreach my $row ($self->rows()) { + my $cell = 'A'.$row; + my $value = $formulas{$cell}; + if(defined($c) && ($c->aborted())) { + last; + } + next if ($value =~ /^[!~-]/); + my ($usy,$ufn)=split(/__&&&\__/,$value); + @assessdata=$self->exportsheet($self->{'uname'}, + $self->{'udom'}, + 'assesscalc',$usy,$ufn,$r); my $index=0; - foreach ('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') { - if ($assessdata[$index]) { - my $col=$_; + foreach my $col ('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') { + if (defined($assessdata[$index])) { if ($assessdata[$index]=~/\D/) { - $c{$col.$row}="'".$assessdata[$index]."'"; + $constants{$col.$row}="'".$assessdata[$index]."'"; } else { - $c{$col.$row}=$assessdata[$index]; - } - unless ($col eq 'A') { - $f{$col.$row}='import'; + $constants{$col.$row}=$assessdata[$index]; } + $formulas{$col.$row}='import' if ($col ne 'A'); } $index++; } } $cachedassess=''; undef %cachedstores; - $sheet->{'f'} = \%f; - $sheet->{'constants'} = \%c; - &setformulas($sheet); - &setconstants($sheet); + $self->formulas(\%formulas); + $self->constants(\%constants); } # --------------------------------------------------- Load data for one student # sub loadcourse { - my ($sheet,$r)=@_; - my %c=(); - my %f=&getformulas($sheet); + my $self = shift; + my ($r,$c)=@_; + # + my %constants=(); + my %formulas=$self->formulas(); + # my $total=0; - foreach (keys(%f)) { - if ($_=~/^A(\d+)/) { - unless ($f{$_}=~/^[\!\~\-]/) { $total++; } - } + foreach ($self->rows()) { + $total++ if ($formulas{'A'.$_} !~ /^[!~-]/); } my $now=0; my $since=time; @@ -1893,46 +3194,50 @@ sub loadcourse { popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+ '<h3>Spreadsheet Calculation Progress</h3>'+ '<form name=popremain>'+ - '<input type=text size=35 name=remaining value=Starting></form>'+ + '<input type=text size=45 name=remaining value=Starting></form>'+ '</body></html>'); popwin.document.close(); </script> ENDPOP $r->rflush(); - foreach (keys(%f)) { - next if ($_!~/^A(\d+)/); - my $row=$1; - next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); - my @studentdata=&exportsheet(split(/\:/,$f{$_}), - 'studentcalc'); + # It would be nice to load in the classlist and assessment info at this + # point, before attacking the student spreadsheets. + foreach my $row ($self->rows()) { + if(defined($c) && ($c->aborted())) { + last; + } + my $cell = 'A'.$row; + next if ($formulas{$cell}=~/^[\!\~\-]/); + my ($sname,$sdom) = split(':',$formulas{$cell}); + my $started = time; + my @studentdata=$self->exportsheet($sname,$sdom,'studentcalc', + undef,undef,$r); undef %userrdatas; $now++; $r->print('<script>popwin.document.popremain.remaining.value="'. $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)). - ' secs remaining";</script>'); + ' secs remaining '.(time-$started).' last";</script>'); $r->rflush(); # my $index=0; foreach ('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') { - if ($studentdata[$index]) { + if (defined($studentdata[$index])) { my $col=$_; if ($studentdata[$index]=~/\D/) { - $c{$col.$row}="'".$studentdata[$index]."'"; + $constants{$col.$row}="'".$studentdata[$index]."'"; } else { - $c{$col.$row}=$studentdata[$index]; + $constants{$col.$row}=$studentdata[$index]; } unless ($col eq 'A') { - $f{$col.$row}='import'; + $formulas{$col.$row}='import'; } - $index++; - } + } + $index++; } } - $sheet->{'f'}=\%f; - $sheet->{'constants'}=\%c; - &setformulas($sheet); - &setconstants($sheet); + $self->formulas(\%formulas); + $self->constants(\%constants); $r->print('<script>popwin.close()</script>'); $r->rflush(); } @@ -1940,16 +3245,18 @@ ENDPOP # ------------------------------------------------ Load data for one assessment # sub loadassessment { - my ($sheet)=@_; + my $self = shift; + my ($r,$c)=@_; - my $uhome = $sheet->{'uhome'}; - my $uname = $sheet->{'uname'}; - my $udom = $sheet->{'udom'}; - my $symb = $sheet->{'usymb'}; - my $cid = $sheet->{'cid'}; - my $cnum = $sheet->{'cnum'}; - my $cdom = $sheet->{'cdom'}; - my $chome = $sheet->{'chome'}; + my $uhome = $self->{'uhome'}; + my $uname = $self->{'uname'}; + my $udom = $self->{'udom'}; + my $symb = $self->{'usymb'}; + my $cid = $self->{'cid'}; + my $cnum = $self->{'cnum'}; + my $cdom = $self->{'cdom'}; + my $chome = $self->{'chome'}; + my $csec = $self->{'csec'}; my $namespace; unless ($namespace=$cid) { return ''; } @@ -1959,23 +3266,16 @@ sub loadassessment { # # get data out of the dumped stores # - my $version=$cachedstores{'version:'.$symb}; - my $scope; - for ($scope=1;$scope<=$version;$scope++) { - foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) { - $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; - } + if (exists($cachedstores{$symb})) { + %returnhash = %{$cachedstores{$symb}}; + } else { + %returnhash = (); } } else { # # restore individual # %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname); - for (my $version=1;$version<=$returnhash{'version'};$version++) { - foreach (split(/\:/,$returnhash{$version.':keys'})) { - $returnhash{$_}=$returnhash{$version.':'.$_}; - } - } } # # returnhash now has all stores for this resource @@ -2034,68 +3334,42 @@ sub loadassessment { # my %c=(); if (tie(%parmhash,'GDBM_File', - $sheet->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { - my %f=&getformulas($sheet); - foreach (keys(%f)) { - next if ($_!~/^A/); - next if ($f{$_}=~/^[\!\~\-]/); - if ($f{$_}=~/^parameter/) { - if ($thisassess{$f{$_}}) { - my $val=&parmval($f{$_},$sheet); - $c{$_}=$val; - $c{$f{$_}}=$val; + $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { + my %f=$self->formulas(); + foreach my $row ($self->rows()) { + my $cell = 'A'.$row; + my $formula = $self->formula($cell); + next if ($formula =~/^[\!\~\-]/); + if ($formula =~ /^parameter/) { + if (defined($thisassess{$formula})) { + my $val = &parmval($formula,$symb,$uname,$udom,$csec); + $c{$cell} = $val; + $c{$formula} = $val; } } else { - my $key=$f{$_}; - my $ckey=$key; - $key=~s/^stores\_/resource\./; - $key=~s/\_/\./g; - $c{$_}=$returnhash{$key}; - $c{$ckey}=$returnhash{$key}; + my $ckey=$formula; + $formula=~s/^stores\_/resource\./; + $formula=~s/\_/\./g; + $c{$cell}=$returnhash{$formula}; + $c{$ckey}=$returnhash{$formula}; } } untie(%parmhash); } - $sheet->{'constants'}=\%c; - &setconstants($sheet); -} - -# --------------------------------------------------------- Various form fields - -sub textfield { - my ($title,$name,$value)=@_; - return "\n<p><b>$title:</b><br>". - '<input type=text name="'.$name.'" size=80 value="'.$value.'">'; + $self->constants(\%c); } -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.'">'; - foreach (sort keys(%options)) { - $selout.='<option value="'.$_.'"'; - if ($_ eq $value) { $selout.=' selected'; } - $selout.='>'.$options{$_}.'</option>'; - } - return $selout.'</select>'; -} # =============================================== Update information in a sheet # # Add new users or assessments, etc. # - sub updatesheet { - my ($sheet)=@_; - my $stype=$sheet->{'sheettype'}; - if ($stype eq 'classcalc') { - return &updateclasssheet($sheet); + my $self = shift; + if ($self->{'type'} eq 'classcalc') { + return $self->updateclasssheet(); } else { - return &updatestudentassesssheet($sheet); + return $self->updatestudentassesssheet(); } } @@ -2103,56 +3377,34 @@ sub updatesheet { # # Import the data for rows # - sub loadrows { - my ($sheet,$r)=@_; - my $stype=$sheet->{'sheettype'}; - if ($stype eq 'classcalc') { - &loadcourse($sheet,$r); - } elsif ($stype eq 'studentcalc') { - &loadstudent($sheet); - } else { - &loadassessment($sheet); - } -} - -# ======================================================= Forced recalculation? - -sub checkthis { - my ($keyname,$time)=@_; - return ($time<$expiredates{$keyname}); -} - -sub forcedrecalc { - my ($uname,$udom,$stype,$usymb)=@_; - my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; - my $time=$oldsheets{$key.'.time'}; - if ($ENV{'form.forcerecalc'}) { return 1; } - unless ($time) { return 1; } - if ($stype eq 'assesscalc') { - my $map=(split(/___/,$usymb))[0]; - if (&checkthis('::assesscalc:',$time) || - &checkthis('::assesscalc:'.$map,$time) || - &checkthis('::assesscalc:'.$usymb,$time) || - &checkthis($uname.':'.$udom.':assesscalc:',$time) || - &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) || - &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) { - return 1; - } + my $self = shift; + my ($r)=@_; + my $c = $r->connection; + if ($self->{'type'} eq 'classcalc') { + $self->loadcourse($r,$c); + } elsif ($self->{'type'} eq 'studentcalc') { + $self->loadstudent($r,$c); } else { - if (&checkthis('::studentcalc:',$time) || - &checkthis($uname.':'.$udom.':studentcalc:',$time)) { - return 1; - } + $self->loadassessment($r,$c); } - return 0; } # ============================================================== Export handler +# exportsheet +# returns the export row for a spreadsheet. +# sub exportsheet { - my ($uname,$udom,$stype,$usymb,$fn)=@_; + my $self = shift; + my ($uname,$udom,$stype,$usymb,$fn,$r)=@_; + my $flag = 0; + $uname = $uname || $self->{'uname'}; + $udom = $udom || $self->{'udom'}; + $stype = $stype || $self->{'type'}; my @exportarr=(); - if (defined($usymb) && ($usymb=~/^\_(\w+)/) && (!$fn)) { + # This handles the assessment sheets for '_feedback', etc + if (defined($usymb) && ($usymb=~/^\_(\w+)/) && + (!defined($fn) || $fn eq '')) { $fn='default_'.$1; } # @@ -2160,8 +3412,8 @@ sub exportsheet { # my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; my $found=''; - if ($oldsheets{$key}) { - foreach (split(/___&\___/,$oldsheets{$key})) { + if ($Apache::lonspreadsheet::oldsheets{$key}) { + foreach (split(/___&\___/,$Apache::lonspreadsheet::oldsheets{$key})) { my ($name,$value)=split(/___=___/,$_); if ($name eq $fn) { $found=$value; @@ -2169,9 +3421,9 @@ sub exportsheet { } } unless ($found) { - &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom)); - if ($oldsheets{$key}) { - foreach (split(/___&\___/,$oldsheets{$key})) { + &cachedssheets($self,$uname,$udom); + if ($Apache::lonspreadsheet::oldsheets{$key}) { + foreach (split(/___&\___/,$Apache::lonspreadsheet::oldsheets{$key})) { my ($name,$value)=split(/___=___/,$_); if ($name eq $fn) { $found=$value; @@ -2196,423 +3448,81 @@ sub exportsheet { } # # Not cached - # - my ($sheet)=&makenewsheet($uname,$udom,$stype,$usymb); - &readsheet($sheet,$fn); - &updatesheet($sheet); - &loadrows($sheet); - &calcsheet($sheet); - @exportarr=&exportdata($sheet); # - # Store now + my $newsheet = Apache::lonspreadsheet::Spreadsheet->new($uname,$udom, + $stype,$usymb); + $newsheet->readsheet($fn); + $newsheet->updatesheet(); + $newsheet->loadrows($r); + $newsheet->calcsheet(); + @exportarr=$newsheet->exportdata(); + ## + ## 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:'.$sheet->{'udom'}.':'. - $sheet->{'uname'}. - ':nohist_calculatedsheets_'. - $ENV{'request.course.id'}.':'. - &Apache::lonnet::escape($key), - $sheet->{'uhome'}); - } - my %currentlystored=(); - unless ($current=~/^error\:/) { - foreach (split(/___&\___/,&Apache::lonnet::unescape($current))) { - my ($name,$value)=split(/___=___/,$_); - $currentlystored{$name}=$value; - } - } - $currentlystored{$fn}=join('___;___',@exportarr); + # load in the old value # - my $newstore=''; - foreach (keys(%currentlystored)) { - if ($newstore) { $newstore.='___&___'; } - $newstore.=$_.'___=___'.$currentlystored{$_}; - } - my $now=time; + my %currentlystored=(); if ($stype eq 'studentcalc') { - &Apache::lonnet::put('nohist_calculatedsheets', - { $key => $newstore, - $key.time => $now }, - $ENV{'course.'.$cid.'.domain'}, - $ENV{'course.'.$cid.'.num'}) - } else { - &Apache::lonnet::put('nohist_calculatedsheets_'.$sheet->{'cid'}, - { $key => $newstore, - $key.time => $now }, - $sheet->{'udom'}, - $sheet->{'uname'}) - } - return @exportarr; -} - -# ============================================================ Expiration Dates -# -# Load previously cached student spreadsheets for this course -# -sub expirationdates { - undef %expiredates; - my $cid=$ENV{'request.course.id'}; - my $reply=&Apache::lonnet::reply('dump:'. - $ENV{'course.'.$cid.'.domain'}.':'. - $ENV{'course.'.$cid.'.num'}. - ':nohist_expirationdates', - $ENV{'course.'.$cid.'.home'}); - unless ($reply=~/^error\:/) { - foreach (split(/\&/,$reply)) { - my ($name,$value)=split(/\=/,$_); - $expiredates{&Apache::lonnet::unescape($name)} - =&Apache::lonnet::unescape($value); - } - } -} - -# ===================================================== 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\:/) { - foreach ( split(/\&/,$reply)) { - my ($name,$value)=split(/\=/,$_); - $oldsheets{&Apache::lonnet::unescape($name)} - =&Apache::lonnet::unescape($value); - } - } -} - -# ===================================================== 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\:/) { - foreach ( split(/\&/,$reply)) { - my ($name,$value)=split(/\=/,$_); - $oldsheets{&Apache::lonnet::unescape($name)} - =&Apache::lonnet::unescape($value); - } - } - $loadedcaches{$sname.'_'.$sdom}=1; - } -} - -# ===================================================== Calculated sheets cache -# -# Load previously cached assessment spreadsheets for this student -# - -# ================================================================ Main handler -# -# Interactive call to screen -# -# -sub handler { - my $r=shift; - - if (! exists($ENV{'form.Status'})) { - $ENV{'form.Status'} = 'Active'; - } - # Check this server - my $loaderror=&Apache::lonnet::overloaderror($r); - if ($loaderror) { return $loaderror; } - # Check the course homeserver - $loaderror= &Apache::lonnet::overloaderror($r, - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - if ($loaderror) { return $loaderror; } - - if ($r->header_only) { - $r->content_type('text/html'); - $r->send_http_header; - return OK; - } - # Global directory configs - $includedir = $r->dir_config('lonIncludes'); - $tmpdir = $r->dir_config('lonDaemons').'/tmp/'; - # Needs to be in a course - if (! $ENV{'request.course.fn'}) { - # 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; - } - # Get query string for limited number of parameters - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['uname','udom','usymb','ufn']); - if ($ENV{'request.role'} =~ /^st\./) { - delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'})); - delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'})); - } - if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { - $ENV{'form.ufn'}='default_'.$1; - } - # Interactive loading of specific sheet? - if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { - $ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; - } - # - # Determine the user name and domain for the sheet. - my $aname; - my $adom; - unless ($ENV{'form.uname'}) { - $aname=$ENV{'user.name'}; - $adom=$ENV{'user.domain'}; - } else { - $aname=$ENV{'form.uname'}; - $adom=$ENV{'form.udom'}; - } - # - # Open page - $r->content_type('text/html'); - $r->header_out('Cache-control','no-cache'); - $r->header_out('Pragma','no-cache'); - $r->send_http_header; - # Screen output - $r->print('<html><head><title>LON-CAPA Spreadsheet</title>'); - if ($ENV{'request.role'} !~ /^st\./) { - $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(); + my @tmp = &Apache::lonnet::get('nohist_calculatedsheets', + [$key], + $self->{'cdom'},$self->{'cnum'}); + if ($tmp[0]!~/^error/) { + # We only got one key, so we will access it directly. + foreach (split('___&___',$tmp[1])) { + my ($key,$value) = split('___=___',$_); + $key = '' if (! defined($key)); + $currentlystored{$key} = $value; + } } - } - - function changesheet(cn) { - document.sheet.unewfield.value=cn; - document.sheet.unewformula.value='changesheet'; - document.sheet.submit(); - } - - function insertrow(cn) { - document.sheet.unewfield.value='insertrow'; - document.sheet.unewformula.value=cn; - document.sheet.submit(); - } - -</script> -ENDSCRIPT - } - $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet'). - '<form action="'.$r->uri.'" name=sheet method=post>'); - $r->print(&hiddenfield('uname',$ENV{'form.uname'}). - &hiddenfield('udom',$ENV{'form.udom'}). - &hiddenfield('usymb',$ENV{'form.usymb'}). - &hiddenfield('unewfield',''). - &hiddenfield('unewformula','')); - $r->rflush(); - # - # Full recalc? - if ($ENV{'form.forcerecalc'}) { - $r->print('<h4>Completely Recalculating Sheet ...</h4>'); - undef %spreadsheets; - undef %courserdatas; - undef %userrdatas; - undef %defaultsheets; - undef %updatedata; - } - # Read new sheet or modified worksheet - $r->uri=~/\/(\w+)$/; - my ($sheet)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'}); - # - # If a new formula had been entered, go from work copy - if ($ENV{'form.unewfield'}) { - $r->print('<h2>Modified Workcopy</h2>'); - $ENV{'form.unewformula'}=~s/\'/\"/g; - $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='. - $ENV{'form.unewformula'}.'<p>'); - $sheet->{'filename'} = $ENV{'form.ufn'}; - &tmpread($sheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'}); - } elsif ($ENV{'form.saveas'}) { - $sheet->{'filename'} = $ENV{'form.ufn'}; - &tmpread($sheet); } else { - &readsheet($sheet,$ENV{'form.ufn'}); - } - # Print out user information - if ($sheet->{'sheettype'} ne 'classcalc') { - $r->print('<p><b>User:</b> '.$sheet->{'uname'}. - '<br><b>Domain:</b> '.$sheet->{'udom'}); - $r->print('<br><b>Section/Group:</b> '.$sheet->{'csec'}); - if ($ENV{'form.usymb'}) { - $r->print('<br><b>Assessment:</b> <tt>'. - $ENV{'form.usymb'}.'</tt>'); - } - } - # - # Check user permissions - if (($sheet->{'sheettype'} eq 'classcalc' ) || - ($sheet->{'uname'} ne $ENV{'user.name'} ) || - ($sheet->{'udom'} ne $ENV{'user.domain'})) { - unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) { - $r->print('<h1>Access Permission Denied</h1>'. - '</form></body></html>'); - return OK; - } - } - # Additional options - $r->print('<br />'. - '<input type="submit" name="forcerecalc" '. - 'value="Completely Recalculate Sheet"><p>'); - if ($sheet->{'sheettype'} eq 'assesscalc') { - $r->print('<p><font size=+2>'. - '<a href="/adm/studentcalc?'. - 'uname='.$sheet->{'uname'}. - '&udom='.$sheet->{'udom'}.'">'. - 'Level up: Student Sheet</a></font><p>'); - } - if (($sheet->{'sheettype'} eq 'studentcalc') && - (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) { - $r->print ('<p><font size=+2><a href="/adm/classcalc">'. - 'Level up: Course Sheet</a></font><p>'); - } - # Save dialog - if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { - my $fname=$ENV{'form.ufn'}; - $fname=~s/\_[^\_]+$//; - if ($fname eq 'default') { $fname='course_default'; } - $r->print('<input type=submit name=saveas value="Save as ...">'. - '<input type=text size=20 name=newfn value="'.$fname.'">'. - 'make default: <input type=checkbox name="makedefufn"><p>'); - } - $r->print(&hiddenfield('ufn',$sheet->{'filename'})); - # Load dialog - if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { - $r->print('<p><input type=submit name=load value="Load ...">'. - '<select name="loadthissheet">'. - '<option name="default">Default</option>'); - foreach (&othersheets($sheet)) { - $r->print('<option name="'.$_.'"'); - if ($ENV{'form.ufn'} eq $_) { - $r->print(' selected'); + my @tmp = &Apache::lonnet::get('nohist_calculatedsheets_'. + $self->{'cid'},[$key], + $self->{'udom'},$self->{'uname'}); + if ($tmp[0]!~/^error/) { + # We only got one key, so we will access it directly. + foreach (split('___&___',$tmp[1])) { + my ($key,$value) = split('___=___',$_); + $key = '' if (! defined($key)); + $currentlystored{$key} = $value; } - $r->print('>'.$_.'</option>'); - } - $r->print('</select><p>'); - if ($sheet->{'sheettype'} eq 'studentcalc') { - &setothersheets($sheet, - &othersheets($sheet,'assesscalc')); } } - # Cached sheets - &expirationdates(); - undef %oldsheets; - undef %loadedcaches; - if ($sheet->{'sheettype'} eq 'classcalc') { - $r->print("Loading previously calculated student sheets ...\n"); - $r->rflush(); - &cachedcsheets(); - } elsif ($sheet->{'sheettype'} eq 'studentcalc') { - $r->print("Loading previously calculated assessment sheets ...\n"); - $r->rflush(); - &cachedssheets($sheet->{'uname'},$sheet->{'udom'},$sheet->{'uhome'}); - } - # Update sheet, load rows - $r->print("Loaded sheet(s), updating rows ...<br>\n"); - $r->rflush(); # - &updatesheet($sheet); - $r->print("Updated rows, loading row data ...\n"); - $r->rflush(); + # Add the new line # - &loadrows($sheet,$r); - $r->print("Loaded row data, calculating sheet ...<br>\n"); - $r->rflush(); + $currentlystored{$fn}=join('___;___',@exportarr); # - my $calcoutput=&calcsheet($sheet); - $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); - # See if something to save - if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { - my $fname=''; - if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { - $fname=~s/\W/\_/g; - if ($fname eq 'default') { $fname='course_default'; } - $fname.='_'.$sheet->{'sheettype'}; - $sheet->{'filename'} = $fname; - $ENV{'form.ufn'}=$fname; - $r->print('<p>Saving spreadsheet: '. - &writesheet($sheet,$ENV{'form.makedefufn'}). - '<p>'); - } - } + # Stick everything back together # - # Write the modified worksheet - $r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'<p>'); - &tmpwrite($sheet); - if ($sheet->{'sheettype'} eq 'studentcalc') { - $r->print('<br>Show rows with empty A column: '); - } else { - $r->print('<br>Show empty rows: '); + my $newstore=''; + foreach (keys(%currentlystored)) { + if ($newstore) { $newstore.='___&___'; } + $newstore.=$_.'___=___'.$currentlystored{$_}; } + my $now=time; # - $r->print(&hiddenfield('userselhidden','true'). - '<input type="checkbox" name="showall" onClick="submit()"'); + # Store away the new value # - if ($ENV{'form.showall'}) { - $r->print(' checked'); - } else { - unless ($ENV{'form.userselhidden'}) { - unless - ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') { - $r->print(' checked'); - $ENV{'form.showall'}=1; - } - } - } - $r->print('>'); - # - # CSV format checkbox (classcalc sheets only) - $r->print(' Output CSV format: <input type="checkbox" '. - 'name="showcsv" onClick="submit()"'); - $r->print(' checked') if ($ENV{'form.showcsv'}); - $r->print('>'); - if ($sheet->{'sheettype'} eq 'classcalc') { - $r->print(' Student Status: '. - &Apache::lonhtmlcommon::StatusOptions - ($ENV{'form.Status'},'sheet')); + my $timekey = $key.'.time'; + if ($stype eq 'studentcalc') { + my $result = &Apache::lonnet::put('nohist_calculatedsheets', + { $key => $newstore, + $timekey => $now }, + $self->{'cdom'}, + $self->{'cnum'}); + } else { + my $result = &Apache::lonnet::put('nohist_calculatedsheets_'.$self->{'cid'}, + { $key => $newstore, + $timekey => $now }, + $self->{'udom'}, + $self->{'uname'}); } - # - # Buttons to insert rows - $r->print(<<ENDINSERTBUTTONS); -<br> -<input type='button' onClick='insertrow("top");' -value='Insert Row Top'> -<input type='button' onClick='insertrow("bottom");' -value='Insert Row Bottom'><br> -ENDINSERTBUTTONS - # Print out sheet - &outsheet($r,$sheet); - $r->print('</form></body></html>'); - # Done - return OK; + return @exportarr; } 1; + __END__ + +