loncom/interface/lonspreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.164: download - view: text, annotated - select for diffs
Wed Jan 29 16:26:08 2003 UTC (21 years, 5 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

BIG CHANGES (this commit is 3000 lines longer than the code is :) )
This code has been tested and I believe it produces identical results to
the lonspreadsheet.pm in 0.6.1.
The spreadsheet is now an object, accessed via methods and all that nifty
stuff.
&mask, being a pure function, now memoizes its results.
The HASH and related subroutines have temporarily been removed from the
safe space.  I would like to remove them permenantly but this is unlikely
to be feasable.
&expandnamed and &sett have been moved outside the safe space.
logging and accessor/setter functions have been added.  In
more than a few cases the previous code did
foreach my $cell (keys(%formulas)) {
    next if ($cell !~ /^A(\d+)/);
..
methods have been written to return just the needed cells for the 'A' column
and the template row.
A few debugging routines have been added ($sheet->dump_formulas_to_log() and
$sheet->dump_values_to_log() );
The code has been re-arranged and will be re-arranged further.

1: # 2: # $Id: lonspreadsheet.pm,v 1.164 2003/01/29 16:26:08 matthew Exp $ 3: # 4: # Copyright Michigan State University Board of Trustees 5: # 6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 7: # 8: # LON-CAPA is free software; you can redistribute it and/or modify 9: # it under the terms of the GNU General Public License as published by 10: # the Free Software Foundation; either version 2 of the License, or 11: # (at your option) any later version. 12: # 13: # LON-CAPA is distributed in the hope that it will be useful, 14: # but WITHOUT ANY WARRANTY; without even the implied warranty of 15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16: # GNU General Public License for more details. 17: # 18: # You should have received a copy of the GNU General Public License 19: # along with LON-CAPA; if not, write to the Free Software 20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 21: # 22: # /home/httpd/html/adm/gpl.txt 23: # 24: # http://www.lon-capa.org/ 25: # 26: # The LearningOnline Network with CAPA 27: # Spreadsheet/Grades Display Handler 28: # 29: # POD required stuff: 30: 31: =head1 NAME 32: 33: lonspreadsheet 34: 35: =head1 SYNOPSIS 36: 37: Spreadsheet interface to internal LON-CAPA data 38: 39: =head1 DESCRIPTION 40: 41: Lonspreadsheet provides course coordinators the ability to manage their 42: students grades online. The students are able to view their own grades, but 43: not the grades of their peers. The spreadsheet is highly customizable, 44: offering the ability to use Perl code to manipulate data, as well as many 45: built-in functions. 46: 47: =head2 Functions available to user of lonspreadsheet 48: 49: =over 4 50: 51: =cut 52: 53: 54: package Apache::lonspreadsheet; 55: 56: use strict; 57: use Apache::Constants qw(:common :http); 58: use Apache::lonnet; 59: use Apache::lonhtmlcommon; 60: use HTML::Entities(); 61: 62: # --------------------------------------------------------- Various form fields 63: 64: sub textfield { 65: my ($title,$name,$value)=@_; 66: return "\n<p><b>$title:</b><br>". 67: '<input type=text name="'.$name.'" size=80 value="'.$value.'">'; 68: } 69: 70: sub hiddenfield { 71: my ($name,$value)=@_; 72: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">'; 73: } 74: 75: sub selectbox { 76: my ($title,$name,$value,%options)=@_; 77: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">'; 78: foreach (sort keys(%options)) { 79: $selout.='<option value="'.$_.'"'; 80: if ($_ eq $value) { $selout.=' selected'; } 81: $selout.='>'.$options{$_}.'</option>'; 82: } 83: return $selout.'</select>'; 84: } 85: 86: my %oldsheets; 87: my %loadedcaches; 88: 89: # ================================================================ Main handler 90: # 91: # Interactive call to screen 92: # 93: # 94: sub handler { 95: my $r=shift; 96: 97: my ($sheettype) = ($r->uri=~/\/(\w+)$/); 98: 99: if (! exists($ENV{'form.Status'})) { 100: $ENV{'form.Status'} = 'Active'; 101: } 102: if ( ! exists($ENV{'form.output'}) || 103: ($sheettype ne 'classcalc' && 104: lc($ENV{'form.output'}) eq 'recursive excel')) { 105: $ENV{'form.output'} = 'HTML'; 106: } 107: # 108: # Overload checking 109: # 110: # Check this server 111: my $loaderror=&Apache::lonnet::overloaderror($r); 112: if ($loaderror) { return $loaderror; } 113: # Check the course homeserver 114: $loaderror= &Apache::lonnet::overloaderror($r, 115: $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); 116: if ($loaderror) { return $loaderror; } 117: # 118: # HTML Header 119: # 120: if ($r->header_only) { 121: $r->content_type('text/html'); 122: $r->send_http_header; 123: return OK; 124: } 125: # 126: # Roles Checking 127: # 128: # Needs to be in a course 129: if (! $ENV{'request.course.fn'}) { 130: # Not in a course, or not allowed to modify parms 131: $ENV{'user.error.msg'}= 132: $r->uri.":opa:0:0:Cannot modify spreadsheet"; 133: return HTTP_NOT_ACCEPTABLE; 134: } 135: # 136: # Get query string for limited number of parameters 137: # 138: &Apache::loncommon::get_unprocessed_cgi 139: ($ENV{'QUERY_STRING'},['uname','udom','usymb','ufn','mapid','resid']); 140: # 141: # Deal with restricted student permissions 142: # 143: if ($ENV{'request.role'} =~ /^st\./) { 144: delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'})); 145: delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'})); 146: } 147: # 148: # Look for special assessment spreadsheets - '_feedback', etc. 149: # 150: if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'} || 151: $ENV{'form.ufn'} eq '' || 152: $ENV{'form.ufn'} eq 'default')) { 153: $ENV{'form.ufn'}='default_'.$1; 154: } 155: if (!$ENV{'form.ufn'} || $ENV{'form.ufn'} eq 'default') { 156: $ENV{'form.ufn'}='course_default_'.$sheettype; 157: } 158: # 159: # Interactive loading of specific sheet? 160: # 161: if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { 162: $ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; 163: } 164: # 165: # Determine the user name and domain for the sheet. 166: my $aname; 167: my $adom; 168: unless ($ENV{'form.uname'}) { 169: $aname=$ENV{'user.name'}; 170: $adom=$ENV{'user.domain'}; 171: } else { 172: $aname=$ENV{'form.uname'}; 173: $adom=$ENV{'form.udom'}; 174: } 175: # 176: # Open page, try to prevent browser cache. 177: # 178: $r->content_type('text/html'); 179: $r->header_out('Cache-control','no-cache'); 180: $r->header_out('Pragma','no-cache'); 181: $r->send_http_header; 182: # 183: # Header.... 184: # 185: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>'); 186: my $nothing = "''"; 187: if ($ENV{'browser.type'} eq 'explorer') { 188: $nothing = "'javascript:void(0);'"; 189: } 190: 191: if ($ENV{'request.role'} !~ /^st\./) { 192: $r->print(<<ENDSCRIPT); 193: <script language="JavaScript"> 194: 195: var editwin; 196: 197: function celledit(cellname,cellformula) { 198: var edit_text = ''; 199: // cellformula may contain less-than and greater-than symbols, so 200: // we need to escape them? 201: edit_text +='<html><head><title>Cell Edit Window</title></head><body>'; 202: edit_text += '<form name="editwinform">'; 203: edit_text += '<center><h3>Cell '+cellname+'</h3>'; 204: edit_text += '<textarea name="newformula" cols="40" rows="6"'; 205: edit_text += ' wrap="off" >'+cellformula+'</textarea>'; 206: edit_text += '</br>'; 207: edit_text += '<input type="button" name="accept" value="Accept"'; 208: edit_text += ' onClick=\\\'javascript:'; 209: edit_text += 'opener.document.sheet.unewfield.value='; 210: edit_text += '"'+cellname+'";'; 211: edit_text += 'opener.document.sheet.unewformula.value='; 212: edit_text += 'document.editwinform.newformula.value;'; 213: edit_text += 'opener.document.sheet.submit();'; 214: edit_text += 'self.close()\\\' />'; 215: edit_text += '      '; 216: edit_text += '<input type="button" name="abort" '; 217: edit_text += 'value="Discard Changes"'; 218: edit_text += ' onClick="javascript:self.close()" />'; 219: edit_text += '</center></body></html>'; 220: 221: if (editwin != null && !(editwin.closed) ) { 222: editwin.close(); 223: } 224: 225: editwin = window.open($nothing,'CellEditWin','height=200,width=350,scrollbars=no,resizeable=yes,alwaysRaised=yes,dependent=yes',true); 226: editwin.document.write(edit_text); 227: } 228: 229: function changesheet(cn) { 230: document.sheet.unewfield.value=cn; 231: document.sheet.unewformula.value='changesheet'; 232: document.sheet.submit(); 233: } 234: 235: function insertrow(cn) { 236: document.sheet.unewfield.value='insertrow'; 237: document.sheet.unewformula.value=cn; 238: document.sheet.submit(); 239: } 240: 241: </script> 242: ENDSCRIPT 243: } 244: $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet'). 245: '<form action="'.$r->uri.'" name="sheet" method="post">'); 246: $r->print(&hiddenfield('uname',$ENV{'form.uname'}). 247: &hiddenfield('udom',$ENV{'form.udom'}). 248: &hiddenfield('usymb',$ENV{'form.usymb'}). 249: &hiddenfield('unewfield',''). 250: &hiddenfield('unewformula','')); 251: $r->rflush(); 252: # 253: # Full recalc? 254: # 255: # Read new sheet or modified worksheet 256: my $sheet=Apache::lonspreadsheet::Spreadsheet->new($aname,$adom,$sheettype,$ENV{'form.usymb'}); 257: if ($ENV{'form.forcerecalc'}) { 258: $r->print('<h4>Completely Recalculating Sheet ...</h4>'); 259: $sheet->complete_recalc(); 260: } 261: # 262: # Global directory configs 263: # 264: $sheet->includedir($r->dir_config('lonIncludes')); 265: $sheet->tmpdir($r->dir_config('lonDaemons').'/tmp/'); 266: # 267: # Check user permissions 268: if (($sheet->{'type'} eq 'classcalc' ) || 269: ($sheet->{'uname'} ne $ENV{'user.name'} ) || 270: ($sheet->{'udom'} ne $ENV{'user.domain'})) { 271: unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) { 272: $r->print('<h1>Access Permission Denied</h1>'. 273: '</form></body></html>'); 274: return OK; 275: } 276: } 277: # Print out user information 278: $r->print('<h2>'.$sheet->{'coursedesc'}.'</h2>'); 279: if ($sheet->{'type'} ne 'classcalc') { 280: $r->print('<h2>'.$sheet->gettitle().'</h2><p>'); 281: } 282: if ($sheet->{'type'} eq 'assesscalc') { 283: $r->print('<b>User:</b> '.$sheet->{'uname'}. 284: '<br /><b>Domain:</b> '.$sheet->{'udom'}.'<br />'); 285: } 286: if ($sheet->{'type'} eq 'studentcalc' || 287: $sheet->{'type'} eq 'assesscalc') { 288: $r->print('<b>Section/Group:</b>'.$sheet->{'csec'}.'</p>'); 289: } 290: # 291: # If a new formula had been entered, go from work copy 292: if ($ENV{'form.unewfield'}) { 293: $r->print('<h2>Modified Workcopy</h2>'); 294: #$ENV{'form.unewformula'}=~s/\'/\"/g; 295: $r->print('<p>Cell '.$ENV{'form.unewfield'}.' = <pre>'); 296: $r->print(&HTML::Entities::encode($ENV{'form.unewformula'}). 297: '</pre></p>'); 298: $sheet->{'filename'} = $ENV{'form.ufn'}; 299: $sheet->tmpread($ENV{'form.unewfield'},$ENV{'form.unewformula'}); 300: } elsif ($ENV{'form.saveas'}) { 301: $sheet->{'filename'} = $ENV{'form.ufn'}; 302: $sheet->tmpread(); 303: } else { 304: $sheet->readsheet($ENV{'form.ufn'}); 305: } 306: # Additional options 307: if ($sheet->{'type'} eq 'assesscalc') { 308: $r->print('<p><font size=+2>'. 309: '<a href="/adm/studentcalc?'. 310: 'uname='.$sheet->{'uname'}. 311: '&udom='.$sheet->{'udom'}.'">'. 312: 'Level up: Student Sheet</a></font></p>'); 313: } 314: if (($sheet->{'type'} eq 'studentcalc') && 315: (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) { 316: $r->print ('<p><font size=+2><a href="/adm/classcalc">'. 317: 'Level up: Course Sheet</a></font></p>'); 318: } 319: # Recalc button 320: $r->print('<br />'. 321: '<input type="submit" name="forcerecalc" '. 322: 'value="Completely Recalculate Sheet"></p>'); 323: # Save dialog 324: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 325: my $fname=$ENV{'form.ufn'}; 326: $fname=~s/\_[^\_]+$//; 327: if ($fname eq 'default') { $fname='course_default'; } 328: $r->print('<input type=submit name=saveas value="Save as ...">'. 329: '<input type=text size=20 name=newfn value="'.$fname.'">'. 330: 'make default: <input type=checkbox name="makedefufn"><p>'); 331: } 332: $r->print(&hiddenfield('ufn',$sheet->{'filename'})); 333: # Load dialog 334: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 335: $r->print('<p><input type=submit name=load value="Load ...">'. 336: '<select name="loadthissheet">'. 337: '<option name="default">Default</option>'); 338: foreach ($sheet->othersheets()) { 339: $r->print('<option name="'.$_.'"'); 340: if ($ENV{'form.ufn'} eq $_) { 341: $r->print(' selected'); 342: } 343: $r->print('>'.$_.'</option>'); 344: } 345: $r->print('</select><p>'); 346: if ($sheet->{'type'} eq 'studentcalc') { 347: $sheet->setothersheets($sheet->othersheets('assesscalc')); 348: } 349: } 350: # 351: # Set up caching mechanisms 352: # 353: &Apache::lonspreadsheet::Spreadsheet::load_spreadsheet_expirationdates(); 354: # Clear out old caches if we have not seen this class before. 355: if (exists($oldsheets{'course'}) && 356: $oldsheets{'course'} ne $sheet->{'cid'}) { 357: undef %oldsheets; 358: undef %loadedcaches; 359: } 360: $oldsheets{'course'} = $sheet->{'cid'}; 361: # 362: if ($sheet->{'type'} eq 'classcalc') { 363: $r->print("Loading previously calculated student sheets ...\n"); 364: $r->rflush(); 365: &Apache::lonspreadsheet::Spreadsheet::cachedcsheets(); 366: } elsif ($sheet->{'type'} eq 'studentcalc') { 367: $r->print("Loading previously calculated assessment sheets ...\n"); 368: $r->rflush(); 369: $sheet->cachedssheets(); 370: } 371: # Update sheet, load rows 372: $r->print("Loaded sheet(s), updating rows ...<br>\n"); 373: $r->rflush(); 374: # 375: $sheet->updatesheet(); 376: $r->print("Updated rows, loading row data ...\n"); 377: $r->rflush(); 378: # 379: $sheet->loadrows($r); 380: $r->print("Loaded row data, calculating sheet ...<br>\n"); 381: $r->rflush(); 382: # 383: my $calcoutput=$sheet->calcsheet(); 384: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); 385: # See if something to save 386: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 387: my $fname=''; 388: if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { 389: $fname=~s/\W/\_/g; 390: if ($fname eq 'default') { $fname='course_default'; } 391: $fname.='_'.$sheet->{'type'}; 392: $sheet->{'filename'} = $fname; 393: $ENV{'form.ufn'}=$fname; 394: $r->print('<p>Saving spreadsheet: '. 395: $sheet->writesheet($ENV{'form.makedefufn'}). 396: '<p>'); 397: } 398: } 399: # 400: # Write the modified worksheet 401: $r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'</p>'); 402: $sheet->tmpwrite(); 403: if ($sheet->{'type'} eq 'assesscalc') { 404: $r->print('<p>Show rows with empty A column: '); 405: } else { 406: $r->print('<p>Show empty rows: '); 407: } 408: # 409: $r->print(&hiddenfield('userselhidden','true'). 410: '<input type="checkbox" name="showall" onClick="submit()"'); 411: # 412: if ($ENV{'form.showall'}) { 413: $r->print(' checked'); 414: } else { 415: unless ($ENV{'form.userselhidden'}) { 416: unless 417: ($ENV{'course.'.$sheet->{'cid'}.'.hideemptyrows'} eq 'yes') { 418: $r->print(' checked'); 419: $ENV{'form.showall'}=1; 420: } 421: } 422: } 423: $r->print('>'); 424: # 425: # output format select box 426: $r->print(' Output as <select name="output" size="1" onChange="submit()">'. 427: "\n"); 428: foreach my $mode (qw/HTML CSV Excel/) { 429: $r->print('<option value="'.$mode.'"'); 430: if ($ENV{'form.output'} eq $mode) { 431: $r->print(' selected '); 432: } 433: $r->print('>'.$mode.'</option>'."\n"); 434: } 435: # 436: # Mulit-sheet excel takes too long and does not work at all for large 437: # classes. Future inclusion of this option may be possible with the 438: # Spreadsheet::WriteExcel::Big and speed improvements. 439: # 440: # if ($sheet->{'type'} eq 'classcalc') { 441: # $r->print('<option value="recursive excel"'); 442: # if ($ENV{'form.output'} eq 'recursive excel') { 443: # $r->print(' selected '); 444: # } 445: # $r->print(">Multi-Sheet Excel</option>\n"); 446: # } 447: $r->print("</select>\n"); 448: # 449: if ($sheet->{'type'} eq 'classcalc') { 450: $r->print(' Student Status: '. 451: &Apache::lonhtmlcommon::StatusOptions 452: ($ENV{'form.Status'},'sheet')); 453: } 454: # 455: # Buttons to insert rows 456: # $r->print(<<ENDINSERTBUTTONS); 457: #<br> 458: #<input type='button' onClick='insertrow("top");' 459: #value='Insert Row Top'> 460: #<input type='button' onClick='insertrow("bottom");' 461: #value='Insert Row Bottom'><br> 462: #ENDINSERTBUTTONS 463: # Print out sheet 464: $sheet->outsheet($r); 465: $r->print('</form></body></html>'); 466: # Done 467: return OK; 468: } 469: 470: 1; 471: 472: ############################################################# 473: ############################################################# 474: ############################################################# 475: 476: package Apache::lonspreadsheet::Spreadsheet; 477: 478: use strict; 479: use Apache::Constants qw(:common :http); 480: use Apache::lonnet; 481: use Apache::loncoursedata; 482: use Apache::File(); 483: use Safe; 484: use Safe::Hole; 485: use Opcode; 486: use GDBM_File; 487: use HTML::Entities(); 488: use HTML::TokeParser; 489: use Spreadsheet::WriteExcel; 490: # 491: # These global hashes are dependent on user, course and resource, 492: # and need to be initialized every time when a sheet is calculated 493: # 494: my %courseopt; 495: my %useropt; 496: my %parmhash; 497: 498: # 499: # Caches for coursewide information 500: # 501: my %Section; 502: 503: # 504: # Caches for previously calculated spreadsheets 505: # 506: my %expiredates; 507: 508: # 509: # Cache for stores of an individual user 510: # 511: my $cachedassess; 512: my %cachedstores; 513: 514: # 515: # Some hashes for stats on timing and performance 516: # 517: my %starttimes; 518: my %usedtimes; 519: my %numbertimes; 520: 521: # 522: # Directories 523: # 524: my $includedir; 525: my $tmpdir; 526: 527: sub includedir { 528: my $self = shift; 529: $includedir = shift; 530: } 531: 532: sub tmpdir { 533: my $self = shift; 534: $tmpdir = shift; 535: } 536: 537: my %spreadsheets; 538: my %loadedcaches; 539: my %courserdatas; 540: my %userrdatas; 541: my %defaultsheets; 542: my %rowlabel_cache; 543: my %oldsheets; 544: 545: sub complete_recalc { 546: my $self = shift; 547: undef %spreadsheets; 548: undef %courserdatas; 549: undef %userrdatas; 550: undef %defaultsheets; 551: undef %rowlabel_cache; 552: } 553: 554: sub get_sheet { 555: my $self = shift; 556: my $sheet_id = shift; 557: my $formulas; 558: # if we already have the file loaded and parsed, return the formulas 559: if (exists($self->{'sheets'}->{$sheet_id})) { 560: $formulas = $self->{'sheets'}->{$sheet_id}; 561: $self->debug('retrieved '.$sheet_id); 562: } else { 563: # load the file 564: # set $error and return undef if there is an error loading 565: # parse it 566: # set $error and return undef if there is an error parsing 567: } 568: return $formulas; 569: } 570: 571: # 572: # Load previously cached student spreadsheets for this course 573: # 574: sub load_spreadsheet_expirationdates { 575: undef %expiredates; 576: my $cid=$ENV{'request.course.id'}; 577: my @tmp = &Apache::lonnet::dump('nohist_expirationdates', 578: $ENV{'course.'.$cid.'.domain'}, 579: $ENV{'course.'.$cid.'.num'}); 580: if (lc($tmp[0]) !~ /^error/){ 581: %expiredates = @tmp; 582: } 583: } 584: 585: # ===================================================== Calculated sheets cache 586: # 587: # Load previously cached student spreadsheets for this course 588: # 589: sub cachedcsheets { 590: my $cid=$ENV{'request.course.id'}; 591: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets', 592: $ENV{'course.'.$cid.'.domain'}, 593: $ENV{'course.'.$cid.'.num'}); 594: if ($tmp[0] !~ /^error/) { 595: my %StupidTempHash = @tmp; 596: while (my ($key,$value) = each %StupidTempHash) { 597: $Apache::lonspreadsheet::oldsheets{$key} = $value; 598: } 599: } 600: } 601: 602: # 603: # Load previously cached assessment spreadsheets for this student 604: # 605: sub cachedssheets { 606: my $self = shift; 607: my ($uname,$udom) = @_; 608: $uname = $uname || $self->{'uname'}; 609: $udom = $udom || $self->{'udom'}; 610: if (! $Apache::lonspreadsheet::loadedcaches{$uname.'_'.$udom}) { 611: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. 612: $ENV{'request.course.id'}, 613: $self->{'udom'}, 614: $self->{'uname'}); 615: if ($tmp[0] !~ /^error/) { 616: my %TempHash = @tmp; 617: my $count = 0; 618: while (my ($key,$value) = each %TempHash) { 619: $Apache::lonspreadsheet::oldsheets{$key} = $value; 620: $count++; 621: } 622: $Apache::lonspreadsheet::loadedcaches{$self->{'uname'}.'_'.$self->{'udom'}}=1; 623: } 624: } 625: } 626: 627: # ======================================================= Forced recalculation? 628: sub checkthis { 629: my ($keyname,$time)=@_; 630: if (! exists($expiredates{$keyname})) { 631: return 0; 632: } else { 633: return ($time<$expiredates{$keyname}); 634: } 635: } 636: 637: sub forcedrecalc { 638: my ($uname,$udom,$stype,$usymb)=@_; 639: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; 640: my $time=$Apache::lonspreadsheet::oldsheets{$key.'.time'}; 641: if ($ENV{'form.forcerecalc'}) { return 1; } 642: unless ($time) { return 1; } 643: if ($stype eq 'assesscalc') { 644: my $map=(split(/___/,$usymb))[0]; 645: if (&checkthis('::assesscalc:',$time) || 646: &checkthis('::assesscalc:'.$map,$time) || 647: &checkthis('::assesscalc:'.$usymb,$time) || 648: &checkthis($uname.':'.$udom.':assesscalc:',$time) || 649: &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) || 650: &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) { 651: return 1; 652: } 653: } else { 654: if (&checkthis('::studentcalc:',$time) || 655: &checkthis($uname.':'.$udom.':studentcalc:',$time)) { 656: return 1; 657: } 658: } 659: return 0; 660: } 661: 662: 663: ################################################## 664: ################################################## 665: 666: =pod 667: 668: =item &parmval() 669: 670: Determine the value of a parameter. 671: 672: Inputs: $what, the parameter needed, $symb, $uname, $udom, $csec 673: 674: Returns: The value of a parameter, or '' if none. 675: 676: This function cascades through the possible levels searching for a value for 677: a parameter. The levels are checked in the following order: 678: user, course (at section level and course level), map, and lonnet::metadata. 679: This function uses %parmhash, which must be tied prior to calling it. 680: This function also requires %courseopt and %useropt to be initialized for 681: this user and course. 682: 683: =cut 684: 685: ################################################## 686: ################################################## 687: sub parmval { 688: my ($what,$symb,$uname,$udom,$csec)=@_; 689: return '' if (!$symb); 690: # 691: my $cid = $ENV{'request.course.id'}; 692: my $result=''; 693: # 694: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); 695: # Cascading lookup scheme 696: my $rwhat=$what; 697: $what =~ s/^parameter\_//; 698: $what =~ s/\_([^\_]+)$/\.$1/; 699: # 700: my $symbparm = $symb.'.'.$what; 701: my $mapparm = $mapname.'___(all).'.$what; 702: my $usercourseprefix = $uname.'_'.$udom.'_'.$cid; 703: # 704: my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; 705: my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; 706: my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; 707: # 708: my $courselevel = $usercourseprefix.'.'.$what; 709: my $courselevelr = $usercourseprefix.'.'.$symbparm; 710: my $courselevelm = $usercourseprefix.'.'.$mapparm; 711: # fourth, check user 712: if (defined($uname)) { 713: return $useropt{$courselevelr} if (defined($useropt{$courselevelr})); 714: return $useropt{$courselevelm} if (defined($useropt{$courselevelm})); 715: return $useropt{$courselevel} if (defined($useropt{$courselevel})); 716: } 717: # third, check course 718: if (defined($csec)) { 719: return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); 720: return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); 721: return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); 722: } 723: # 724: return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); 725: return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); 726: return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); 727: # second, check map parms 728: my $thisparm = $parmhash{$symbparm}; 729: return $thisparm if (defined($thisparm)); 730: # first, check default 731: return &Apache::lonnet::metadata($fn,$rwhat.'.default'); 732: } 733: 734: # 735: # new: Make a new spreadsheet 736: # 737: sub new { 738: my $this = shift; 739: my $class = ref($this) || $this; 740: # 741: my ($uname,$udom,$stype,$usymb)=@_; 742: # 743: my $self = { 744: uname => $uname, 745: udom => $udom, 746: type => $stype, 747: usymb => $usymb, 748: errorlog => '', 749: maxrow => '', 750: mapid => $ENV{'form.mapid'}, 751: resid => $ENV{'form.resid'}, 752: cid => $ENV{'request.course.id'}, 753: csec => $Section{$uname.':'.$udom}, 754: cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, 755: cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 756: chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'}, 757: coursefilename => $ENV{'request.course.fn'}, 758: coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, 759: A_column => [], 760: template_cells => [], 761: }; 762: $self->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom); 763: # 764: # 765: $self->{'formulas'} = {}; 766: $self->{'constants'} = {}; 767: $self->{'othersheets'} = []; 768: $self->{'rowlabel'} = {}; 769: # 770: # 771: $self->{'safe'} = &initsheet($self->{'type'}); 772: $self->{'root'} = $self->{'safe'}->root(); 773: # 774: # Place some of the %$self items into the safe space except the safe space 775: # itself 776: my $initstring = ''; 777: foreach (qw/uname udom type usymb cid csec coursefilename 778: cnum cdom chome uhome/) { 779: $initstring.= qq{\$$_="$self->{$_}";}; 780: } 781: $self->{'safe'}->reval($initstring); 782: bless($self,$class); 783: return $self; 784: } 785: 786: ## 787: ## mask - used to reside in the safe space. 788: ## 789: { 790: 791: my %memoizer; 792: 793: sub mask { 794: my ($lower,$upper)=@_; 795: my $key = $lower.'_'.$upper; 796: if (exists($memoizer{$key})) { 797: return $memoizer{$key}; 798: } 799: $upper = $lower if (! defined($upper)); 800: # 801: my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/); 802: my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/); 803: # 804: my $alpha=''; 805: my $num=''; 806: # 807: if (($la eq '*') || ($ua eq '*')) { 808: $alpha='[A-Za-z]'; 809: } else { 810: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || 811: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { 812: $alpha='['.$la.'-'.$ua.']'; 813: } else { 814: $alpha='['.$la.'-Za-'.$ua.']'; 815: } 816: } 817: if (($ld eq '*') || ($ud eq '*')) { 818: $num='\d+'; 819: } else { 820: if (length($ld)!=length($ud)) { 821: $num.='('; 822: foreach ($ld=~m/\d/g) { 823: $num.='['.$_.'-9]'; 824: } 825: if (length($ud)-length($ld)>1) { 826: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; 827: } 828: $num.='|'; 829: foreach ($ud=~m/\d/g) { 830: $num.='[0-'.$_.']'; 831: } 832: $num.=')'; 833: } else { 834: my @lda=($ld=~m/\d/g); 835: my @uda=($ud=~m/\d/g); 836: my $i; 837: my $j=0; 838: my $notdone=1; 839: for ($i=0;($i<=$#lda)&&($notdone);$i++) { 840: if ($lda[$i]==$uda[$i]) { 841: $num.=$lda[$i]; 842: $j=$i; 843: } else { 844: $notdone=0; 845: } 846: } 847: if ($j<$#lda-1) { 848: $num.='('.$lda[$j+1]; 849: for ($i=$j+2;$i<=$#lda;$i++) { 850: $num.='['.$lda[$i].'-9]'; 851: } 852: if ($uda[$j+1]-$lda[$j+1]>1) { 853: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'. 854: ($#lda-$j-1).'}'; 855: } 856: $num.='|'.$uda[$j+1]; 857: for ($i=$j+2;$i<=$#uda;$i++) { 858: $num.='[0-'.$uda[$i].']'; 859: } 860: $num.=')'; 861: } else { 862: if ($lda[-1]!=$uda[-1]) { 863: $num.='['.$lda[-1].'-'.$uda[-1].']'; 864: } 865: } 866: } 867: } 868: my $expression ='^'.$alpha.$num."\$"; 869: $memoizer{$key} = $expression; 870: return $expression; 871: } 872: 873: } 874: 875: sub add_hash_to_safe { 876: my $self = shift; 877: my $code = <<'END'; 878: #------------------------------------------------------- 879: 880: =item UWCALC(hashname,modules,units,date) 881: 882: returns the proportion of the module 883: weights not previously completed by the student. 884: 885: =over 4 886: 887: =item hashname 888: 889: name of the hash the module dates have been inserted into 890: 891: =item modules 892: 893: reference to a cell which contains a comma deliminated list of modules 894: covered by the assignment. 895: 896: =item units 897: 898: reference to a cell which contains a comma deliminated list of module 899: weights with respect to the assignment 900: 901: =item date 902: 903: reference to a cell which contains the date the assignment was completed. 904: 905: =back 906: 907: =cut 908: 909: #------------------------------------------------------- 910: sub UWCALC { 911: my ($hashname,$modules,$units,$date) = @_; 912: my @Modules = split(/,/,$modules); 913: my @Units = split(/,/,$units); 914: my $total_weight; 915: foreach (@Units) { 916: $total_weight += $_; 917: } 918: my $usum=0; 919: for (my $i=0; $i<=$#Modules; $i++) { 920: if (&HASH($hashname,$Modules[$i]) eq $date) { 921: $usum += $Units[$i]; 922: } 923: } 924: return $usum/$total_weight; 925: } 926: 927: #------------------------------------------------------- 928: 929: =item CDLSUM(list) 930: 931: returns the sum of the elements in a cell which contains 932: a Comma Deliminate List of numerical values. 933: 'list' is a reference to a cell which contains a comma deliminated list. 934: 935: =cut 936: 937: #------------------------------------------------------- 938: sub CDLSUM { 939: my ($list)=@_; 940: my $sum; 941: foreach (split/,/,$list) { 942: $sum += $_; 943: } 944: return $sum; 945: } 946: 947: #------------------------------------------------------- 948: 949: =item CDLITEM(list,index) 950: 951: returns the item at 'index' in a Comma Deliminated List. 952: 953: =over 4 954: 955: =item list 956: 957: reference to a cell which contains a comma deliminated list. 958: 959: =item index 960: 961: the Perl index of the item requested (first element in list has 962: an index of 0) 963: 964: =back 965: 966: =cut 967: 968: #------------------------------------------------------- 969: sub CDLITEM { 970: my ($list,$index)=@_; 971: my @Temp = split/,/,$list; 972: return $Temp[$index]; 973: } 974: 975: #------------------------------------------------------- 976: 977: =item CDLHASH(name,key,value) 978: 979: loads a comma deliminated list of keys into 980: the hash 'name', all with a value of 'value'. 981: 982: =over 4 983: 984: =item name 985: 986: name of the hash. 987: 988: =item key 989: 990: (a pointer to) a comma deliminated list of keys. 991: 992: =item value 993: 994: a single value to be entered for each key. 995: 996: =back 997: 998: =cut 999: 1000: #------------------------------------------------------- 1001: sub CDLHASH { 1002: my ($name,$key,$value)=@_; 1003: my @Keys; 1004: my @Values; 1005: # Check to see if we have multiple $key values 1006: if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 1007: my $keymask = &mask($key); 1008: # Assume the keys are addresses 1009: my @Temp = grep /$keymask/,keys(%sheet_values); 1010: @Keys = $sheet_values{@Temp}; 1011: } else { 1012: $Keys[0]= $key; 1013: } 1014: my @Temp; 1015: foreach $key (@Keys) { 1016: @Temp = (@Temp, split/,/,$key); 1017: } 1018: @Keys = @Temp; 1019: if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 1020: my $valmask = &mask($value); 1021: my @Temp = grep /$valmask/,keys(%sheet_values); 1022: @Values =$sheet_values{@Temp}; 1023: } else { 1024: $Values[0]= $value; 1025: } 1026: $value = $Values[0]; 1027: # Add values to hash 1028: for (my $i = 0; $i<=$#Keys; $i++) { 1029: my $key = $Keys[$i]; 1030: if (! exists ($hashes{$name}->{$key})) { 1031: $hashes{$name}->{$key}->[0]=$value; 1032: } else { 1033: my @Temp = sort(@{$hashes{$name}->{$key}},$value); 1034: $hashes{$name}->{$key} = \@Temp; 1035: } 1036: } 1037: return "hash '$name' updated"; 1038: } 1039: 1040: #------------------------------------------------------- 1041: 1042: =item GETHASH(name,key,index) 1043: 1044: returns the element in hash 'name' 1045: reference by the key 'key', at index 'index' in the values list. 1046: 1047: =cut 1048: 1049: #------------------------------------------------------- 1050: sub GETHASH { 1051: my ($name,$key,$index)=@_; 1052: if (! defined($index)) { 1053: $index = 0; 1054: } 1055: if ($key =~ /^[A-z]\d+$/) { 1056: $key = $sheet_values{$key}; 1057: } 1058: return $hashes{$name}->{$key}->[$index]; 1059: } 1060: 1061: #------------------------------------------------------- 1062: 1063: =item CLEARHASH(name) 1064: 1065: clears all the values from the hash 'name' 1066: 1067: =item CLEARHASH(name,key) 1068: 1069: clears all the values from the hash 'name' associated with the given key. 1070: 1071: =cut 1072: 1073: #------------------------------------------------------- 1074: sub CLEARHASH { 1075: my ($name,$key)=@_; 1076: if (defined($key)) { 1077: if (exists($hashes{$name}->{$key})) { 1078: $hashes{$name}->{$key}=undef; 1079: return "hash '$name' key '$key' cleared"; 1080: } 1081: } else { 1082: if (exists($hashes{$name})) { 1083: $hashes{$name}=undef; 1084: return "hash '$name' cleared"; 1085: } 1086: } 1087: return "Error in clearing hash"; 1088: } 1089: 1090: #------------------------------------------------------- 1091: 1092: =item HASH(name,key,value) 1093: 1094: loads values into an internal hash. If a key 1095: already has a value associated with it, the values are sorted numerically. 1096: 1097: =item HASH(name,key) 1098: 1099: returns the 0th value in the hash 'name' associated with 'key'. 1100: 1101: =cut 1102: 1103: #------------------------------------------------------- 1104: sub HASH { 1105: my ($name,$key,$value)=@_; 1106: my @Keys; 1107: undef @Keys; 1108: my @Values; 1109: # Check to see if we have multiple $key values 1110: if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 1111: my $keymask = &mask($key); 1112: # Assume the keys are addresses 1113: my @Temp = grep /$keymask/,keys(%sheet_values); 1114: @Keys = $sheet_values{@Temp}; 1115: } else { 1116: $Keys[0]= $key; 1117: } 1118: # If $value is empty, return the first value associated 1119: # with the first key. 1120: if (! $value) { 1121: return $hashes{$name}->{$Keys[0]}->[0]; 1122: } 1123: # Check to see if we have multiple $value(s) 1124: if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 1125: my $valmask = &mask($value); 1126: my @Temp = grep /$valmask/,keys(%sheet_values); 1127: @Values =$sheet_values{@Temp}; 1128: } else { 1129: $Values[0]= $value; 1130: } 1131: # Add values to hash 1132: for (my $i = 0; $i<=$#Keys; $i++) { 1133: my $key = $Keys[$i]; 1134: my $value = ($i<=$#Values ? $Values[$i] : $Values[0]); 1135: if (! exists ($hashes{$name}->{$key})) { 1136: $hashes{$name}->{$key}->[0]=$value; 1137: } else { 1138: my @Temp = sort(@{$hashes{$name}->{$key}},$value); 1139: $hashes{$name}->{$key} = \@Temp; 1140: } 1141: } 1142: return $Values[-1]; 1143: } 1144: END 1145: $self->{'safe'}->reval($code); 1146: return; 1147: } 1148: 1149: sub initsheet { 1150: my $safeeval = new Safe(shift); 1151: my $safehole = new Safe::Hole; 1152: $safeeval->permit("entereval"); 1153: $safeeval->permit(":base_math"); 1154: $safeeval->permit("sort"); 1155: $safeeval->deny(":base_io"); 1156: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 1157: $safehole->wrap(\&mask,$safeeval,'&mask'); 1158: $safeeval->share('$@'); 1159: my $code=<<'ENDDEFS'; 1160: # ---------------------------------------------------- Inside of the safe space 1161: # 1162: # f: formulas 1163: # t: intermediate format (variable references expanded) 1164: # v: output values 1165: # c: preloaded constants (A-column) 1166: # rl: row label 1167: # os: other spreadsheets (for student spreadsheet only) 1168: 1169: undef %sheet_values; # Holds the (computed, final) values for the sheet 1170: # This is only written to by &calc, the spreadsheet computation routine. 1171: # It is read by many functions 1172: undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, 1173: # which does the translation of strings like C5 into the value in C5. 1174: # Used in &calc - %t holds the values that are actually eval'd. 1175: undef %f; # Holds the formulas for each cell. This is the users 1176: # (spreadsheet authors) data for each cell. 1177: undef %c; # Holds the constants for a sheet. In the assessment 1178: # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, 1179: # &sett, and &constants. There is no &getconstants. 1180: # &constants is called by &loadstudent, &loadcourse, &load assessment, 1181: undef @os; # Holds the names of other spreadsheets - this is used to specify 1182: # the spreadsheets that are available for the assessment sheet. 1183: # Set by &setothersheets. &setothersheets is called by &handler. A 1184: # related subroutine is &othersheets. 1185: $errorlog = ''; 1186: 1187: $maxrow = 0; 1188: $type = ''; 1189: 1190: # filename/reference of the sheet 1191: $filename = ''; 1192: 1193: # user data 1194: $uname = ''; 1195: $uhome = ''; 1196: $udom = ''; 1197: 1198: # course data 1199: 1200: $csec = ''; 1201: $chome= ''; 1202: $cnum = ''; 1203: $cdom = ''; 1204: $cid = ''; 1205: $coursefilename = ''; 1206: 1207: # symb 1208: 1209: $usymb = ''; 1210: 1211: # error messages 1212: $errormsg = ''; 1213: 1214: #------------------------------------------------------- 1215: 1216: =item NUM(range) 1217: 1218: returns the number of items in the range. 1219: 1220: =cut 1221: 1222: #------------------------------------------------------- 1223: sub NUM { 1224: my $mask=&mask(@_); 1225: my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; 1226: return $num; 1227: } 1228: 1229: sub BIN { 1230: my ($low,$high,$lower,$upper)=@_; 1231: my $mask=&mask($lower,$upper); 1232: my $num=0; 1233: foreach (grep /$mask/,keys(%sheet_values)) { 1234: if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { 1235: $num++; 1236: } 1237: } 1238: return $num; 1239: } 1240: 1241: 1242: #------------------------------------------------------- 1243: 1244: =item SUM(range) 1245: 1246: returns the sum of items in the range. 1247: 1248: =cut 1249: 1250: #------------------------------------------------------- 1251: sub SUM { 1252: my $mask=&mask(@_); 1253: my $sum=0; 1254: foreach (grep /$mask/,keys(%sheet_values)) { 1255: $sum+=$sheet_values{$_}; 1256: } 1257: return $sum; 1258: } 1259: 1260: #------------------------------------------------------- 1261: 1262: =item MEAN(range) 1263: 1264: compute the average of the items in the range. 1265: 1266: =cut 1267: 1268: #------------------------------------------------------- 1269: sub MEAN { 1270: my $mask=&mask(@_); 1271: # $errorlog.='(mask = '.$mask.' )'; 1272: my $sum=0; 1273: my $num=0; 1274: foreach (grep /$mask/,keys(%sheet_values)) { 1275: $sum+=$sheet_values{$_}; 1276: $num++; 1277: } 1278: if ($num) { 1279: return $sum/$num; 1280: } else { 1281: return undef; 1282: } 1283: } 1284: 1285: #------------------------------------------------------- 1286: 1287: =item STDDEV(range) 1288: 1289: compute the standard deviation of the items in the range. 1290: 1291: =cut 1292: 1293: #------------------------------------------------------- 1294: sub STDDEV { 1295: my $mask=&mask(@_); 1296: # $errorlog.='(mask = '.$mask.' )'; 1297: my $sum=0; my $num=0; 1298: foreach (grep /$mask/,keys(%sheet_values)) { 1299: $sum+=$sheet_values{$_}; 1300: $num++; 1301: } 1302: unless ($num>1) { return undef; } 1303: my $mean=$sum/$num; 1304: $sum=0; 1305: foreach (grep /$mask/,keys(%sheet_values)) { 1306: $sum+=($sheet_values{$_}-$mean)**2; 1307: } 1308: return sqrt($sum/($num-1)); 1309: } 1310: 1311: #------------------------------------------------------- 1312: 1313: =item PROD(range) 1314: 1315: compute the product of the items in the range. 1316: 1317: =cut 1318: 1319: #------------------------------------------------------- 1320: sub PROD { 1321: my $mask=&mask(@_); 1322: my $prod=1; 1323: foreach (grep /$mask/,keys(%sheet_values)) { 1324: $prod*=$sheet_values{$_}; 1325: } 1326: return $prod; 1327: } 1328: 1329: #------------------------------------------------------- 1330: 1331: =item MAX(range) 1332: 1333: compute the maximum of the items in the range. 1334: 1335: =cut 1336: 1337: #------------------------------------------------------- 1338: sub MAX { 1339: my $mask=&mask(@_); 1340: my $max='-'; 1341: foreach (grep /$mask/,keys(%sheet_values)) { 1342: unless ($max) { $max=$sheet_values{$_}; } 1343: if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; } 1344: } 1345: return $max; 1346: } 1347: 1348: #------------------------------------------------------- 1349: 1350: =item MIN(range) 1351: 1352: compute the minimum of the items in the range. 1353: 1354: =cut 1355: 1356: #------------------------------------------------------- 1357: sub MIN { 1358: my $mask=&mask(@_); 1359: my $min='-'; 1360: foreach (grep /$mask/,keys(%sheet_values)) { 1361: unless ($max) { $max=$sheet_values{$_}; } 1362: if (($sheet_values{$_}<$min) || ($min eq '-')) { 1363: $min=$sheet_values{$_}; 1364: } 1365: } 1366: return $min; 1367: } 1368: 1369: #------------------------------------------------------- 1370: 1371: =item SUMMAX(num,lower,upper) 1372: 1373: compute the sum of the largest 'num' items in the range from 1374: 'lower' to 'upper' 1375: 1376: =cut 1377: 1378: #------------------------------------------------------- 1379: sub SUMMAX { 1380: my ($num,$lower,$upper)=@_; 1381: my $mask=&mask($lower,$upper); 1382: my @inside=(); 1383: foreach (grep /$mask/,keys(%sheet_values)) { 1384: push (@inside,$sheet_values{$_}); 1385: } 1386: @inside=sort(@inside); 1387: my $sum=0; my $i; 1388: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 1389: $sum+=$inside[$i]; 1390: } 1391: return $sum; 1392: } 1393: 1394: #------------------------------------------------------- 1395: 1396: =item SUMMIN(num,lower,upper) 1397: 1398: compute the sum of the smallest 'num' items in the range from 1399: 'lower' to 'upper' 1400: 1401: =cut 1402: 1403: #------------------------------------------------------- 1404: sub SUMMIN { 1405: my ($num,$lower,$upper)=@_; 1406: my $mask=&mask($lower,$upper); 1407: my @inside=(); 1408: foreach (grep /$mask/,keys(%sheet_values)) { 1409: $inside[$#inside+1]=$sheet_values{$_}; 1410: } 1411: @inside=sort(@inside); 1412: my $sum=0; my $i; 1413: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 1414: $sum+=$inside[$i]; 1415: } 1416: return $sum; 1417: } 1418: 1419: #------------------------------------------------------- 1420: 1421: =item MINPARM(parametername) 1422: 1423: Returns the minimum value of the parameters matching the parametername. 1424: parametername should be a string such as 'duedate'. 1425: 1426: =cut 1427: 1428: #------------------------------------------------------- 1429: sub MINPARM { 1430: my ($expression) = @_; 1431: my $min = undef; 1432: study($expression); 1433: foreach $parameter (keys(%c)) { 1434: next if ($parameter !~ /$expression/); 1435: if ((! defined($min)) || ($min > $c{$parameter})) { 1436: $min = $c{$parameter} 1437: } 1438: } 1439: return $min; 1440: } 1441: 1442: #------------------------------------------------------- 1443: 1444: =item MAXPARM(parametername) 1445: 1446: Returns the maximum value of the parameters matching the input parameter name. 1447: parametername should be a string such as 'duedate'. 1448: 1449: =cut 1450: 1451: #------------------------------------------------------- 1452: sub MAXPARM { 1453: my ($expression) = @_; 1454: my $max = undef; 1455: study($expression); 1456: foreach $parameter (keys(%c)) { 1457: next if ($parameter !~ /$expression/); 1458: if ((! defined($min)) || ($max < $c{$parameter})) { 1459: $max = $c{$parameter} 1460: } 1461: } 1462: return $max; 1463: } 1464: 1465: sub calc { 1466: # $errorlog .= "\%t has ".(keys(%t))." keys\n"; 1467: %sheet_values = %t; # copy %t into %sheet_values. 1468: # $errorlog .= "\%sheet_values has ".(keys(%sheet_values))." keys\n"; 1469: my $notfinished=1; 1470: my $lastcalc=''; 1471: my $depth=0; 1472: while ($notfinished) { 1473: $notfinished=0; 1474: while (my ($cell,$value) = each(%t)) { 1475: my $old=$sheet_values{$cell}; 1476: $sheet_values{$cell}=eval $value; 1477: if ($@) { 1478: undef %sheet_values; 1479: return $cell.': '.$@; 1480: } 1481: if ($sheet_values{$cell} ne $old) { 1482: $notfinished=1; 1483: $lastcalc=$cell; 1484: } 1485: } 1486: $depth++; 1487: if ($depth>100) { 1488: undef %sheet_values; 1489: return $lastcalc.': Maximum calculation depth exceeded'; 1490: } 1491: } 1492: return ''; 1493: } 1494: 1495: # ------------------------------------------- End of "Inside of the safe space" 1496: ENDDEFS 1497: $safeeval->reval($code); 1498: return $safeeval; 1499: } 1500: 1501: 1502: # 1503: # expandnamed used to reside in the safe space 1504: # 1505: sub expandnamed { 1506: my $self = shift; 1507: my $expression=shift; 1508: if ($expression=~/^\&/) { 1509: my ($func,$var,$formula)=($expression=~/^\&(\w+)$([^\;]+)\;(.*)$/); 1510: my @vars=split(/\W+/,$formula); 1511: my %values=(); 1512: foreach my $varname ( @vars ) { 1513: if ($varname=~/\D/) { 1514: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; 1515: $varname=~s/$var/$\\w\+$/g; 1516: foreach (keys(%{$self->{'constants'}})) { 1517: if ($_=~/$varname/) { 1518: $values{$1}=1; 1519: } 1520: } 1521: } 1522: } 1523: if ($func eq 'EXPANDSUM') { 1524: my $result=''; 1525: foreach (keys(%values)) { 1526: my $thissum=$formula; 1527: $thissum=~s/$var/$_/g; 1528: $result.=$thissum.'+'; 1529: } 1530: $result=~s/\+$//; 1531: return $result; 1532: } else { 1533: return 0; 1534: } 1535: } else { 1536: # it is not a function, so it is a parameter name 1537: # We should do the following: 1538: # 1. Take the list of parameter names 1539: # 2. look through the list for ones that match the parameter we want 1540: # 3. If there are no collisions, return the one that matches 1541: # 4. If there is a collision, return 'bad parameter name error' 1542: my $returnvalue = ''; 1543: my @matches = (); 1544: $#matches = -1; 1545: study $expression; 1546: my $parameter; 1547: foreach $parameter (keys(%{$self->{'constants'}})) { 1548: push @matches,$parameter if ($parameter =~ /$expression/); 1549: } 1550: if (scalar(@matches) == 0) { 1551: $returnvalue = 'unmatched parameter: '.$parameter; 1552: } elsif (scalar(@matches) == 1) { 1553: # why do we not do this lookup here, instead of delaying it? 1554: $returnvalue = '$c{\''.$matches[0].'\'}'; 1555: } elsif (scalar(@matches) > 0) { 1556: # more than one match. Look for a concise one 1557: $returnvalue = "'non-unique parameter name : $expression'"; 1558: foreach (@matches) { 1559: if (/^$expression$/) { 1560: # why do we not do this lookup here? 1561: $returnvalue = '$c{\''.$_.'\'}'; 1562: } 1563: } 1564: } else { 1565: # There was a negative number of matches, which indicates 1566: # something is wrong with reality. Better warn the user. 1567: $returnvalue = 'bizzare parameter: '.$parameter; 1568: } 1569: return $returnvalue; 1570: } 1571: } 1572: 1573: # 1574: # sett used to reside in the safe space 1575: # 1576: sub sett { 1577: my $self = shift; 1578: my %t=(); 1579: my $pattern=''; 1580: if ($self->{'type'} eq 'assesscalc') { 1581: $pattern='A'; 1582: } else { 1583: $pattern='[A-Z]'; 1584: } 1585: # Deal with the template row 1586: foreach ($self->template_cells()) { 1587: my ($col) = ($_=~/template\_(\w)/); 1588: next if ($col=~/^$pattern/); 1589: foreach ($self->A_column()) { 1590: my ($trow)=($_!~/A(\d+)/); 1591: next if (! $trow); 1592: # Get the name of this cell 1593: my $lb=$col.$trow; 1594: # Grab the template declaration 1595: $t{$lb}=$self->formula('template_'.$col); 1596: # Replace '#' with the row number 1597: $t{$lb}=~s/\#/$trow/g; 1598: # Replace '....' with ',' 1599: $t{$lb}=~s/\.\.+/\,/g; 1600: # Replace 'A0' with the value from 'A0' 1601: $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 1602: # Replace parameters 1603: $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 1604: } 1605: } 1606: # Deal with the normal cells 1607: foreach ($self->formulas_keys()) { 1608: next if ($_=~/template\_/); 1609: if (($_=~/^$pattern(\d+)/) && ($1)) { 1610: if ($self->formula($_) !~ /^\!/) { 1611: $t{$_}=$self->{'constants'}->{$_}; 1612: } 1613: } else { 1614: $t{$_}=$self->formula($_); 1615: $t{$_}=~s/\.\.+/\,/g; 1616: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 1617: $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 1618: } 1619: } 1620: # For inserted lines, [B-Z] is also valid 1621: if ($self->{'type'} ne 'assesscalc') { 1622: foreach ($self->formulas_keys()) { 1623: next if ($_ !~ /[B-Z](\d+)/); 1624: next if ($self->formula('A'.$1) !~ /^[\~\-]/); 1625: $t{$_}=$self->formula($_); 1626: $t{$_}=~s/\.\.+/\,/g; 1627: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 1628: $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 1629: } 1630: } 1631: # For some reason 'A0' gets special treatment... This seems superfluous 1632: # but I imagine it is here for a reason. 1633: $t{'A0'}=$self->formula('A0'); 1634: $t{'A0'}=~s/\.\.+/\,/g; 1635: $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 1636: $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 1637: # Put %t into the safe space 1638: %{$self->{'safe'}->varglob('t')}=%t; 1639: } 1640: 1641: 1642: ########################################### 1643: ### Row output routines ### 1644: ########################################### 1645: # 1646: # get_row: Produce output row n from sheet by calling the appropriate routine 1647: # 1648: sub get_row { 1649: my $self = shift; 1650: my ($n) = @_; 1651: my ($rowlabel,@rowdata); 1652: if ($n eq '-') { 1653: ($rowlabel,@rowdata) = $self->templaterow(); 1654: } elsif ($self->{'type'} eq 'studentcalc') { 1655: ($rowlabel,@rowdata) = $self->outrowassess($n); 1656: } else { 1657: ($rowlabel,@rowdata) = $self->outrow($n); 1658: } 1659: return ($rowlabel,@rowdata); 1660: } 1661: 1662: sub templaterow { 1663: my $self = shift; 1664: my @cols=(); 1665: my $rowlabel = 'Template</td><td> '; 1666: foreach my $n ('A','B','C','D','E','F','G','H','I','J','K','L','M', 1667: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 1668: 'a','b','c','d','e','f','g','h','i','j','k','l','m', 1669: 'n','o','p','q','r','s','t','u','v','w','x','y','z') { 1670: push(@cols,{ name => 'template_'.$_, 1671: formula => $self->formula('template_'.$n), 1672: value => $self->value('template_'.$n) }); 1673: } 1674: return ($rowlabel,@cols); 1675: } 1676: 1677: sub outrowassess { 1678: my $self = shift; 1679: # $n is the current row number 1680: my ($n) = @_; 1681: my @cols=(); 1682: my $rowlabel=''; 1683: if ($n) { 1684: my ($usy,$ufn)=split(/__&&&\__/,$self->formula('A'.$n)); 1685: if (exists($self->{'rowlabel'}->{$usy})) { 1686: # This is dumb, but we need the information when we output 1687: # the html version of the studentcalc spreadsheet for the 1688: # links to the assesscalc sheets. 1689: $rowlabel = $self->{'rowlabel'}->{$usy}.':'. 1690: &Apache::lonnet::escape($ufn); 1691: } else { 1692: $rowlabel = ''; 1693: } 1694: } elsif ($ENV{'request.role'} =~ /^st\./) { 1695: $rowlabel = 'Summary</td><td>0'; 1696: } else { 1697: $rowlabel = 'Export</td><td>0'; 1698: } 1699: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 1700: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 1701: 'a','b','c','d','e','f','g','h','i','j','k','l','m', 1702: 'n','o','p','q','r','s','t','u','v','w','x','y','z') { 1703: push(@cols,{ name => $_.$n, 1704: formula => $self->formula($_.$n), 1705: value => $self->value($_.$n)}); 1706: } 1707: return ($rowlabel,@cols); 1708: } 1709: 1710: sub outrow { 1711: my $self = shift; 1712: my ($n)=@_; 1713: my @cols=(); 1714: my $rowlabel; 1715: if ($n) { 1716: $rowlabel = $self->{'rowlabel'}->{$self->formula('A'.$n)}; 1717: } else { 1718: if ($self->{'type'} eq 'classcalc') { 1719: $rowlabel = 'Summary</td><td>0'; 1720: } else { 1721: $rowlabel = 'Export</td><td>0'; 1722: } 1723: } 1724: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 1725: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 1726: 'a','b','c','d','e','f','g','h','i','j','k','l','m', 1727: 'n','o','p','q','r','s','t','u','v','w','x','y','z') { 1728: push(@cols,{ name => $_.$n, 1729: formula => $self->formula($_.$n), 1730: value => $self->value($_.$n)}); 1731: } 1732: return ($rowlabel,@cols); 1733: } 1734: 1735: ######################################################## 1736: #### Spreadsheet calculation methods ##### 1737: ######################################################## 1738: # 1739: # calcsheet: makes all the calls to compute the spreadsheet. 1740: # 1741: sub calcsheet { 1742: my $self = shift; 1743: $self->sync_safe_space(); 1744: $self->clear_errorlog(); 1745: $self->sett(); 1746: my $result = $self->{'safe'}->reval('&calc();'); 1747: %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')}; 1748: # $self->logthis($self->get_errorlog()); 1749: # $self->logthis('number of values = '.(keys(%{$self->{'values'}}))); 1750: return $result; 1751: } 1752: 1753: ## 1754: ## sync_safe_space: Called by calcsheet to make sure all the data we 1755: # need to calculate is placed into the safe space 1756: ## 1757: sub sync_safe_space { 1758: my $self = shift; 1759: # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'. 1760: %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}}; 1761: # 'constants' leads a peaceful hidden life of 'c'. 1762: %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}}; 1763: # 'othersheets' hides as 'os', a disguise few can penetrate. 1764: @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}}; 1765: } 1766: 1767: ## 1768: ## Retrieve the error log from the safe space (used for debugging) 1769: ## 1770: sub get_errorlog { 1771: my $self = shift; 1772: $self->{'errorlog'} = ${$self->{'safe'}->varglob('errorlog')}; 1773: return $self->{'errorlog'}; 1774: } 1775: 1776: ## 1777: ## Clear the error log inside the safe space 1778: ## 1779: sub clear_errorlog { 1780: my $self = shift; 1781: ${$self->{'safe'}->varglob('errorlog')} = ''; 1782: $self->{'errorlog'} = ''; 1783: } 1784: 1785: 1786: ######################################################## 1787: #### Spreadsheet content retrieval/setting methods ##### 1788: ######################################################## 1789: ## 1790: ## contents: either set or get the constants. Cannot do both. It is just too 1791: ## clunky to swing around big hashes when we may not need to. 1792: ## 1793: sub constants { 1794: my $self=shift; 1795: my ($constants) = @_; 1796: if (defined($constants)) { 1797: if (! ref($constants)) { 1798: my %tmp = @_; 1799: $constants = \%tmp; 1800: } 1801: $self->{'constants'} = $constants; 1802: return; 1803: } else { 1804: return %{$self->{'constants'}}; 1805: } 1806: } 1807: 1808: ## 1809: ## formulas: either set or get the formulas. Cannot do both. It is just too 1810: ## clunky to swing around big hashes when we may not need to. 1811: sub formulas { 1812: my $self=shift; 1813: my ($formulas) = @_; 1814: if (defined($formulas)) { 1815: if (! ref($formulas)) { 1816: my %tmp = @_; 1817: $formulas = \%tmp; 1818: } 1819: $self->{'formulas'} = $formulas; 1820: $self->{'A_column'} = []; 1821: $self->{'template_cells'} = []; 1822: return; 1823: } else { 1824: return %{$self->{'formulas'}}; 1825: } 1826: } 1827: 1828: ## 1829: ## formulas_keys: Return the keys to the formulas hash. 1830: ## 1831: sub formulas_keys { 1832: my $self = shift; 1833: my @keys = keys(%{$self->{'formulas'}}); 1834: # $self->logthis('formulas keys has '.@keys.' elements'); 1835: return keys(%{$self->{'formulas'}}); 1836: } 1837: 1838: ## 1839: ## formula: Return the formula for a given cell in the spreadsheet 1840: ## returns '' if the cell does not have a formula or does not exist 1841: ## 1842: sub formula { 1843: my $self = shift; 1844: my $cell = shift; 1845: if (defined($cell) && exists($self->{'formulas'}->{$cell})) { 1846: return $self->{'formulas'}->{$cell}; 1847: } 1848: return ''; 1849: } 1850: 1851: ## 1852: ## logthis: write the input to lonnet.log 1853: ## 1854: sub logthis { 1855: my $self = shift; 1856: my $message = shift; 1857: &Apache::lonnet::logthis($self->{'type'}.':'. 1858: $self->{'uname'}.':'.$self->{'udom'}.':'. 1859: $message); 1860: } 1861: 1862: ## 1863: ## dump_formulas_to_log: makes lonnet.log huge... 1864: ## 1865: sub dump_formulas_to_log { 1866: my $self =shift; 1867: $self->logthis("Spreadsheet formulas"); 1868: $self->logthis("--------------------------------------------------------"); 1869: while (my ($cell, $formula) = each(%{$self->{'formulas'}})) { 1870: $self->logthis(' '.$cell.' = '.$formula); 1871: } 1872: $self->logthis("--------------------------------------------------------");} 1873: 1874: ## 1875: ## value: returns the computed value of a particular cell 1876: ## 1877: sub value { 1878: my $self = shift; 1879: my $cell = shift; 1880: if (defined($cell) && exists($self->{'values'}->{$cell})) { 1881: return $self->{'values'}->{$cell}; 1882: } 1883: return ''; 1884: } 1885: 1886: ## 1887: ## dump_values_to_log: makes lonnet.log huge... 1888: ## 1889: sub dump_values_to_log { 1890: my $self =shift; 1891: $self->logthis("Spreadsheet Values"); 1892: $self->logthis("--------------------------------------------------------"); 1893: while (my ($cell, $value) = each(%{$self->{'values'}})) { 1894: $self->logthis(' '.$cell.' = '.$value); 1895: } 1896: $self->logthis("--------------------------------------------------------");} 1897: 1898: ################################ 1899: ## Helper functions ## 1900: ################################ 1901: ## 1902: ## rebuild_stats: rebuilds the A_column and template_cells arrays 1903: ## 1904: sub rebuild_stats { 1905: my $self = shift; 1906: $self->{'A_column'}=[]; 1907: $self->{'template_cells'}=[]; 1908: foreach my $cell($self->formulas_keys()) { 1909: push(@{$self->{'A_column'}},$cell) if $cell =~ /^A\d+/; 1910: push(@{$self->{'template_cells'}},$cell) if ($cell =~ /^template_/); 1911: } 1912: # $self->logthis('rebuilt A_column '.@{$self->{'A_column'}}); 1913: # $self->logthis('rebuilt tempate_cells '.@{$self->{'template_cells'}}); 1914: return; 1915: } 1916: 1917: ## 1918: ## template_cells returns a list of the cells defined in the template row 1919: ## 1920: sub template_cells { 1921: my $self = shift; 1922: $self->rebuild_stats() if (!@{$self->{'template_cells'}}); 1923: return @{$self->{'template_cells'}}; 1924: } 1925: 1926: ## 1927: ## A_column returns a list of the names of cells defined in the A column 1928: ## 1929: sub A_column { 1930: my $self = shift; 1931: $self->rebuild_stats() if (!@{$self->{'A_column'}}); 1932: return @{$self->{'A_column'}}; 1933: } 1934: 1935: ## 1936: ## Sigh.... 1937: ## 1938: sub setothersheets { 1939: my $self = shift; 1940: my @othersheets = @_; 1941: $self->{'othersheets'} = \@othersheets; 1942: } 1943: 1944: ## 1945: ## rowlabels: get or set the rowlabels hash from the spreadsheet. 1946: ## 1947: sub rowlabels { 1948: my $self = shift; 1949: my ($rowlabel) = @_; 1950: if (defined($rowlabel)) { 1951: if (! ref($rowlabel)) { 1952: my %tmp = @_; 1953: $rowlabel = \%tmp; 1954: } 1955: $self->{'rowlabel'}=$rowlabel; 1956: return; 1957: } else { 1958: return %{$self->{'rowlabel'}} if (defined($self->{'rowlabels'})); 1959: } 1960: } 1961: 1962: ## 1963: ## gettitle: returns a title for the spreadsheet. 1964: ## 1965: sub gettitle { 1966: my $self = shift; 1967: if ($self->{'type'} eq 'classcalc') { 1968: return $self->{'coursedesc'}; 1969: } elsif ($self->{'type'} eq 'studentcalc') { 1970: return 'Grades for '.$self->{'uname'}.'@'.$self->{'udom'}; 1971: } elsif ($self->{'type'} eq 'assesscalc') { 1972: if (($self->{'usymb'} eq '_feedback') || 1973: ($self->{'usymb'} eq '_evaluation') || 1974: ($self->{'usymb'} eq '_discussion') || 1975: ($self->{'usymb'} eq '_tutoring')) { 1976: my $title = $self->{'usymb'}; 1977: $title =~ s/^_//; 1978: $title = ucfirst($title); 1979: return $title; 1980: } 1981: return if (! defined($self->{'mapid'}) || 1982: $self->{'mapid'} !~ /^\d+$/); 1983: my $mapid = $self->{'mapid'}; 1984: return if (! defined($self->{'resid'}) || 1985: $self->{'resid'} !~ /^\d+$/); 1986: my $resid = $self->{'resid'}; 1987: my %course_db; 1988: tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db', 1989: &GDBM_READER(),0640); 1990: return if (! tied(%course_db)); 1991: my $key = 'title_'.$mapid.'.'.$resid; 1992: my $title = ''; 1993: if (exists($course_db{$key})) { 1994: $title = $course_db{$key}; 1995: } else { 1996: $title = $self->{'usymb'}; 1997: } 1998: untie (%course_db); 1999: return $title; 2000: } 2001: } 2002: 2003: # 2004: # Export of A-row 2005: # 2006: sub exportdata { 2007: my $self=shift; 2008: my @exportarray=(); 2009: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 2010: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 2011: push(@exportarray,$self->value($_.'0')); 2012: } 2013: return @exportarray; 2014: } 2015: 2016: ## 2017: ## update_student_sheet: experimental function 2018: ## 2019: sub update_student_sheet{ 2020: my $self = shift; 2021: my ($r,$c) = @_; 2022: # Load in the studentcalc sheet 2023: $self->readsheet('default_studentcalc'); 2024: # Determine the structure (contained assessments, etc) of the sheet 2025: $self->updatesheet(); 2026: # Load in the cached sheets for this student 2027: $self->cachedssheets(); 2028: # Load in the (possibly cached) data from the assessment sheets 2029: $self->loadstudent($r,$c); 2030: # Compute the sheet 2031: $self->calcsheet(); 2032: } 2033: 2034: # 2035: # sort_indicies: returns an ordered list of the rows of the spreadsheet 2036: # 2037: sub sort_indicies { 2038: my $self = shift; 2039: my @sortidx=(); 2040: # 2041: if ($self->{'type'} eq 'classcalc') { 2042: my @sortby=(undef); 2043: # Skip row 0 2044: for (my $row=1;$row<=$self->{'maxrow'};$row++) { 2045: my (undef,$sname,$sdom,$fullname,$section,$id) = 2046: split(':',$self->{'rowlabel'}->{$self->formula('A'.$row)}); 2047: push (@sortby, lc($fullname)); 2048: push (@sortidx, $row); 2049: } 2050: @sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx; 2051: } elsif ($self->{'type'} eq 'studentcalc') { 2052: my @sortby1=(undef); 2053: my @sortby2=(undef); 2054: # Skip row 0 2055: for (my $row=1;$row<=$self->{'maxrow'};$row++) { 2056: my ($key,undef) = split(/__&&&\__/,$self->formula('A'.$row)); 2057: my $rowlabel = $self->{'rowlabel'}->{$key}; 2058: my (undef,$symb,$mapid,$resid,$title,$ufn) = 2059: split(':',$rowlabel); 2060: $ufn = &Apache::lonnet::unescape($ufn); 2061: $symb = &Apache::lonnet::unescape($symb); 2062: $title = &Apache::lonnet::unescape($title); 2063: my ($sequence) = ($symb =~ /\/([^\/]*\.sequence)/); 2064: if ($sequence eq '') { 2065: $sequence = $symb; 2066: } 2067: push (@sortby1, $sequence); 2068: push (@sortby2, $title); 2069: push (@sortidx, $row); 2070: } 2071: @sortidx = sort { $sortby1[$a] cmp $sortby1[$b] || 2072: $sortby2[$a] cmp $sortby2[$b] } @sortidx; 2073: } else { 2074: my @sortby=(undef); 2075: # Skip row 0 2076: $self->sync_safe_space(); 2077: for (my $row=1;$row<=$self->{'maxrow'};$row++) { 2078: push (@sortby, $self->{'safe'}->reval('$f{"A'.$row.'"}')); 2079: push (@sortidx, $row); 2080: } 2081: @sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx; 2082: } 2083: return @sortidx; 2084: } 2085: 2086: ############################################################# 2087: ### ### 2088: ### Spreadsheet Output Routines ### 2089: ### ### 2090: ############################################################# 2091: 2092: ############################################ 2093: ## HTML output routines ## 2094: ############################################ 2095: sub html_editable_cell { 2096: my ($cell,$bgcolor) = @_; 2097: my $result; 2098: my ($name,$formula,$value); 2099: if (defined($cell)) { 2100: $name = $cell->{'name'}; 2101: $formula = $cell->{'formula'}; 2102: $value = $cell->{'value'}; 2103: } 2104: $name = '' if (! defined($name)); 2105: $formula = '' if (! defined($formula)); 2106: if (! defined($value)) { 2107: $value = '<font color="'.$bgcolor.'">#</font>'; 2108: if ($formula ne '') { 2109: $value = '<i>undefined value</i>'; 2110: } 2111: } elsif ($value =~ /^\s*$/ ) { 2112: $value = '<font color="'.$bgcolor.'">#</font>'; 2113: } else { 2114: $value = &HTML::Entities::encode($value) if ($value !~/ /); 2115: } 2116: # Make the formula safe for outputting 2117: $formula =~ s/\'/\"/g; 2118: # The formula will be parsed by the browser *twice* before being 2119: # displayed to the user for editing. 2120: $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula)); 2121: # Escape newlines so they make it into the edit window 2122: $formula =~ s/\n/\\n/gs; 2123: # Glue everything together 2124: $result .= "<a href=\"javascript:celledit(\'". 2125: $name."','".$formula."');\">".$value."</a>"; 2126: return $result; 2127: } 2128: 2129: sub html_uneditable_cell { 2130: my ($cell,$bgcolor) = @_; 2131: my $value = (defined($cell) ? $cell->{'value'} : ''); 2132: $value = &HTML::Entities::encode($value) if ($value !~/ /); 2133: return ' '.$value.' '; 2134: } 2135: 2136: sub outsheet_html { 2137: my $self = shift; 2138: my ($r) = @_; 2139: my ($num_uneditable,$realm,$row_type); 2140: my $requester_is_student = ($ENV{'request.role'} =~ /^st\./); 2141: if ($self->{'type'} eq 'assesscalc') { 2142: $num_uneditable = 1; 2143: $realm = 'Assessment'; 2144: $row_type = 'Item'; 2145: } elsif ($self->{'type'} eq 'studentcalc') { 2146: $num_uneditable = 26; 2147: $realm = 'User'; 2148: $row_type = 'Assessment'; 2149: } elsif ($self->{'type'} eq 'classcalc') { 2150: $num_uneditable = 26; 2151: $realm = 'Course'; 2152: $row_type = 'Student'; 2153: } else { 2154: return; # error 2155: } 2156: #################################### 2157: # Print out header table 2158: #################################### 2159: my $num_left = 52-$num_uneditable; 2160: my $tabledata =<<"END"; 2161: <table border="2"> 2162: <tr> 2163: <th colspan="2" rowspan="2"><font size="+2">$realm</font></th> 2164: <td bgcolor="#FFDDDD" colspan="$num_uneditable"> 2165: <b><font size="+1">Import</font></b></td> 2166: <td colspan="$num_left"> 2167: <b><font size="+1">Calculations</font></b></td> 2168: </tr><tr> 2169: END 2170: my $label_num = 0; 2171: foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ 2172: if ($label_num<$num_uneditable) { 2173: $tabledata.='<td bgcolor="#FFDDDD">'; 2174: } else { 2175: $tabledata.='<td>'; 2176: } 2177: $tabledata.="<b><font size=+1>$_</font></b></td>"; 2178: $label_num++; 2179: } 2180: $tabledata.="</tr>\n"; 2181: $r->print($tabledata); 2182: #################################### 2183: # Print out template row 2184: #################################### 2185: my ($num_cols_output,$row_html,$rowlabel,@rowdata); 2186: 2187: if (! $requester_is_student) { 2188: ($rowlabel,@rowdata) = $self->get_row('-'); 2189: $row_html = '<tr><td>'.$self->format_html_rowlabel($rowlabel).'</td>'; 2190: $num_cols_output = 0; 2191: foreach my $cell (@rowdata) { 2192: if ($requester_is_student || 2193: $num_cols_output++ < $num_uneditable) { 2194: $row_html .= '<td bgcolor="#FFDDDD">'; 2195: $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); 2196: } else { 2197: $row_html .= '<td bgcolor="#EOFFDD">'; 2198: $row_html .= &html_editable_cell($cell,'#E0FFDD'); 2199: } 2200: $row_html .= '</td>'; 2201: } 2202: $row_html.= "</tr>\n"; 2203: $r->print($row_html); 2204: } 2205: #################################### 2206: # Print out summary/export row 2207: #################################### 2208: ($rowlabel,@rowdata) = $self->get_row('0'); 2209: $row_html = '<tr><td>'.$self->format_html_rowlabel($rowlabel).'</td>'; 2210: $num_cols_output = 0; 2211: foreach my $cell (@rowdata) { 2212: if ($num_cols_output++ < 26 && ! $requester_is_student) { 2213: $row_html .= '<td bgcolor="#CCCCFF">'; 2214: $row_html .= &html_editable_cell($cell,'#CCCCFF'); 2215: } else { 2216: $row_html .= '<td bgcolor="#DDCCFF">'; 2217: $row_html .= &html_uneditable_cell($cell,'#CCCCFF'); 2218: } 2219: $row_html .= '</td>'; 2220: } 2221: $row_html.= "</tr>\n"; 2222: $r->print($row_html); 2223: $r->print('</table>'); 2224: #################################### 2225: # Prepare to output rows 2226: #################################### 2227: my @Rows = $self->sort_indicies(); 2228: # 2229: # Loop through the rows and output them one at a time 2230: my $rows_output=0; 2231: foreach my $rownum (@Rows) { 2232: my ($rowlabel,@rowdata) = $self->get_row($rownum); 2233: next if ($rowlabel =~ /^\s*$/); 2234: next if (($self->{'type'} eq 'assesscalc') && 2235: (! $ENV{'form.showall'}) && 2236: ($rowdata[0]->{'value'} =~ /^\s*$/)); 2237: if (! $ENV{'form.showall'} && 2238: $self->{'type'} =~ /^(studentcalc|classcalc)$/) { 2239: my $row_is_empty = 1; 2240: foreach my $cell (@rowdata) { 2241: if ($cell->{'value'} !~ /^\s*$/) { 2242: $row_is_empty = 0; 2243: last; 2244: } 2245: } 2246: next if ($row_is_empty); 2247: } 2248: # 2249: my $defaultbg='#E0FF'; 2250: # 2251: my $row_html ="\n".'<tr><td><b><font size=+1>'.$rownum. 2252: '</font></b></td>'; 2253: # 2254: if ($self->{'type'} eq 'classcalc') { 2255: $row_html.='<td>'.$self->format_html_rowlabel($rowlabel).'</td>'; 2256: # Output links for each student? 2257: # Nope, that is already done for us in format_html_rowlabel 2258: # (for now) 2259: } elsif ($self->{'type'} eq 'studentcalc') { 2260: my $ufn = (split(/:/,$rowlabel))[5]; 2261: $row_html.='<td>'.$self->format_html_rowlabel($rowlabel); 2262: $row_html.= '<br>'. 2263: '<select name="sel_'.$rownum.'" '. 2264: 'onChange="changesheet('.$rownum.')">'. 2265: '<option name="default">Default</option>'; 2266: foreach (@{$self->{'othersheets'}}) { 2267: $row_html.='<option name="'.$_.'"'; 2268: if ($ufn eq $_) { 2269: $row_html.=' selected'; 2270: } 2271: $row_html.='>'.$_.'</option>'; 2272: } 2273: $row_html.='</select></td>'; 2274: } elsif ($self->{'type'} eq 'assesscalc') { 2275: $row_html.='<td>'.$self->format_html_rowlabel($rowlabel).'</td>'; 2276: } 2277: # 2278: my $shown_cells = 0; 2279: foreach my $cell (@rowdata) { 2280: my $value = $cell->{'value'}; 2281: my $formula = $cell->{'formula'}; 2282: my $cellname = $cell->{'name'}; 2283: # 2284: my $bgcolor; 2285: if ($shown_cells && ($shown_cells/5 == int($shown_cells/5))) { 2286: $bgcolor = $defaultbg.'99'; 2287: } else { 2288: $bgcolor = $defaultbg.'DD'; 2289: } 2290: $bgcolor='#FFDDDD' if ($shown_cells < $num_uneditable); 2291: # 2292: $row_html.='<td bgcolor='.$bgcolor.'>'; 2293: if ($requester_is_student || $shown_cells < $num_uneditable) { 2294: $row_html .= &html_uneditable_cell($cell,$bgcolor); 2295: } else { 2296: $row_html .= &html_editable_cell($cell,$bgcolor); 2297: } 2298: $row_html.='</td>'; 2299: $shown_cells++; 2300: } 2301: if ($row_html) { 2302: if ($rows_output % 25 == 0) { 2303: $r->print("</table>\n<br>\n"); 2304: $r->rflush(); 2305: $r->print('<table border=2>'. 2306: '<tr><td> <td>'.$row_type.'</td>'. 2307: '<td>'. 2308: join('</td><td>', 2309: (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. 2310: 'abcdefghijklmnopqrstuvwxyz'))). 2311: "</td></tr>\n"); 2312: } 2313: $rows_output++; 2314: $r->print($row_html); 2315: } 2316: } 2317: # 2318: $r->print('</table>'); 2319: # 2320: # Debugging code (be sure to uncomment errorlog code in safe space): 2321: # 2322: # $r->print("\n<pre>"); 2323: # $r->print(&geterrorlog($self)); 2324: # $r->print("\n</pre>"); 2325: return 1; 2326: } 2327: 2328: ############################################ 2329: ## csv output routines ## 2330: ############################################ 2331: sub outsheet_csv { 2332: my $self = shift; 2333: my ($r) = @_; 2334: my $csvdata = ''; 2335: my @Values; 2336: #################################### 2337: # Prepare to output rows 2338: #################################### 2339: my @Rows = $self->sort_indicies(); 2340: # 2341: # Loop through the rows and output them one at a time 2342: my $rows_output=0; 2343: foreach my $rownum (@Rows) { 2344: my ($rowlabel,@rowdata) = $self->get_row($rownum); 2345: next if ($rowlabel =~ /^\s*$/); 2346: push (@Values,$self->format_csv_rowlabel($rowlabel)); 2347: foreach my $cell (@rowdata) { 2348: push (@Values,'"'.$cell->{'value'}.'"'); 2349: } 2350: $csvdata.= join(',',@Values)."\n"; 2351: @Values = (); 2352: } 2353: # 2354: # Write the CSV data to a file and serve up a link 2355: # 2356: my $filename = '/prtspool/'. 2357: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. 2358: time.'_'.rand(1000000000).'.csv'; 2359: my $file; 2360: unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) { 2361: $r->log_error("Couldn't open $filename for output $!"); 2362: $r->print("Problems occured in writing the csv file. ". 2363: "This error has been logged. ". 2364: "Please alert your LON-CAPA administrator."); 2365: $r->print("<pre>\n".$csvdata."</pre>\n"); 2366: return 0; 2367: } 2368: print $file $csvdata; 2369: close($file); 2370: $r->print('<br /><br />'. 2371: '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n"); 2372: # 2373: return 1; 2374: } 2375: 2376: ############################################ 2377: ## Excel output routines ## 2378: ############################################ 2379: sub outsheet_recursive_excel { 2380: my $self = shift; 2381: my ($r) = @_; 2382: my $c = $r->connection; 2383: return undef if ($self->{'type'} ne 'classcalc'); 2384: my ($workbook,$filename) = $self->create_excel_spreadsheet($r); 2385: return undef if (! defined($workbook)); 2386: # 2387: # Create main worksheet 2388: my $main_worksheet = $workbook->addworksheet('main'); 2389: # 2390: # Figure out who the students are 2391: my %f=$self->formulas(); 2392: my $count = 0; 2393: $r->print(<<END); 2394: <p> 2395: Compiling Excel Workbook with a worksheet for each student. 2396: </p><p> 2397: This operation may take longer than a complete recalculation of the 2398: spreadsheet. 2399: </p><p> 2400: To abort this operation, hit the stop button on your browser. 2401: </p><p> 2402: A link to the spreadsheet will be available at the end of this process. 2403: </p> 2404: <p> 2405: END 2406: $r->rflush(); 2407: my $starttime = time; 2408: foreach my $rownum ($self->sort_indicies()) { 2409: $count++; 2410: my ($sname,$sdom) = split(':',$f{'A'.$rownum}); 2411: my $student_excel_worksheet=$workbook->addworksheet($sname.'@'.$sdom); 2412: # Create a new spreadsheet 2413: my $studentsheet = &Apache::lonspreadsheet::Spreadsheet->new 2414: ($sname,$sdom,'studentcalc',undef); 2415: # Read in the spreadsheet definition 2416: $studentsheet->update_student_sheet($r,$c); 2417: # Stuff the sheet into excel 2418: $studentsheet->export_sheet_as_excel($student_excel_worksheet); 2419: my $totaltime = int((time - $starttime) / $count * $self->{'maxrow'}); 2420: my $timeleft = int((time - $starttime) / $count * ($self->{'maxrow'} - $count)); 2421: if ($count % 5 == 0) { 2422: $r->print($count.' students completed.'. 2423: ' Time remaining: '.$timeleft.' sec. '. 2424: ' Estimated total time: '.$totaltime." sec <br />\n"); 2425: $r->rflush(); 2426: } 2427: if(defined($c) && ($c->aborted())) { 2428: last; 2429: } 2430: } 2431: # 2432: if(! $c->aborted() ) { 2433: $r->print('All students spreadsheets completed!<br />'); 2434: $r->rflush(); 2435: # 2436: # &export_sheet_as_excel fills $worksheet with the data from $sheet 2437: $self->export_sheet_as_excel($main_worksheet); 2438: # 2439: $workbook->close(); 2440: # Okay, the spreadsheet is taken care of, so give the user a link. 2441: $r->print('<br /><br />'. 2442: '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); 2443: } else { 2444: $workbook->close(); # Not sure how necessary this is. 2445: #unlink('/home/httpd'.$filename); # No need to keep this around? 2446: } 2447: return 1; 2448: } 2449: 2450: sub outsheet_excel { 2451: my $self = shift; 2452: my ($r) = @_; 2453: my ($workbook,$filename) = $self->create_excel_spreadsheet($r); 2454: return undef if (! defined($workbook)); 2455: my $sheetname; 2456: if ($self->{'type'} eq 'classcalc') { 2457: $sheetname = 'Main'; 2458: } elsif ($self->{'type'} eq 'studentcalc') { 2459: $sheetname = $self->{'uname'}.'@'.$self->{'udom'}; 2460: } elsif ($self->{'type'} eq 'assesscalc') { 2461: $sheetname = $self->{'uname'}.'@'.$self->{'udom'}.' assessment'; 2462: } 2463: my $worksheet = $workbook->addworksheet($sheetname); 2464: # 2465: # &export_sheet_as_excel fills $worksheet with the data from $sheet 2466: $self->export_sheet_as_excel($worksheet); 2467: # 2468: $workbook->close(); 2469: # Okay, the spreadsheet is taken care of, so give the user a link. 2470: $r->print('<br /><br />'. 2471: '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); 2472: return 1; 2473: } 2474: 2475: sub create_excel_spreadsheet { 2476: my $self = shift; 2477: my ($r) = @_; 2478: my $filename = '/prtspool/'. 2479: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. 2480: time.'_'.rand(1000000000).'.xls'; 2481: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); 2482: if (! defined($workbook)) { 2483: $r->log_error("Error creating excel spreadsheet $filename: $!"); 2484: $r->print("Problems creating new Excel file. ". 2485: "This error has been logged. ". 2486: "Please alert your LON-CAPA administrator"); 2487: return undef; 2488: } 2489: # 2490: # The excel spreadsheet stores temporary data in files, then put them 2491: # together. If needed we should be able to disable this (memory only). 2492: # The temporary directory must be specified before calling 'addworksheet'. 2493: # File::Temp is used to determine the temporary directory. 2494: $workbook->set_tempdir('/home/httpd/perl/tmp'); 2495: # 2496: # Determine the name to give the worksheet 2497: return ($workbook,$filename); 2498: } 2499: 2500: sub export_sheet_as_excel { 2501: my $self = shift; 2502: my $worksheet = shift; 2503: # 2504: my $rows_output = 0; 2505: my $cols_output = 0; 2506: #################################### 2507: # Write an identifying row # 2508: #################################### 2509: my @Headerinfo = ($self->{'coursedesc'}); 2510: my $title = $self->gettitle(); 2511: $cols_output = 0; 2512: if (defined($title)) { 2513: $worksheet->write($rows_output++,$cols_output++,$title); 2514: } 2515: #################################### 2516: # Write the summary/export row # 2517: #################################### 2518: my ($rowlabel,@rowdata) = &get_row($self,'0'); 2519: my $label = &format_excel_rowlabel($self,$rowlabel); 2520: $cols_output = 0; 2521: $worksheet->write($rows_output,$cols_output++,$label); 2522: foreach my $cell (@rowdata) { 2523: $worksheet->write($rows_output,$cols_output++,$cell->{'value'}); 2524: } 2525: $rows_output+= 2; # Skip a row, just for fun 2526: #################################### 2527: # Prepare to output rows 2528: #################################### 2529: my @Rows = &sort_indicies($self); 2530: # 2531: # Loop through the rows and output them one at a time 2532: foreach my $rownum (@Rows) { 2533: my ($rowlabel,@rowdata) = &get_row($self,$rownum); 2534: next if ($rowlabel =~ /^[\s]*$/); 2535: $cols_output = 0; 2536: my $label = &format_excel_rowlabel($self,$rowlabel); 2537: if ( ! $ENV{'form.showall'} && 2538: $self->{'type'} =~ /^(studentcalc|classcalc)$/) { 2539: my $row_is_empty = 1; 2540: foreach my $cell (@rowdata) { 2541: if ($cell->{'value'} !~ /^\s*$/) { 2542: $row_is_empty = 0; 2543: last; 2544: } 2545: } 2546: next if ($row_is_empty); 2547: } 2548: $worksheet->write($rows_output,$cols_output++,$label); 2549: if (ref($label)) { 2550: $cols_output = (scalar(@$label)); 2551: } 2552: foreach my $cell (@rowdata) { 2553: $worksheet->write($rows_output,$cols_output++,$cell->{'value'}); 2554: } 2555: $rows_output++; 2556: } 2557: return; 2558: } 2559: 2560: ############################################ 2561: ## XML output routines ## 2562: ############################################ 2563: sub outsheet_xml { 2564: my $self = shift; 2565: my ($r) = @_; 2566: ## Someday XML 2567: ## Will be rendered for the user 2568: ## But not on this day 2569: } 2570: 2571: ## 2572: ## Outsheet - calls other outsheet_* functions 2573: ## 2574: sub outsheet { 2575: my $self = shift; 2576: my ($r)=@_; 2577: if (! exists($ENV{'form.output'})) { 2578: $ENV{'form.output'} = 'HTML'; 2579: } 2580: if (lc($ENV{'form.output'}) eq 'csv') { 2581: $self->outsheet_csv($r); 2582: } elsif (lc($ENV{'form.output'}) eq 'excel') { 2583: $self->outsheet_excel($r); 2584: } elsif (lc($ENV{'form.output'}) eq 'recursive excel') { 2585: $self->outsheet_recursive_excel($r); 2586: # } elsif (lc($ENV{'form.output'}) eq 'xml' ) { 2587: # $self->outsheet_xml($r); 2588: } else { 2589: $self->outsheet_html($r); 2590: } 2591: } 2592: 2593: # 2594: # othersheets: Returns the list of other spreadsheets available 2595: # 2596: sub othersheets { 2597: my $self = shift; 2598: my ($stype)=@_; 2599: $stype = $self->{'type'} if (! defined($stype)); 2600: # 2601: my $cnum = $self->{'cnum'}; 2602: my $cdom = $self->{'cdom'}; 2603: my $chome = $self->{'chome'}; 2604: # 2605: my @alternatives=(); 2606: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); 2607: my ($tmp) = keys(%results); 2608: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { 2609: @alternatives = sort (keys(%results)); 2610: } 2611: return @alternatives; 2612: } 2613: 2614: # 2615: # Parse a spreadsheet 2616: # 2617: sub parse_sheet { 2618: # $sheetxml is a scalar reference or a scalar 2619: my ($sheetxml) = @_; 2620: if (! ref($sheetxml)) { 2621: my $tmp = $sheetxml; 2622: $sheetxml = \$tmp; 2623: } 2624: my %f; 2625: my $parser=HTML::TokeParser->new($sheetxml); 2626: my $token; 2627: while ($token=$parser->get_token) { 2628: if ($token->[0] eq 'S') { 2629: if ($token->[1] eq 'field') { 2630: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}= 2631: $parser->get_text('/field'); 2632: } 2633: if ($token->[1] eq 'template') { 2634: $f{'template_'.$token->[2]->{'col'}}= 2635: $parser->get_text('/template'); 2636: } 2637: } 2638: } 2639: return \%f; 2640: } 2641: 2642: sub readsheet { 2643: my $self = shift; 2644: my ($fn)=@_; 2645: # 2646: my $stype = $self->{'type'}; 2647: my $cnum = $self->{'cnum'}; 2648: my $cdom = $self->{'cdom'}; 2649: my $chome = $self->{'chome'}; 2650: # 2651: if (! defined($fn)) { 2652: # There is no filename. Look for defaults in course and global, cache 2653: unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { 2654: my %tmphash = &Apache::lonnet::get('environment', 2655: ['spreadsheet_default_'.$stype], 2656: $cdom,$cnum); 2657: my ($tmp) = keys(%tmphash); 2658: if ($tmp =~ /^(con_lost|error|no_such_host)/i) { 2659: $fn = 'default_'.$stype; 2660: } else { 2661: $fn = $tmphash{'spreadsheet_default_'.$stype}; 2662: } 2663: unless (($fn) && ($fn!~/^error\:/)) { 2664: $fn='default_'.$stype; 2665: } 2666: $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 2667: } 2668: } 2669: # $fn now has a value 2670: $self->{'filename'} = $fn; 2671: # see if sheet is cached 2672: my $fstring=''; 2673: if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { 2674: my %tmp = split(/___;___/,$fstring); 2675: $self->formulas(\%tmp); 2676: # $self->logthis('readsheet found cached '); 2677: # $self->dump_formulas_to_log(); 2678: } else { 2679: # Not cached, need to read 2680: my %f=(); 2681: if ($fn=~/^default\_/) { 2682: my $sheetxml=''; 2683: my $fh; 2684: my $dfn=$fn; 2685: $dfn=~s/\_/\./g; 2686: if ($fh=Apache::File->new($includedir.'/'.$dfn)) { 2687: $sheetxml=join('',<$fh>); 2688: } else { 2689: # $sheetxml='<field row="0" col="A">"Error"</field>'; 2690: $sheetxml='<field row="0" col="A"></field>'; 2691: } 2692: %f=%{&parse_sheet(\$sheetxml)}; 2693: } elsif($fn=~/\/*\.spreadsheet$/) { 2694: my $sheetxml=&Apache::lonnet::getfile 2695: (&Apache::lonnet::filelocation('',$fn)); 2696: if ($sheetxml == -1) { 2697: $sheetxml='<field row="0" col="A">"Error loading spreadsheet ' 2698: .$fn.'"</field>'; 2699: } 2700: %f=%{&parse_sheet(\$sheetxml)}; 2701: } else { 2702: my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); 2703: my ($tmp) = keys(%tmphash); 2704: if ($tmp !~ /^(con_lost|error|no_such_host)/i) { 2705: foreach (keys(%tmphash)) { 2706: $f{$_}=$tmphash{$_}; 2707: } 2708: } else { 2709: # Unable to grab the specified spreadsheet, 2710: # so we get the default ones instead. 2711: $fn = 'default_'.$stype; 2712: $self->{'filename'} = $fn; 2713: my $dfn = $fn; 2714: $dfn =~ s/\_/\./g; 2715: my $sheetxml; 2716: if (my $fh=Apache::File->new($includedir.'/'.$dfn)) { 2717: $sheetxml = join('',<$fh>); 2718: } else { 2719: $sheetxml='<field row="0" col="A">'. 2720: '"Unable to load spreadsheet"</field>'; 2721: } 2722: %f=%{&parse_sheet(\$sheetxml)}; 2723: } 2724: } 2725: # Cache and set 2726: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); 2727: $self->formulas(\%f); 2728: # $self->logthis('readsheet loaded '); 2729: # $self->dump_formulas_to_log(); 2730: } 2731: } 2732: 2733: # ------------------------------------------------------------ Save spreadsheet 2734: sub writesheet { 2735: my $self = shift; 2736: my ($makedef)=@_; 2737: my $cid=$self->{'cid'}; 2738: if (&Apache::lonnet::allowed('opa',$cid)) { 2739: my %f=$self->formulas(); 2740: my $stype= $self->{'type'}; 2741: my $cnum = $self->{'cnum'}; 2742: my $cdom = $self->{'cdom'}; 2743: my $chome= $self->{'chome'}; 2744: my $fn = $self->{'filename'}; 2745: # Cache new sheet 2746: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); 2747: # Write sheet 2748: foreach (keys(%f)) { 2749: delete($f{$_}) if ($f{$_} eq 'import'); 2750: } 2751: my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum); 2752: if ($reply eq 'ok') { 2753: $reply = &Apache::lonnet::put($stype.'_spreadsheets', 2754: {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, 2755: $cdom,$cnum); 2756: if ($reply eq 'ok') { 2757: if ($makedef) { 2758: $reply = &Apache::lonnet::put('environment', 2759: {'spreadsheet_default_'.$stype => $fn }, 2760: $cdom,$cnum); 2761: if ($reply eq 'ok' && 2762: ($self->{'type'} eq 'studentcalc' || 2763: $self->{'type'} eq 'assesscalc')) { 2764: # Expire the spreadsheets of the other students. 2765: &Apache::lonnet::expirespread('','','studentcalc',''); 2766: } 2767: return $reply; 2768: } 2769: return $reply; 2770: } 2771: return $reply; 2772: } 2773: return $reply; 2774: } 2775: return 'unauthorized'; 2776: } 2777: 2778: # ----------------------------------------------- Make a temp copy of the sheet 2779: # "Modified workcopy" - interactive only 2780: # 2781: sub tmpwrite { 2782: my $self = shift; 2783: my $fn=$ENV{'user.name'}.'_'. 2784: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. 2785: $self->{'filename'}; 2786: $fn=~s/\W/\_/g; 2787: $fn=$tmpdir.$fn.'.tmp'; 2788: my $fh; 2789: if ($fh=Apache::File->new('>'.$fn)) { 2790: my %f = $self->formulas(); 2791: while( my ($cell,$formula) = each(%f)) { 2792: print $fh &Apache::lonnet::escape($cell)."=".&Apache::lonnet::escape($formula)."\n"; 2793: } 2794: } 2795: } 2796: 2797: 2798: # ---------------------------------------------------------- Read the temp copy 2799: sub tmpread { 2800: my $self = shift; 2801: my ($nfield,$nform)=@_; 2802: my $fn=$ENV{'user.name'}.'_'. 2803: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. 2804: $self->{'filename'}; 2805: $fn=~s/\W/\_/g; 2806: $fn=$tmpdir.$fn.'.tmp'; 2807: my $fh; 2808: my %fo=(); 2809: my $countrows=0; 2810: if ($fh=Apache::File->new($fn)) { 2811: while (<$fh>) { 2812: chomp; 2813: my ($cell,$formula) = split(/=/); 2814: $cell = &Apache::lonnet::unescape($cell); 2815: $formula = &Apache::lonnet::unescape($formula); 2816: $fo{$cell} = $formula; 2817: } 2818: } 2819: if ($nform eq 'changesheet') { 2820: $fo{'A'.$nfield}=(split(/__&&&\__/,$fo{'A'.$nfield}))[0]; 2821: unless ($ENV{'form.sel_'.$nfield} eq 'Default') { 2822: $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield}; 2823: } 2824: } else { 2825: if ($nfield) { $fo{$nfield}=$nform; } 2826: } 2827: $self->formulas(\%fo); 2828: } 2829: 2830: ################################################################## 2831: ## Row label formatting routines ## 2832: ################################################################## 2833: sub format_html_rowlabel { 2834: my $self = shift; 2835: my $rowlabel = shift; 2836: return '' if ($rowlabel eq ''); 2837: my ($type,$labeldata) = split(':',$rowlabel,2); 2838: my $result = ''; 2839: if ($type eq 'symb') { 2840: my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata); 2841: $ufn = 'default' if (!defined($ufn) || $ufn eq ''); 2842: $ufn = &Apache::lonnet::unescape($ufn); 2843: $symb = &Apache::lonnet::unescape($symb); 2844: $title = &Apache::lonnet::unescape($title); 2845: $result = '<a href="/adm/assesscalc?usymb='.$symb. 2846: '&uname='.$self->{'uname'}.'&udom='.$self->{'udom'}. 2847: '&ufn='.$ufn. 2848: '&mapid='.$mapid.'&resid='.$resid.'">'.$title.'</a>'; 2849: } elsif ($type eq 'student') { 2850: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); 2851: if ($fullname =~ /^\s*$/) { 2852: $fullname = $sname.'@'.$sdom; 2853: } 2854: $result ='<a href="/adm/studentcalc?uname='.$sname. 2855: '&udom='.$sdom.'">'; 2856: $result.=$section.' '.$id." ".$fullname.'</a>'; 2857: } elsif ($type eq 'parameter') { 2858: $result = $labeldata; 2859: } else { 2860: $result = '<b><font size=+1>'.$rowlabel.'</font></b>'; 2861: } 2862: return $result; 2863: } 2864: 2865: sub format_csv_rowlabel { 2866: my $self = shift; 2867: my $rowlabel = shift; 2868: return '' if ($rowlabel eq ''); 2869: my ($type,$labeldata) = split(':',$rowlabel,2); 2870: my $result = ''; 2871: if ($type eq 'symb') { 2872: my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata); 2873: $ufn = &Apache::lonnet::unescape($ufn); 2874: $symb = &Apache::lonnet::unescape($symb); 2875: $title = &Apache::lonnet::unescape($title); 2876: $result = $title; 2877: } elsif ($type eq 'student') { 2878: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); 2879: $result = join('","',($sname,$sdom,$fullname,$section,$id)); 2880: } elsif ($type eq 'parameter') { 2881: $labeldata =~ s/<br>/ /g; 2882: $result = $labeldata; 2883: } else { 2884: $result = $rowlabel; 2885: } 2886: return '"'.$result.'"'; 2887: } 2888: 2889: sub format_excel_rowlabel { 2890: my $self = shift; 2891: my $rowlabel = shift; 2892: return '' if ($rowlabel eq ''); 2893: my ($type,$labeldata) = split(':',$rowlabel,2); 2894: my $result = ''; 2895: if ($type eq 'symb') { 2896: my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata); 2897: $ufn = &Apache::lonnet::unescape($ufn); 2898: $symb = &Apache::lonnet::unescape($symb); 2899: $title = &Apache::lonnet::unescape($title); 2900: $result = $title; 2901: } elsif ($type eq 'student') { 2902: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); 2903: $section = '' if (! defined($section)); 2904: $id = '' if (! defined($id)); 2905: my @Data = ($sname,$sdom,$fullname,$section,$id); 2906: $result = \@Data; 2907: } elsif ($type eq 'parameter') { 2908: $labeldata =~ s/<br>/ /g; 2909: $result = $labeldata; 2910: } else { 2911: $result = $rowlabel; 2912: } 2913: return $result; 2914: } 2915: 2916: # ---------------------------------------------- Update rows for course listing 2917: sub updateclasssheet { 2918: my $self = shift; 2919: my $cnum =$self->{'cnum'}; 2920: my $cdom =$self->{'cdom'}; 2921: my $cid =$self->{'cid'}; 2922: my $chome =$self->{'chome'}; 2923: # 2924: %Section = (); 2925: # 2926: # Read class list and row labels 2927: my $classlist = &Apache::loncoursedata::get_classlist(); 2928: if (! defined($classlist)) { 2929: return 'Could not access course classlist'; 2930: } 2931: # 2932: my %currentlist=(); 2933: foreach my $student (keys(%$classlist)) { 2934: my ($studentDomain,$studentName,$end,$start,$id,$studentSection, 2935: $fullname,$status) = @{$classlist->{$student}}; 2936: $Section{$studentName.':'.$studentDomain} = $studentSection; 2937: if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') { 2938: $currentlist{$student}=join(':',('student',$studentName, 2939: $studentDomain,$fullname, 2940: $studentSection,$id)); 2941: } 2942: } 2943: # 2944: # Find discrepancies between the course row table and this 2945: # 2946: my %f=$self->formulas(); 2947: my $changed=0; 2948: # 2949: $self->{'maxrow'}=0; 2950: my %existing=(); 2951: # 2952: # Now obsolete rows 2953: foreach my $cell ($self->A_column()) { 2954: $cell =~ /^A(\d+)/; 2955: if ($1 > $self->{'maxrow'}) { 2956: $self->{'maxrow'}= $1; 2957: } 2958: $existing{$f{$cell}}=1; 2959: unless ((defined($currentlist{$f{$cell}})) || (!$1) || 2960: ($f{$cell}=~/^(~~~|---)/)) { 2961: $f{$cell}='!!! Obsolete'; 2962: $changed=1; 2963: } 2964: } 2965: # 2966: # New and unknown keys 2967: foreach my $student (sort keys(%currentlist)) { 2968: next if ($existing{$student}); 2969: $changed=1; 2970: $self->{'maxrow'}++; 2971: $f{'A'.$self->{'maxrow'}}=$student; 2972: } 2973: $self->formulas(\%f) if ($changed); 2974: # 2975: $self->rowlabels(\%currentlist); 2976: } 2977: 2978: # ----------------------------------- Update rows for student and assess sheets 2979: sub get_student_rowlabels { 2980: my $self = shift; 2981: # 2982: my %course_db; 2983: # 2984: my $stype = $self->{'type'}; 2985: my $uname = $self->{'uname'}; 2986: my $udom = $self->{'udom'}; 2987: # 2988: $self->{'rowlabel'} = {}; 2989: # 2990: my $identifier =$self->{'coursefilename'}.'_'.$stype; 2991: if ($rowlabel_cache{$identifier}) { 2992: %{$self->{'rowlabel'}}=split(/___;___/,$rowlabel_cache{$identifier}); 2993: } else { 2994: # Get the data and store it in the cache 2995: # Tie hash 2996: tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db', 2997: &GDBM_READER(),0640); 2998: if (! tied(%course_db)) { 2999: return 'Could not access course data'; 3000: } 3001: # 3002: my %assesslist = (); 3003: foreach ('Feedback','Evaluation','Tutoring','Discussion') { 3004: my $symb = '_'.lc($_); 3005: $assesslist{$symb} = join(':',('symb',$symb,0,0, 3006: &Apache::lonnet::escape($_))); 3007: } 3008: # 3009: while (my ($key,$srcf) = each(%course_db)) { 3010: next if ($key !~ /^src_(\d+)\.(\d+)$/); 3011: my $mapid = $1; 3012: my $resid = $2; 3013: my $id = $mapid.'.'.$resid; 3014: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { 3015: my $symb= 3016: &Apache::lonnet::declutter($course_db{'map_id_'.$mapid}). 3017: '___'.$resid.'___'.&Apache::lonnet::declutter($srcf); 3018: $assesslist{$symb} ='symb:'.&Apache::lonnet::escape($symb).':' 3019: .$mapid.':'.$resid.':'. 3020: &Apache::lonnet::escape($course_db{'title_'.$id}); 3021: } 3022: } 3023: untie(%course_db); 3024: # Store away the data 3025: $self->{'rowlabel'} = \%assesslist; 3026: $rowlabel_cache{$identifier}=join('___;___',%{$self->{'rowlabel'}}); 3027: } 3028: 3029: } 3030: 3031: sub get_assess_rowlabels { 3032: my $self = shift; 3033: # 3034: my %course_db; 3035: # 3036: my $stype = $self->{'type'}; 3037: my $uname = $self->{'uname'}; 3038: my $udom = $self->{'udom'}; 3039: my $usymb = $self->{'usymb'}; 3040: # 3041: $self->rowlabels({}); 3042: my $identifier =$self->{'coursefilename'}.'_'.$stype.'_'.$usymb; 3043: # 3044: if ($rowlabel_cache{$identifier}) { 3045: $self->rowlabels(split(/___;___/,$rowlabel_cache{$identifier})); 3046: } else { 3047: # Get the data and store it in the cache 3048: # Tie hash 3049: tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db', 3050: &GDBM_READER(),0640); 3051: if (! tied(%course_db)) { 3052: return 'Could not access course data'; 3053: } 3054: # 3055: my %parameter_labels= 3056: ('timestamp' => 3057: 'parameter:Timestamp of Last Transaction<br>timestamp', 3058: 'subnumber' => 3059: 'parameter:Number of Submissions<br>subnumber', 3060: 'tutornumber' => 3061: 'parameter:Number of Tutor Responses<br>tutornumber', 3062: 'totalpoints' => 3063: 'parameter:Total Points Granted<br>totalpoints'); 3064: while (my ($key,$srcf) = each(%course_db)) { 3065: next if ($key !~ /^src_(\d+)\.(\d+)$/); 3066: my $mapid = $1; 3067: my $resid = $2; 3068: my $id = $mapid.'.'.$resid; 3069: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { 3070: # Loop through the metadata for this key 3071: my @Metadata = split(/,/, 3072: &Apache::lonnet::metadata($srcf,'keys')); 3073: foreach my $key (@Metadata) { 3074: next if ($key !~ /^(stores|parameter)_/); 3075: my $display= 3076: &Apache::lonnet::metadata($srcf,$key.'.display'); 3077: unless ($display) { 3078: $display.= 3079: &Apache::lonnet::metadata($srcf,$key.'.name'); 3080: } 3081: $display.='<br>'.$key; 3082: $parameter_labels{$key}='parameter:'.$display; 3083: } # end of foreach 3084: } 3085: } 3086: untie(%course_db); 3087: # Store away the results 3088: $self->rowlabels(\%parameter_labels); 3089: $rowlabel_cache{$identifier}=join('___;___',$self->rowlabels()); 3090: } 3091: 3092: } 3093: 3094: sub updatestudentassesssheet { 3095: my $self = shift; 3096: if ($self->{'type'} eq 'studentcalc') { 3097: $self->get_student_rowlabels(); 3098: } else { 3099: $self->get_assess_rowlabels(); 3100: } 3101: # Determine if any of the information has changed 3102: my %f=$self->formulas(); 3103: my $changed=0; 3104: $self->{'maxrow'} = 0; 3105: my %existing=(); 3106: # Now obsolete rows 3107: foreach my $cell ($self->A_column()) { 3108: my $formula = $f{$cell}; 3109: my ($n)= ($cell =~ /A(\d+)/); 3110: next if ($n eq '0'); 3111: $self->{'maxrow'} = $n if ($n > $self->{'maxrow'}); 3112: my ($usy,$ufn)=split(/__&&&\__/,$formula); 3113: $existing{$usy}=1; 3114: if ( ! exists($self->{'rowlabel'}->{$usy}) || 3115: ! defined($self->{'rowlabel'}->{$usy}) || 3116: ($formula =~ /^(~~~|---)/) || 3117: ($formula =~ /^\s*$/)) { 3118: $f{$cell}='!!! Obsolete'; 3119: # $self->logthis('obsoleted row '.$n); 3120: $changed=1; 3121: } 3122: } 3123: # New and unknown keys 3124: my %keys_hates_me = $self->rowlabels(); 3125: foreach (keys(%keys_hates_me)) { 3126: unless ($existing{$_}) { 3127: $changed=1; 3128: $self->{'maxrow'}++; 3129: $f{'A'.$self->{'maxrow'}}=$_; 3130: } 3131: } 3132: $self->formulas(\%f) if ($changed); 3133: # $self->dump_formulas_to_log(); 3134: } 3135: 3136: # ------------------------------------------------ Load data for one assessment 3137: sub loadstudent{ 3138: my $self = shift; 3139: my ($r,$c)=@_; 3140: my %constants = (); 3141: my %formulas = $self->formulas(); 3142: $cachedassess = $self->{'uname'}.':'.$self->{'udom'}; 3143: # Get ALL the student preformance data 3144: my @tmp = &Apache::lonnet::currentdump($self->{'cid'}, 3145: $self->{'udom'}, 3146: $self->{'uname'}); 3147: if ((scalar @tmp > 0) && ($tmp[0] !~ /^error:/)) { 3148: %cachedstores = @tmp; 3149: } 3150: undef @tmp; 3151: # 3152: my @assessdata=(); 3153: foreach my $cell ($self->A_column()) { 3154: my $value = $formulas{$cell}; 3155: if(defined($c) && ($c->aborted())) { 3156: last; 3157: } 3158: my ($row)=($cell=~/A(\d+)/); 3159: next if (($value =~ /^[!~-]/) || ($row==0)); 3160: my ($usy,$ufn)=split(/__&&&\__/,$value); 3161: @assessdata=$self->exportsheet($self->{'uname'}, 3162: $self->{'udom'}, 3163: 'assesscalc',$usy,$ufn,$r); 3164: my $index=0; 3165: foreach my $col ('A','B','C','D','E','F','G','H','I','J','K','L','M', 3166: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 3167: if (defined($assessdata[$index])) { 3168: if ($assessdata[$index]=~/\D/) { 3169: $constants{$col.$row}="'".$assessdata[$index]."'"; 3170: } else { 3171: $constants{$col.$row}=$assessdata[$index]; 3172: } 3173: $formulas{$col.$row}='import' if ($col ne 'A'); 3174: } 3175: $index++; 3176: } 3177: } 3178: $cachedassess=''; 3179: undef %cachedstores; 3180: $self->formulas(\%formulas); 3181: $self->constants(\%constants); 3182: } 3183: 3184: # --------------------------------------------------- Load data for one student 3185: # 3186: sub loadcourse { 3187: my $self = shift; 3188: my ($r,$c)=@_; 3189: # 3190: my %constants=(); 3191: my %formulas=$self->formulas(); 3192: # 3193: my $total=0; 3194: foreach ($self->A_column()) { 3195: $total++ if ($formulas{$_} !~ /^[!~-]/); 3196: } 3197: my $now=0; 3198: my $since=time; 3199: $r->print(<<ENDPOP); 3200: <script> 3201: popwin=open('','popwin','width=400,height=100'); 3202: popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+ 3203: '<h3>Spreadsheet Calculation Progress</h3>'+ 3204: '<form name=popremain>'+ 3205: '<input type=text size=45 name=remaining value=Starting></form>'+ 3206: '</body></html>'); 3207: popwin.document.close(); 3208: </script> 3209: ENDPOP 3210: $r->rflush(); 3211: foreach ($self->A_column()) { 3212: if(defined($c) && ($c->aborted())) { 3213: last; 3214: } 3215: my ($row)=(/A(\d+)/); 3216: next if (($formulas{$_}=~/^[\!\~\-]/) || ($row==0)); 3217: my ($sname,$sdom) = split(':',$formulas{$_}); 3218: my $started = time; 3219: my @studentdata=$self->exportsheet($sname,$sdom,'studentcalc', 3220: undef,undef,$r); 3221: undef %userrdatas; 3222: $now++; 3223: $r->print('<script>popwin.document.popremain.remaining.value="'. 3224: $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)). 3225: ' secs remaining '.(time-$started).' last";</script>'); 3226: $r->rflush(); 3227: # 3228: my $index=0; 3229: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 3230: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 3231: if (defined($studentdata[$index])) { 3232: my $col=$_; 3233: if ($studentdata[$index]=~/\D/) { 3234: $constants{$col.$row}="'".$studentdata[$index]."'"; 3235: } else { 3236: $constants{$col.$row}=$studentdata[$index]; 3237: } 3238: unless ($col eq 'A') { 3239: $formulas{$col.$row}='import'; 3240: } 3241: } 3242: $index++; 3243: } 3244: } 3245: $self->formulas(\%formulas); 3246: $self->constants(\%constants); 3247: $r->print('<script>popwin.close()</script>'); 3248: $r->rflush(); 3249: } 3250: 3251: # ------------------------------------------------ Load data for one assessment 3252: # 3253: sub loadassessment { 3254: my $self = shift; 3255: my ($r,$c)=@_; 3256: 3257: my $uhome = $self->{'uhome'}; 3258: my $uname = $self->{'uname'}; 3259: my $udom = $self->{'udom'}; 3260: my $symb = $self->{'usymb'}; 3261: my $cid = $self->{'cid'}; 3262: my $cnum = $self->{'cnum'}; 3263: my $cdom = $self->{'cdom'}; 3264: my $chome = $self->{'chome'}; 3265: my $csec = $self->{'csec'}; 3266: 3267: my $namespace; 3268: unless ($namespace=$cid) { return ''; } 3269: # Get stored values 3270: my %returnhash=(); 3271: if ($cachedassess eq $uname.':'.$udom) { 3272: # 3273: # get data out of the dumped stores 3274: # 3275: if (exists($cachedstores{$symb})) { 3276: %returnhash = %{$cachedstores{$symb}}; 3277: } else { 3278: %returnhash = (); 3279: } 3280: } else { 3281: # 3282: # restore individual 3283: # 3284: %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname); 3285: } 3286: # 3287: # returnhash now has all stores for this resource 3288: # convert all "_" to "." to be able to use libraries, multiparts, etc 3289: # 3290: # This is dumb. It is also necessary :( 3291: my @oldkeys=keys %returnhash; 3292: # 3293: foreach my $name (@oldkeys) { 3294: my $value=$returnhash{$name}; 3295: delete $returnhash{$name}; 3296: $name=~s/\_/\./g; 3297: $returnhash{$name}=$value; 3298: } 3299: # initialize coursedata and userdata for this user 3300: undef %courseopt; 3301: undef %useropt; 3302: 3303: my $userprefix=$uname.'_'.$udom.'_'; 3304: 3305: unless ($uhome eq 'no_host') { 3306: # Get coursedata 3307: unless ((time-$courserdatas{$cid.'.last_cache'})<240) { 3308: my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum); 3309: $courserdatas{$cid}=\%Tmp; 3310: $courserdatas{$cid.'.last_cache'}=time; 3311: } 3312: while (my ($name,$value) = each(%{$courserdatas{$cid}})) { 3313: $courseopt{$userprefix.$name}=$value; 3314: } 3315: # Get userdata (if present) 3316: unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) { 3317: my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname); 3318: $userrdatas{$cid} = \%Tmp; 3319: # Most of the time the user does not have a 'resourcedata.db' 3320: # file. We need to cache that we got nothing instead of bothering 3321: # with requesting it every time. 3322: $userrdatas{$uname.'@'.$udom.'.last_cache'}=time; 3323: } 3324: while (my ($name,$value) = each(%{$userrdatas{$cid}})) { 3325: $useropt{$userprefix.$name}=$value; 3326: } 3327: } 3328: # now courseopt, useropt initialized for this user and course 3329: # (used by parmval) 3330: # 3331: # Load keys for this assessment only 3332: # 3333: my %thisassess=(); 3334: my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); 3335: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { 3336: $thisassess{$_}=1; 3337: } 3338: # 3339: # Load parameters 3340: # 3341: my %c=(); 3342: if (tie(%parmhash,'GDBM_File', 3343: $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { 3344: my %f=$self->formulas(); 3345: foreach my $cell ($self->A_column()) { 3346: my $formula = $self->formula($cell); 3347: next if ($formula =~/^[\!\~\-]/); 3348: if ($formula =~ /^parameter/) { 3349: if (defined($thisassess{$formula})) { 3350: my $val = &parmval($formula,$symb,$uname,$udom,$csec); 3351: $c{$cell} = $val; 3352: $c{$formula} = $val; 3353: } 3354: } else { 3355: my $ckey=$formula; 3356: $formula=~s/^stores\_/resource\./; 3357: $formula=~s/\_/\./g; 3358: $c{$cell}=$returnhash{$formula}; 3359: $c{$ckey}=$returnhash{$formula}; 3360: } 3361: } 3362: untie(%parmhash); 3363: } 3364: $self->constants(\%c); 3365: } 3366: 3367: 3368: # =============================================== Update information in a sheet 3369: # 3370: # Add new users or assessments, etc. 3371: # 3372: sub updatesheet { 3373: my $self = shift; 3374: if ($self->{'type'} eq 'classcalc') { 3375: return $self->updateclasssheet(); 3376: } else { 3377: return $self->updatestudentassesssheet(); 3378: } 3379: } 3380: 3381: # =================================================== Load the rows for a sheet 3382: # 3383: # Import the data for rows 3384: # 3385: sub loadrows { 3386: my $self = shift; 3387: my ($r)=@_; 3388: my $c = $r->connection; 3389: if ($self->{'type'} eq 'classcalc') { 3390: $self->loadcourse($r,$c); 3391: } elsif ($self->{'type'} eq 'studentcalc') { 3392: $self->loadstudent($r,$c); 3393: } else { 3394: $self->loadassessment($r,$c); 3395: } 3396: } 3397: 3398: # ============================================================== Export handler 3399: # exportsheet 3400: # returns the export row for a spreadsheet. 3401: # 3402: sub exportsheet { 3403: my $self = shift; 3404: my ($uname,$udom,$stype,$usymb,$fn,$r)=@_; 3405: my $flag = 0; 3406: $uname = $uname || $self->{'uname'}; 3407: $udom = $udom || $self->{'udom'}; 3408: $stype = $stype || $self->{'type'}; 3409: my @exportarr=(); 3410: # This handles the assessment sheets for '_feedback', etc 3411: if (defined($usymb) && ($usymb=~/^\_(\w+)/) && 3412: (!defined($fn) || $fn eq '')) { 3413: $fn='default_'.$1; 3414: } 3415: # 3416: # Check if cached 3417: # 3418: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; 3419: my $found=''; 3420: if ($Apache::lonspreadsheet::oldsheets{$key}) { 3421: foreach (split(/___&\___/,$Apache::lonspreadsheet::oldsheets{$key})) { 3422: my ($name,$value)=split(/___=___/,$_); 3423: if ($name eq $fn) { 3424: $found=$value; 3425: } 3426: } 3427: } 3428: unless ($found) { 3429: &cachedssheets($self,$uname,$udom); 3430: if ($Apache::lonspreadsheet::oldsheets{$key}) { 3431: foreach (split(/___&\___/,$Apache::lonspreadsheet::oldsheets{$key})) { 3432: my ($name,$value)=split(/___=___/,$_); 3433: if ($name eq $fn) { 3434: $found=$value; 3435: } 3436: } 3437: } 3438: } 3439: # 3440: # Check if still valid 3441: # 3442: if ($found) { 3443: if (&forcedrecalc($uname,$udom,$stype,$usymb)) { 3444: $found=''; 3445: } 3446: } 3447: if ($found) { 3448: # 3449: # Return what was cached 3450: # 3451: @exportarr=split(/___;___/,$found); 3452: return @exportarr; 3453: } 3454: # 3455: # Not cached 3456: # 3457: my $newsheet = Apache::lonspreadsheet::Spreadsheet->new($uname,$udom, 3458: $stype,$usymb); 3459: $newsheet->readsheet($fn); 3460: $newsheet->updatesheet(); 3461: $newsheet->loadrows($r); 3462: $newsheet->calcsheet(); 3463: @exportarr=$newsheet->exportdata(); 3464: ## 3465: ## Store now 3466: ## 3467: # 3468: # load in the old value 3469: # 3470: my %currentlystored=(); 3471: if ($stype eq 'studentcalc') { 3472: my @tmp = &Apache::lonnet::get('nohist_calculatedsheets', 3473: [$key], 3474: $self->{'cdom'},$self->{'cnum'}); 3475: if ($tmp[0]!~/^error/) { 3476: # We only got one key, so we will access it directly. 3477: foreach (split('___&___',$tmp[1])) { 3478: my ($key,$value) = split('___=___',$_); 3479: $key = '' if (! defined($key)); 3480: $currentlystored{$key} = $value; 3481: } 3482: } 3483: } else { 3484: my @tmp = &Apache::lonnet::get('nohist_calculatedsheets_'. 3485: $self->{'cid'},[$key], 3486: $self->{'udom'},$self->{'uname'}); 3487: if ($tmp[0]!~/^error/) { 3488: # We only got one key, so we will access it directly. 3489: foreach (split('___&___',$tmp[1])) { 3490: my ($key,$value) = split('___=___',$_); 3491: $key = '' if (! defined($key)); 3492: $currentlystored{$key} = $value; 3493: } 3494: } 3495: } 3496: # 3497: # Add the new line 3498: # 3499: $currentlystored{$fn}=join('___;___',@exportarr); 3500: # 3501: # Stick everything back together 3502: # 3503: my $newstore=''; 3504: foreach (keys(%currentlystored)) { 3505: if ($newstore) { $newstore.='___&___'; } 3506: $newstore.=$_.'___=___'.$currentlystored{$_}; 3507: } 3508: my $now=time; 3509: # 3510: # Store away the new value 3511: # 3512: my $timekey = $key.'.time'; 3513: if ($stype eq 'studentcalc') { 3514: my $result = &Apache::lonnet::put('nohist_calculatedsheets', 3515: { $key => $newstore, 3516: $timekey => $now }, 3517: $self->{'cdom'}, 3518: $self->{'cnum'}); 3519: } else { 3520: my $result = &Apache::lonnet::put('nohist_calculatedsheets_'.$self->{'cid'}, 3521: { $key => $newstore, 3522: $timekey => $now }, 3523: $self->{'udom'}, 3524: $self->{'uname'}); 3525: } 3526: return @exportarr; 3527: } 3528: 3529: 1; 3530: 3531: __END__ 3532: 3533: