loncom/interface/spreadsheet/assesscalc.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / assesscalc.pm
Revision 1.1: download - view: text, annotated - select for diffs
Fri May 16 20:55:11 2003 UTC (21 years, 1 month ago) by matthew
Branches: MAIN
CVS tags: HEAD

Nearly complete reworking of spreadsheet.

lonspreadsheet.pm holds a few utility functions and the handler, which
creates a spreadsheet and tells it to display itself.

Spreadsheet.pm is the base definition of the spreadsheet object.
classcalc.pm, studentcalc.pm, and assesscalc.pm are implementations of the
spreadsheets.

There are missing pieces - excel and csv output, limiting by section
permissions, the ability to add extra 'header' rows to the student and
course level sheets, and students are still allowed to view the assessment
level sheets (will disable this soon).

Computing and editing of the spreadsheet have been tested and have been
given a preliminary seal of approval.

1: # 2: # $Id: assesscalc.pm,v 1.1 2003/05/16 20:55:11 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: assesscalc 34: 35: =head1 SYNOPSIS 36: 37: =head1 DESCRIPTION 38: 39: =cut 40: 41: ################################################### 42: ### AssessSheet ### 43: ################################################### 44: package Apache::assesscalc; 45: 46: use strict; 47: use Apache::Constants qw(:common :http); 48: use Apache::lonnet; 49: use Apache::Spreadsheet; 50: use HTML::Entities(); 51: use Spreadsheet::WriteExcel; 52: use GDBM_File; 53: use Time::HiRes; 54: 55: @Apache::assesscalc::ISA = ('Apache::Spreadsheet'); 56: 57: ######################################################## 58: ######################################################## 59: 60: =pod 61: 62: =head2 Package Variables 63: 64: =over 4 65: 66: =item %Exportrows 67: 68: =item $current_name 69: 70: =item $current_domain 71: 72: =item $current_course 73: 74: =item %parmhash 75: 76: =item %nice_parameter_name 77: 78: =item %useropt 79: 80: =item %courseopt 81: 82: =back 83: 84: =cut 85: 86: ######################################################## 87: ######################################################## 88: 89: my %Exportrows; 90: 91: my $current_name; 92: my $current_domain; 93: my $current_course; 94: 95: my %parmhash; 96: my %nice_parameter_name; 97: 98: my %useropt; 99: my %courseopt; 100: 101: ######################################################## 102: ######################################################## 103: 104: =pod 105: 106: =head2 Package Subroutines 107: 108: =item &clear_package() 109: 110: Reset all package variables. 111: 112: =cut 113: 114: ######################################################## 115: ######################################################## 116: sub clear_package { 117: undef(%Exportrows); 118: undef($current_name); 119: undef($current_domain); 120: undef($current_course); 121: undef(%useropt); 122: undef(%courseopt); 123: } 124: 125: ######################################################## 126: ######################################################## 127: 128: =pod 129: 130: =item &initialize_package() 131: 132: =cut 133: 134: ######################################################## 135: ######################################################## 136: sub initialize_package { 137: my ($sname,$sdomain) = @_; 138: $current_course = $ENV{'request.course.id'}; 139: $current_name = $sname; 140: $current_domain = $sdomain; 141: undef(%courseopt); 142: &load_cached_export_rows(); 143: &load_parameter_caches(); 144: } 145: 146: ######################################################## 147: ######################################################## 148: 149: =pod 150: 151: =item &load_parameter_caches() 152: 153: =cut 154: 155: ######################################################## 156: ######################################################## 157: sub load_parameter_caches { 158: my $userprefix = $current_name.':'.$current_domain.'_'; 159: $userprefix =~ s/:/_/g; 160: # 161: # Course Parameters Cache 162: if (! %courseopt) { 163: &Apache::lonnet::logthis("loading course options"); 164: $current_course = $ENV{'request.course.id'}; 165: undef(%courseopt); 166: if (! defined($current_name) || ! defined($current_domain)) { 167: &Apache::lonnet::logthis('bad call to setup_parameter_caches'); 168: return; 169: } 170: my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; 171: my $id = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; 172: my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id); 173: while (my ($name,$value) = each(%Tmp)) { 174: $courseopt{$userprefix.$name}=$value; 175: } 176: } 177: if (! %useropt) { 178: my %Tmp = &Apache::lonnet::dump('resourcedata', 179: $current_domain,$current_name); 180: while (my ($name,$value) = each(%Tmp)) { 181: if ($name =~ /^error: 2/ || $name =~ /no such file/) { 182: undef(%useropt); 183: last; 184: } 185: $useropt{$userprefix.$name}=$value; 186: } 187: } 188: } 189: 190: ######################################################## 191: ######################################################## 192: 193: =pod 194: 195: =head2 assesscalc object methods 196: 197: =cut 198: 199: ######################################################## 200: ######################################################## 201: 202: sub ensure_current_parameter_caches { 203: my $self = shift; 204: if (! defined($current_course) || 205: $current_course ne $ENV{'request.course.id'} ) { 206: $current_course = $ENV{'request.course.id'}; 207: undef(%courseopt); 208: } 209: if (! defined($current_name) || $current_name ne $self->{'name'} || 210: ! defined($current_domain) || $current_domain ne $self->{'domain'}) { 211: $current_domain = $self->{'domain'}; 212: $current_name = $self->{'name'}; 213: undef(%useropt); 214: } 215: &load_parameter_caches(); 216: } 217: 218: ################################################## 219: ################################################## 220: 221: =pod 222: 223: =item &parmval() 224: 225: Determine the value of a parameter. 226: 227: Inputs: $what, the parameter needed, $symb, $uname, $udom, $csec 228: 229: Returns: The value of a parameter, or '' if none. 230: 231: This function cascades through the possible levels searching for a value for 232: a parameter. The levels are checked in the following order: 233: user, course (at section level and course level), map, and lonnet::metadata. 234: This function uses %parmhash, which must be tied prior to calling it. 235: This function also requires %courseopt and %useropt to be initialized for 236: this user and course. 237: 238: =cut 239: 240: ################################################## 241: ################################################## 242: sub parmval { 243: my $self = shift; 244: my ($what,$symb,$uname,$udom,$csec)=@_; 245: $uname = $self->{'name'} if (! defined($uname)); 246: $udom = $self->{'domain'} if (! defined($udom)); 247: $csec = $self->{'section'} if (! defined($csec)); 248: $symb = $self->{'symb'} if (! defined($symb)); 249: # 250: my $result=''; 251: # 252: # This should be a 253: my ($mapname,$id,$fn)=split(/___/,$symb); 254: # Cascading lookup scheme 255: my $rwhat=$what; 256: $what =~ s/^parameter\_//; 257: $what =~ s/\_([^\_]+)$/\.$1/; 258: # 259: my $symbparm = $symb.'.'.$what; 260: my $mapparm = $mapname.'___(all).'.$what; 261: my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'}; 262: # 263: my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; 264: my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; 265: my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; 266: # 267: my $courselevel = $usercourseprefix.'.'.$what; 268: my $courselevelr = $usercourseprefix.'.'.$symbparm; 269: my $courselevelm = $usercourseprefix.'.'.$mapparm; 270: # check user 271: if (defined($uname)) { 272: return $useropt{$courselevelr} if (defined($useropt{$courselevelr})); 273: return $useropt{$courselevelm} if (defined($useropt{$courselevelm})); 274: return $useropt{$courselevel} if (defined($useropt{$courselevel})); 275: } 276: # check section 277: if (defined($csec)) { 278: return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); 279: return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); 280: return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); 281: } 282: # 283: # check course 284: return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); 285: return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); 286: return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); 287: # check map parms 288: my $thisparm = $parmhash{$symbparm}; 289: return $thisparm if (defined($thisparm)); 290: # check default 291: $thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default'); 292: return $thisparm if (defined($thisparm)); 293: # 294: # Cascade Up 295: my $space=$what; 296: $space=~s/\.\w+$//; 297: if ($space ne '0') { 298: my @parts=split(/_/,$space); 299: my $id=pop(@parts); 300: my $part=join('_',@parts); 301: if ($part eq '') { $part='0'; } 302: my $newwhat=$rwhat; 303: $newwhat=~s/\Q$space\E/$part/; 304: my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec); 305: if (defined($partgeneral)) { return $partgeneral; } 306: } 307: #nothing defined 308: return ''; 309: } 310: 311: sub get_title { 312: my $self = shift; 313: my $title; 314: if (($self->{'usymb'} eq '_feedback') || 315: ($self->{'usymb'} eq '_evaluation') || 316: ($self->{'usymb'} eq '_discussion') || 317: ($self->{'usymb'} eq '_tutoring')) { 318: $title = $self->{'usymb'}; 319: $title =~ s/^_//; 320: $title = '<h1>'.ucfirst($title)."</h1>\n"; 321: } else { 322: $title = '<h1>'.&Apache::lonnet::gettitle($self->{'symb'})."</h1>\n"; 323: } 324: $title .= '<h2>'.$self->{'name'}.'@'.$self->{'domain'}."</h2>\n"; 325: $title .= '<h3>'.localtime(time).'</h3>'; 326: # 327: return $title; 328: } 329: 330: sub parent_link { 331: my $self = shift; 332: my $link .= '<p><a href="/adm/studentcalc?'. 333: 'sname='.$self->{'name'}. 334: '&sdomain='.$self->{'domain'}.'">'. 335: 'Student level sheet</a></p>'."\n"; 336: return $link; 337: } 338: 339: sub outsheet_html { 340: my $self = shift; 341: my ($r) = @_; 342: ################################### 343: # Determine table structure 344: ################################### 345: my $num_uneditable = 1; 346: my $num_left = 52-$num_uneditable; 347: my $tableheader =<<"END"; 348: <table border="2"> 349: <tr> 350: <th colspan="2" rowspan="2"><font size="+2">Assessment</font></th> 351: <td bgcolor="#FFDDDD" colspan="$num_uneditable"> </td> 352: <td colspan="$num_left"> 353: <b><font size="+1">Calculations</font></b></td> 354: </tr><tr> 355: END 356: my $label_num = 0; 357: foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ 358: if ($label_num<$num_uneditable) { 359: $tableheader .= '<td bgcolor="#FFDDDD">'; 360: } else { 361: $tableheader .= '<td>'; 362: } 363: $tableheader .= "<b><font size=+1>$_</font></b></td>"; 364: $label_num++; 365: } 366: $tableheader.="</tr>\n"; 367: # 368: $r->print($tableheader); 369: # 370: # Print out template row 371: $r->print('<tr><td>Template</td><td> </td>'. 372: $self->html_template_row($num_uneditable)."</tr>\n"); 373: # 374: # Print out summary/export row 375: $r->print('<tr><td>Export</td><td>0</td>'. 376: $self->html_export_row()."</tr>\n"); 377: # 378: # Prepare to output rows 379: $tableheader =<<"END"; 380: <table border="2"> 381: <tr><th>row</th><th>Item</th> 382: END 383: foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ 384: if ($label_num<$num_uneditable) { 385: $tableheader.='<th bgcolor="#FFDDDD">'; 386: } else { 387: $tableheader.='<th>'; 388: } 389: $tableheader.="<b><font size=+1>$_</font></b></th>"; 390: } 391: # 392: my $num_output = 0; 393: foreach my $rownum ($self->rows()) { 394: if ($num_output++ % 50 == 0) { 395: $r->print("</table>\n".$tableheader); 396: } 397: $r->print('<tr><td>'.$rownum.'</td>'. 398: $self->assess_html_row($num_uneditable,$rownum)."</tr>\n"); 399: } 400: $r->print("</table>\n"); 401: return; 402: } 403: 404: sub assess_html_row { 405: my $self = shift(); 406: my ($num_uneditable,$row) = @_; 407: my $requester_is_student = ($ENV{'request.role'} =~ /^st\./); 408: my $parameter_name = $self->{'formulas'}->{'A'.$row}; 409: my @rowdata = $self->get_row($row); 410: my $num_cols_output = 0; 411: my $row_html; 412: if (exists($nice_parameter_name{$parameter_name})) { 413: my $name = $nice_parameter_name{$parameter_name}; 414: $name =~ s/ /\ /g; 415: $row_html .= '<td>'.$name.'<br />'.$parameter_name.'</td>'; 416: } else { 417: $row_html .= '<td>'.$parameter_name.'</td>'; 418: } 419: foreach my $cell (@rowdata) { 420: if ($requester_is_student || 421: $num_cols_output++ < $num_uneditable) { 422: $row_html .= '<td bgcolor="#FFDDDD">'; 423: $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell,'#FFDDDD'); 424: } else { 425: $row_html .= '<td bgcolor="#EOFFDD">'; 426: $row_html .= &Apache::Spreadsheet::html_editable_cell($cell,'#E0FFDD'); 427: } 428: $row_html .= '</td>'; 429: } 430: return $row_html; 431: } 432: 433: sub outsheet_csv { 434: my $self = shift; 435: my ($r)=@_; 436: } 437: 438: sub outsheet_excel { 439: my $self = shift; 440: my ($r)=@_; 441: } 442: 443: sub display { 444: my $self = shift; 445: my ($r) = @_; 446: $self->compute(); 447: $self->outsheet_html($r); 448: } 449: 450: sub compute { 451: my $self = shift; 452: $self->logthis('computing'); 453: $self->initialize_safe_space(); 454: # 455: # Definitions 456: undef(%nice_parameter_name); 457: my %parameters; # holds underscored parameters by name 458: # 459: # Get the metadata fields and determine their proper names 460: my ($symap,$syid,$srcf)=split(/___/,$self->{'symb'}); 461: my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); 462: foreach my $parm (@Metadata) { 463: next if ($parm !~ /^(resource\.|stores|parameter)_/); 464: my $cleaned_name = $parm; 465: $cleaned_name =~ s/^resource\./stores_/; 466: $cleaned_name =~ s/\./_/g; 467: my $display = &Apache::lonnet::metadata($srcf, 468: $cleaned_name.'.display'); 469: if (! $display) { 470: $display .= &Apache::lonnet::metadata($srcf,$cleaned_name.'.name'); 471: } 472: $parameters{$cleaned_name}++; 473: $nice_parameter_name{$cleaned_name} = $display; 474: } 475: # 476: # Get the values of the metadata fields 477: $self->ensure_current_parameter_caches(); 478: my $filename = $self->{'coursefilename'}.'_parms.db'; 479: if (tie(%parmhash,'GDBM_File', 480: $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { 481: foreach my $parmname (keys(%parameters)) { 482: my $value = $self->parmval($parmname); 483: $parameters{$parmname} =$value; 484: } 485: untie(%parmhash); 486: } else { 487: $self->logthis('unable to tie '.$filename); 488: } 489: # 490: # Clean out unnecessary parameters 491: foreach (keys(%parameters)) { 492: delete($parameters{$_}) if (! /(resource\.|stores_|parameter_)/); 493: } 494: # 495: # Get the students performance data 496: my %student_parameters = 497: &Apache::loncoursedata::get_current_state($self->{'name'}, 498: $self->{'domain'}, 499: $self->{'symb'}, 500: $self->{'cid'}); 501: while (my ($parm,$value) = each(%student_parameters)) { 502: $parm =~ s/^resource\./stores_/; 503: $parm =~ s/\./_/g; 504: $parameters{$parm} = $value; 505: } 506: # 507: # Set up the formulas and parameter values 508: my %f=$self->formulas(); 509: my %c; 510: # 511: while (my ($parm,$value) = each(%parameters)) { 512: my $cell = 'A'.$self->get_row_number_from_key($parm); 513: $f{$cell} = $parm; 514: $c{$parm} = $value; 515: } 516: $self->formulas(%f); 517: $self->constants(%c); 518: $self->calcsheet(); 519: # 520: # Store export row in cache 521: my @exportarray = $self->exportrow(); 522: $Exportrows{$self->{'symb'}}->{'time'} = time; 523: $Exportrows{$self->{'symb'}}->{$self->{'filename'}} = \@exportarray; 524: # 525: # Save the export data 526: $self->save_export_data(); 527: return; 528: } 529: 530: ## 531: ## sett overrides Spreadsheet::sett 532: ## 533: sub sett { 534: my $self = shift; 535: my %t=(); 536: # 537: # Deal with the template row by copying the template formulas into each 538: # row. 539: foreach my $col ($self->template_cells()) { 540: next if ($col=~/^A/); 541: foreach my $row ($self->rows()) { 542: # Get the name of this cell 543: my $cell=$col.$row; 544: # Grab the template declaration 545: $t{$cell}=$self->formula('template_'.$col); 546: # Replace '#' with the row number 547: $t{$cell}=~s/\#/$row/g; 548: # Replace '....' with ',' 549: $t{$cell}=~s/\.\.+/\,/g; 550: # Replace 'A0' with the value from 'A0' 551: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 552: # Replace parameters 553: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 554: } 555: } 556: # 557: # Deal with the cells which have formulas 558: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { 559: next if ($cell =~ /template_/); 560: if ($cell =~ /^A/ && $cell ne 'A0') { 561: if ($formula !~ /^\!/) { 562: $t{$cell}=$self->{'constants'}->{$formula}; 563: } 564: } else { 565: $t{$cell}=$formula; 566: $t{$cell}=~s/\.\.+/\,/g; 567: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 568: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 569: } 570: } 571: # Put %t into the safe space 572: %{$self->{'safe'}->varglob('t')}=%t; 573: } 574: 575: 576: ######################################################## 577: ######################################################## 578: 579: =pod 580: 581: =item &load_cached_export_rows() 582: 583: Retrieves and parsers the export rows of the assessment spreadsheets. 584: These rows are saved in the students directory in the format: 585: 586: sname:sdom:assesscalc:symb.time => time 587: 588: sname:sdom:assesscalc:symb => filename___=___Adata___;___Bdata___;___ ... 589: 590: =cut 591: 592: ######################################################## 593: ######################################################## 594: sub load_cached_export_rows { 595: %Exportrows = undef; 596: &Apache::lonnet::logthis("loading cached assess sheets for $current_name $current_domain"); 597: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. 598: $ENV{'request.course.id'}, 599: $current_domain,$current_name,undef); 600: if ($tmp[0]!~/^error/) { 601: my %tmp = @tmp; 602: my $default_filename = $ENV{'course.'.$ENV{'request.course.id'}. 603: '.spreadsheet_default_assesscalc'}; 604: # We only got one key, so we will access it directly. 605: while (my ($key,$sheetdata) = each(%tmp)) { 606: my ($sname,$sdom,$sheettype,$symb) = split(':',$key); 607: if ($symb =~ /\.time$/) { 608: $symb =~ s/\.time$//; 609: $Exportrows{$symb}->{'time'} = $sheetdata; 610: } else { 611: $sheetdata =~ s/^(.*)___=___//; 612: my $filename = $1; 613: $filename = $default_filename if (! defined($filename)); 614: my @Data = split('___;___',$sheetdata); 615: $Exportrows{$symb}->{$filename} = \@Data; 616: } 617: } 618: } 619: } 620: 621: ############################################# 622: ############################################# 623: 624: =pod 625: 626: =item &export_data 627: 628: Returns the export data associated with the spreadsheet. Computes the 629: spreadsheet only if necessary. 630: 631: =cut 632: 633: ############################################# 634: ############################################# 635: sub export_data { 636: my $self = shift; 637: my $symb = $self->{'symb'}; 638: if (! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) || 639: ! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || 640: ! exists($Exportrows{$symb}->{$self->{'filename'}}) || 641: ! defined($Exportrows{$symb}->{$self->{'filename'}})) { 642: $self->compute(); 643: } 644: my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; 645: if ($Data[0] =~ /^(.*)___=___/) { 646: $self->{'sheetname'} = $1; 647: $Data[0] =~ s/^(.*)___=___//; 648: } 649: for (my $i=0;$i<$#Data;$i++) { 650: $Data[$i]="'".$Data[$i]."'" if ($Data[$i]=~/\D/ && defined($Data[$i])); 651: } 652: return @Data; 653: } 654: 655: ############################################# 656: ############################################# 657: 658: =pod 659: 660: =item &save_export_data() 661: 662: Writes the export data for this spreadsheet to the students cache. 663: 664: =cut 665: 666: ############################################# 667: ############################################# 668: sub save_export_data { 669: my $self = shift; 670: my $student = $self->{'name'}.':'.$self->{'domain'}; 671: my $symb = $self->{'symb'}; 672: if (! exists($Exportrows{$symb}) || 673: ! exists($Exportrows{$symb}->{$self->{'filename'}})) { 674: return; 675: } 676: my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb)); 677: my $timekey = $key.'.time'; 678: my $newstore= join('___;___',@{$Exportrows{$symb}->{$self->{'filename'}}}); 679: $newstore = $self->{'filename'}.'___=___'.$newstore; 680: my $result = &Apache::lonnet::put 681: ('nohist_calculatedsheets_'.$ENV{'request.course.id'}, 682: { $key => $newstore, 683: $timekey => $Exportrows{$symb}->{'time'} }, 684: $self->{'domain'}, 685: $self->{'name'}); 686: 687: return; 688: } 689: 690: 1; 691: 692: __END__