loncom/interface/spreadsheet/assesscalc.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / assesscalc.pm
Revision 1.33: download - view: text, annotated - select for diffs
Tue Feb 24 20:47:14 2004 UTC (20 years, 2 months ago) by matthew
Branches: MAIN
CVS tags: version_1_2_X, version_1_2_1, version_1_2_0, version_1_1_X, version_1_1_99_5, version_1_1_99_4, version_1_1_99_3, version_1_1_99_2, version_1_1_99_1, version_1_1_99_0, version_1_1_3, version_1_1_2, HEAD

These fixes should go on S10 as soon as possible.

Spreadsheet.pm: Fix to handle the case when a spreadsheet object is
created without a valid username/domain passed to new().

assesscalc.pm: Fix to ignore stored data which does not contain the username
and domain.

lonspreadsheet.pm: Fix to not do stupid things that got us in this mess
in the first place (only accept form parameters which have values and do not
send out form parameters without values).

1: # 2: # $Id: assesscalc.pm,v 1.33 2004/02/24 20:47:14 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 warnings FATAL=>'all'; 48: no warnings 'uninitialized'; 49: use Apache::Constants qw(:common :http); 50: use Apache::lonnet; 51: use Apache::loncommon; 52: use Apache::Spreadsheet; 53: use Apache::loncoursedata(); 54: use HTML::Entities(); 55: use Spreadsheet::WriteExcel; 56: use GDBM_File; 57: use Time::HiRes; 58: use Apache::lonlocal; 59: 60: @Apache::assesscalc::ISA = ('Apache::Spreadsheet'); 61: 62: ######################################################## 63: ######################################################## 64: 65: =pod 66: 67: =head2 Package Variables 68: 69: =over 4 70: 71: =item %Exportrows 72: 73: =item $current_name 74: 75: =item $current_domain 76: 77: =item $current_course 78: 79: =item %parmhash 80: 81: =item %nice_parameter_name 82: 83: =item %useropt 84: 85: =item %courseopt 86: 87: =back 88: 89: =cut 90: 91: ######################################################## 92: ######################################################## 93: 94: my %Exportrows; 95: my %newExportrows; 96: 97: my $current_name; 98: my $current_domain; 99: my $current_course; 100: 101: my %parmhash; 102: my %nice_parameter_name; 103: 104: my %useropt; 105: my %userdata; 106: my %courseopt; 107: 108: ######################################################## 109: ######################################################## 110: 111: =pod 112: 113: =head2 Package Subroutines 114: 115: =item &clear_package() 116: 117: Reset all package variables and clean up caches. 118: 119: =cut 120: 121: ######################################################## 122: ######################################################## 123: sub clear_package { 124: if (defined($current_name) && 125: defined($current_domain) && 126: defined($current_course) && 127: $current_course eq $ENV{'request.course.id'} && 128: %newExportrows) { 129: &save_cached_export_rows($current_name,$current_domain); 130: } 131: undef(%Exportrows); 132: undef(%newExportrows); 133: undef($current_name); 134: undef($current_domain); 135: undef($current_course); 136: undef(%useropt); 137: undef(%userdata); 138: undef(%courseopt); 139: } 140: 141: sub save_cached_export_rows { 142: my ($sname,$sdomain) = @_; 143: my $start = Time::HiRes::time; 144: my $result = &Apache::lonnet::put 145: ('nohist_calculatedsheets_'.$ENV{'request.course.id'}, 146: $newExportrows{$sname.':'.$sdomain}, 147: $sdomain,$sname); 148: delete($newExportrows{$sname.':'.$sdomain}); 149: } 150: 151: sub initialize { 152: &clear_package(); 153: &Apache::loncoursedata::clear_internal_caches(); 154: } 155: 156: ######################################################## 157: ######################################################## 158: 159: =pod 160: 161: =item &initialize_package() 162: 163: =cut 164: 165: ######################################################## 166: ######################################################## 167: sub initialize_package { 168: my ($sname,$sdomain) = @_; 169: $current_name = $sname; 170: $current_domain = $sdomain; 171: undef(%useropt); 172: undef(%userdata); 173: if ($current_course ne $ENV{'request.course.id'}) { 174: $current_course = $ENV{'request.course.id'}; 175: undef(%courseopt); 176: } 177: &load_cached_export_rows(); 178: &load_parameter_caches(); 179: &Apache::loncoursedata::clear_internal_caches(); 180: } 181: 182: 183: ######################################################## 184: ######################################################## 185: 186: =pod 187: 188: =item &load_parameter_caches() 189: 190: =cut 191: 192: ######################################################## 193: ######################################################## 194: sub load_parameter_caches { 195: my $userprefix = $current_name.':'.$current_domain.'_'; 196: $userprefix =~ s/:/_/g; 197: # 198: # Course Parameters Cache 199: if (! %courseopt) { 200: $current_course = $ENV{'request.course.id'}; 201: undef(%courseopt); 202: if (! defined($current_name) || ! defined($current_domain)) { 203: return; 204: } 205: my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; 206: my $id = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; 207: my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id); 208: while (my ($name,$value) = each(%Tmp)) { 209: $courseopt{$name}=$value; 210: } 211: } 212: if (! %useropt) { 213: my %Tmp = &Apache::lonnet::dump('resourcedata', 214: $current_domain,$current_name); 215: while (my ($name,$value) = each(%Tmp)) { 216: if ($name =~ /^error: 2/ || $name =~ /no such file/) { 217: undef(%useropt); 218: last; 219: } 220: $useropt{$userprefix.$name}=$value; 221: } 222: $useropt{'loadtime'} = time; 223: } 224: if (! %userdata) { 225: %userdata = &Apache::loncoursedata::get_current_state($current_name, 226: $current_domain); 227: $userdata{'loadtime'} = time; 228: } 229: return; 230: } 231: 232: ######################################################## 233: ######################################################## 234: 235: =pod 236: 237: =head2 assesscalc object methods 238: 239: =cut 240: 241: ######################################################## 242: ######################################################## 243: sub ensure_current_caches { 244: my $self = shift; 245: ## 246: ## Check for a modified parameters 247: ## 248: if (! defined($current_course) || 249: $current_course ne $ENV{'request.course.id'} ) { 250: $current_course = $ENV{'request.course.id'}; 251: undef(%courseopt); 252: undef(%useropt); 253: undef(%userdata); 254: } 255: ## 256: ## Check for new user 257: ## 258: if (! defined($current_name) || $current_name ne $self->{'name'} || 259: ! defined($current_domain) || $current_domain ne $self->{'domain'}) { 260: $current_domain = $self->{'domain'}; 261: $current_name = $self->{'name'}; 262: undef(%useropt); 263: undef(%userdata); 264: } 265: &load_parameter_caches(); 266: } 267: 268: ################################################## 269: ################################################## 270: 271: =pod 272: 273: =item &parmval() 274: 275: Determine the value of a parameter. 276: 277: Inputs: $what, the parameter needed, $symb, $uname, $udom, $csec 278: 279: Returns: The value of a parameter, or '' if none. 280: 281: This function cascades through the possible levels searching for a value for 282: a parameter. The levels are checked in the following order: 283: user, course (at section level and course level), map, and lonnet::metadata. 284: This function uses %parmhash, which must be tied prior to calling it. 285: This function also requires %courseopt and %useropt to be initialized for 286: this user and course. 287: 288: =cut 289: 290: ################################################## 291: ################################################## 292: sub parmval { 293: my $self = shift; 294: my ($what,$symb,$uname,$udom,$csec,$recurse)=@_; 295: $uname = $self->{'name'} if (! defined($uname)); 296: $udom = $self->{'domain'} if (! defined($udom)); 297: $csec = $self->{'section'} if (! defined($csec)); 298: $symb = $self->{'symb'} if (! defined($symb)); 299: # 300: my $result=''; 301: # 302: # This should be a 303: my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); 304: # Cascading lookup scheme 305: my $rwhat=$what; 306: $what =~ s/^parameter\_//; 307: $what =~ s/\_([^\_]+)$/\.$1/; 308: # 309: my $symbparm = $symb.'.'.$what; 310: my $mapparm = $mapname.'___(all).'.$what; 311: my $courseprefix = $self->{'cid'}; 312: my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'}; 313: # 314: my $seclevel = $courseprefix.'.['.$csec.'].'.$what; 315: my $seclevelr = $courseprefix.'.['.$csec.'].'.$symbparm; 316: my $seclevelm = $courseprefix.'.['.$csec.'].'.$mapparm; 317: # 318: my $courselevel = $courseprefix.'.'.$what; 319: my $courselevelr = $courseprefix.'.'.$symbparm; 320: my $courselevelm = $courseprefix.'.'.$mapparm; 321: # 322: my $ucourselevel = $usercourseprefix.'.'.$what; 323: my $ucourselevelr = $usercourseprefix.'.'.$symbparm; 324: my $ucourselevelm = $usercourseprefix.'.'.$mapparm; 325: # check user 326: if (defined($uname)) { 327: return $useropt{$ucourselevelr} if (defined($useropt{$ucourselevelr})); 328: return $useropt{$ucourselevelm} if (defined($useropt{$ucourselevelm})); 329: return $useropt{$ucourselevel} if (defined($useropt{$ucourselevel})); 330: } 331: # check section 332: if (defined($csec)) { 333: return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); 334: return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); 335: return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); 336: } 337: # 338: # check course 339: return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); 340: return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); 341: return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); 342: # check map parms 343: my $thisparm = $parmhash{$symbparm}; 344: return $thisparm if (defined($thisparm)); 345: # check default 346: $thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default'); 347: return $thisparm if (defined($thisparm)); 348: # 349: # Cascade Up 350: my $space=$what; 351: $space=~s/\.\w+$//; 352: if ($space ne '0') { 353: my @parts=split(/_/,$space); 354: my $id=pop(@parts); 355: my $part=join('_',@parts); 356: if ($part eq '') { $part='0'; } 357: my $newwhat=$rwhat; 358: $newwhat=~s/\Q$space\E/$part/; 359: my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1); 360: if (defined($partgeneral)) { return $partgeneral; } 361: } 362: if ($recurse) { return undef; } 363: my $pack_def=&Apache::lonnet::packages_tab_default($fn,'resource.'.$what); 364: if (defined($pack_def)) { return $pack_def; } 365: #nothing defined 366: return ''; 367: } 368: 369: sub get_html_title { 370: my $self = shift; 371: my ($assess_title,$name,$time) = $self->get_full_title(); 372: my $title = '<h1>'.$assess_title.'</h1>'. 373: '<h2>'.$name.', '. 374: &Apache::loncommon::aboutmewrapper 375: ($self->{'name'}.'@'.$self->{'domain'}, 376: $self->{'name'},$self->{'domain'}); 377: $title .= '<h3>'.$time.'</h3>'; 378: return $title; 379: } 380: 381: sub get_title { 382: my $self = shift; 383: if (($self->{'symb'} eq '_feedback') || 384: ($self->{'symb'} eq '_evaluation') || 385: ($self->{'symb'} eq '_discussion') || 386: ($self->{'symb'} eq '_tutoring')) { 387: my $assess_title = ucfirst($self->{'symb'}); 388: $assess_title =~ s/^_//; 389: return $assess_title; 390: } else { 391: return &Apache::lonnet::gettitle($self->{'symb'}); 392: } 393: } 394: 395: sub get_full_title { 396: my $self = shift; 397: my @title = ($self->get_title()); 398: # Look up the users identifying information 399: # Get the users information 400: my %userenv = &Apache::loncoursedata::GetUserName($self->{'name'}, 401: $self->{'domain'}); 402: my $name = 403: join(' ',@userenv{'firstname','middlename','lastname','generation'}); 404: $name =~ s/\s+$//; 405: push (@title,$name); 406: push (@title,&Apache::lonlocal::locallocaltime(time)); 407: return @title; 408: } 409: 410: sub parent_link { 411: my $self = shift; 412: my $link .= '<p><a href="/adm/studentcalc?'. 413: 'sname='.$self->{'name'}. 414: '&sdomain='.$self->{'domain'}.'">'. 415: &mt('Student level sheet').'</a></p>'."\n"; 416: return $link; 417: } 418: 419: sub outsheet_html { 420: my $self = shift; 421: my ($r) = @_; 422: #################################### 423: # Report any calculation errors # 424: #################################### 425: $r->print($self->html_report_error()); 426: ################################### 427: # Determine table structure 428: ################################### 429: my $importcolor = '#FFFFFF'; 430: my $exportcolor = '#FFFFAA'; 431: my $num_uneditable = 1; 432: my $num_left = 52-$num_uneditable; 433: my %lt=&Apache::lonlocal::texthash( 434: 'as' => 'Assessment', 435: 'ca' => 'Calculations', 436: ); 437: my $tableheader =<<"END"; 438: <table border="2"> 439: <tr> 440: <th colspan="2" rowspan="2"><font size="+2">$lt{'as'}</font></th> 441: <td bgcolor="$importcolor" colspan="$num_uneditable"> </td> 442: <td colspan="$num_left"> 443: <b><font size="+1">$lt{'ca'}</font></b></td> 444: </tr><tr> 445: END 446: my $label_num = 0; 447: foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ 448: if ($label_num<$num_uneditable) { 449: $tableheader .= '<td bgcolor="'.$importcolor.'">'; 450: } else { 451: $tableheader .= '<td>'; 452: } 453: $tableheader .= "<b><font size=+1>$_</font></b></td>"; 454: $label_num++; 455: } 456: $tableheader.="</tr>\n"; 457: # 458: $r->print($tableheader); 459: # 460: # Print out template row 461: $r->print('<tr><td>Template</td><td> </td>'. 462: $self->html_template_row($num_uneditable,$importcolor). 463: "</tr>\n"); 464: # 465: # Print out summary/export row 466: $r->print('<tr><td>Export</td><td>0</td>'. 467: $self->html_export_row($exportcolor)."</tr>\n"); 468: # 469: # Prepare to output rows 470: $tableheader =<<"END"; 471: <table border="2"> 472: <tr><th>row</th><th>Item</th> 473: END 474: foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ 475: if ($label_num<$num_uneditable) { 476: $tableheader.='<th bgcolor="'.$importcolor.'">'; 477: } else { 478: $tableheader.='<th>'; 479: } 480: $tableheader.="<b><font size=+1>$_</font></b></th>"; 481: } 482: # 483: my $num_output = 0; 484: foreach my $rownum (sort {$a <=> $b} ($self->rows())) { 485: if (! $self->parameter_part_is_valid( 486: $self->{'formulas'}->{'A'.$rownum} 487: )) { 488: next; 489: } 490: if ($num_output++ % 50 == 0) { 491: $r->print("</table>\n".$tableheader); 492: } 493: $r->print('<tr><td>'.$rownum.'</td>'. 494: $self->assess_html_row($rownum,$importcolor)."</tr>\n"); 495: } 496: $r->print("</table>\n"); 497: return; 498: } 499: 500: sub assess_html_row { 501: my $self = shift(); 502: my ($row,$importcolor) = @_; 503: my $parameter_name = $self->{'formulas'}->{'A'.$row}; 504: my @rowdata = $self->get_row($row); 505: my $num_cols_output = 0; 506: my $row_html; 507: if (exists($nice_parameter_name{$parameter_name})) { 508: my $name = $nice_parameter_name{$parameter_name}; 509: $name =~ s/ /\ /g; 510: $row_html .= '<td>'.$name.'<br />'.$parameter_name.'</td>'; 511: } else { 512: $row_html .= '<td>'.$parameter_name.'</td>'; 513: } 514: foreach my $cell (@rowdata) { 515: if ($num_cols_output < 1) { 516: $row_html .= '<td bgcolor="'.$importcolor.'">'; 517: $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell, 518: '#FFDDDD'); 519: } else { 520: $row_html .= '<td bgcolor="#EOFFDD">'; 521: $row_html .= &Apache::Spreadsheet::html_editable_cell($cell, 522: '#E0FFDD',1); 523: } 524: $row_html .= '</td>'; 525: $num_cols_output++; 526: } 527: return $row_html; 528: } 529: 530: sub csv_rows { 531: # writes the meat of the spreadsheet to an excel worksheet. Called 532: # by Spreadsheet::outsheet_excel; 533: my $self = shift; 534: my ($connection,$filehandle) = @_; 535: # 536: # Write a header row 537: $self->csv_output_row($filehandle,undef, 538: (&mt('Parameter'),&mt('Description'),&mt('Value'))); 539: # 540: # Write each row 541: foreach my $rownum (sort {$a <=> $b} ($self->rows())) { 542: my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; 543: my $description = ''; 544: if (exists($nice_parameter_name{$parameter_name})) { 545: $description = $nice_parameter_name{$parameter_name}; 546: } 547: $self->csv_output_row($filehandle,$rownum, 548: $parameter_name,$description); 549: } 550: return; 551: } 552: 553: sub excel_rows { 554: # writes the meat of the spreadsheet to an excel worksheet. Called 555: # by Spreadsheet::outsheet_excel; 556: my $self = shift; 557: my ($connection,$worksheet,$cols_output,$rows_output) = @_; 558: return if (! ref($worksheet)); 559: # 560: # Write a header row 561: $cols_output = 0; 562: foreach my $value ('Parameter','Description','Value') { 563: $worksheet->write($rows_output,$cols_output++,$value); 564: } 565: $rows_output++; 566: # 567: # Write each row 568: foreach my $rownum (sort {$a <=> $b} ($self->rows())) { 569: my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; 570: my $description = ''; 571: if (exists($nice_parameter_name{$parameter_name})) { 572: $description = $nice_parameter_name{$parameter_name}; 573: } 574: $self->excel_output_row($worksheet,$rownum,$rows_output++, 575: $parameter_name,$description); 576: } 577: return; 578: } 579: 580: ## 581: ## Routines to support assesscalc::compute 582: ## 583: sub get_parm_names { 584: my $self = shift; 585: my @Mandatory_parameters = @_; 586: my %parameters_and_names; 587: # 588: my ($symap,$syid,$srcf) = &Apache::lonnet::decode_symb($self->{'symb'}); 589: my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); 590: foreach my $parm (@Mandatory_parameters,@Metadata) { 591: next if ($parm !~ /^(resource\.|stores|parameter)_/); 592: my $cleaned_name = $parm; 593: $cleaned_name =~ s/^resource\./stores_/; 594: $cleaned_name =~ s/\./_/g; 595: my $display = &Apache::lonnet::metadata($srcf, 596: $cleaned_name.'.display'); 597: if (! $display) { 598: $display .= &Apache::lonnet::metadata($srcf,$cleaned_name.'.name'); 599: } 600: $parameters_and_names{$cleaned_name}=$display; 601: } 602: return (%parameters_and_names); 603: } 604: 605: sub get_parameter_values { 606: my $self = shift(); 607: my @Parameters; 608: my ($parameters) = @_; 609: if (!ref($parameters)) { 610: @Parameters = @_; 611: } elsif (ref($parameters) eq 'ARRAY') { 612: @Parameters = @$parameters; 613: } elsif (ref($parameters) eq 'HASH') { 614: @Parameters = keys(%$parameters); 615: } 616: # 617: my %parameters; 618: # 619: my $filename = $self->{'coursefilename'}.'_parms.db'; 620: if (tie(%parmhash,'GDBM_File', 621: $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { 622: foreach my $parmname (@Parameters) { 623: my $value = $self->parmval($parmname); 624: $parameters{$parmname} =$value; 625: } 626: untie(%parmhash); 627: } else { 628: $self->logthis('unable to tie '.$filename); 629: } 630: return %parameters; 631: } 632: 633: sub deal_with_export_row { 634: my $self = shift(); 635: my @exportarray = @_; 636: $Exportrows{$self->{'symb'}}->{'time'} = time; 637: $Exportrows{$self->{'symb'}}->{$self->{'filename'}} = \@exportarray; 638: # 639: # Save the export data 640: $self->save_export_data(); 641: return; 642: } 643: 644: sub get_problem_state { 645: my $self = shift; 646: my %student_parameters; 647: if (exists($userdata{$self->{'symb'}}) && 648: ref($userdata{$self->{'symb'}}) eq 'HASH') { 649: %student_parameters = %{$userdata{$self->{'symb'}}}; 650: } 651: return %student_parameters; 652: } 653: 654: sub determine_parts { 655: my $self = shift; 656: if (exists($self->{'Parts'}) && ref($self->{'Parts'}) eq 'HASH') { 657: return; 658: } 659: my (undef,undef,$url) = &Apache::lonnet::decode_symb($self->{'symb'}); 660: my $src = &Apache::lonnet::clutter($url); 661: return if (! defined($src)); 662: my %Parts; 663: my $metadata = &Apache::lonnet::metadata($src,'packages'); 664: foreach (split(',',$metadata)) { 665: my ($part) = (/^part_(.*)$/); 666: if (defined($part) && 667: ! &Apache::loncommon::check_if_partid_hidden 668: ($part,$self->{'symb'},$self->{'name'},$self->{'domain'}) 669: ) { 670: $Parts{$part}++; 671: } 672: } 673: # Make sure part 0 is defined. 674: $Parts{'0'}++; 675: $self->{'Parts'} = \%Parts; 676: return; 677: } 678: 679: sub parameter_part_is_valid { 680: my $self = shift; 681: my ($parameter) = @_; 682: return 1 if ($parameter eq 'timestamp'); 683: if (! defined($self->{'Parts'}) || 684: ! ref ($self->{'Parts'}) || 685: ref($self->{'Parts'}) ne 'HASH') { 686: return 1; 687: } 688: # 689: my (undef,$part) = 690: ($parameter =~ m/^(resource|stores|parameter)_([^_]+)_.*/); 691: if (exists($self->{'Parts'}) && 692: exists($self->{'Parts'}->{$part}) && 693: $self->{'Parts'}->{$part} ) { 694: return 1; 695: } else { 696: return 0; 697: } 698: } 699: 700: sub compute { 701: my $self = shift; 702: my ($r) = @_; 703: my $connection = $r->connection(); 704: if ($connection->aborted()) { $self->cleanup(); return; } 705: $self->initialize_safe_space(); 706: ######################################### 707: ######################################### 708: ### ### 709: ### Retrieve the problem parameters ### 710: ### ### 711: ######################################### 712: ######################################### 713: my @Mandatory_parameters = ("stores_0_solved", 714: "stores_0_awarddetail", 715: "stores_0_awarded", 716: "timestamp", 717: "stores_0_tries", 718: "stores_0_award"); 719: # 720: # Definitions 721: undef(%nice_parameter_name); 722: my %parameters; # holds underscored parameters by name 723: # 724: # Get the metadata fields and determine their proper names 725: my %nice_parm_names = $self->get_parm_names(@Mandatory_parameters); 726: while (my($cleaned_name,$display) = each(%nice_parm_names)) { 727: $parameters{$cleaned_name}++; 728: $nice_parameter_name{$cleaned_name} = $display; 729: } 730: # 731: # Get the values of the metadata fields 732: if ($connection->aborted()) { $self->cleanup(); return; } 733: $self->ensure_current_caches(); 734: if ($connection->aborted()) { $self->cleanup(); return; } 735: %parameters = $self->get_parameter_values(keys(%parameters)); 736: if ($connection->aborted()) { $self->cleanup(); return; } 737: # 738: # Clean out unnecessary parameters 739: foreach (keys(%parameters)) { 740: delete($parameters{$_}) if (! /(resource\.|stores_|parameter_)/); 741: } 742: # 743: # Get the students performance data 744: my %student_parameters = $self->get_problem_state(); 745: while (my ($parm,$value) = each(%student_parameters)) { 746: $parm =~ s/^resource\./stores_/; 747: $parm =~ s/\./_/g; 748: $parameters{$parm} = $value; 749: } 750: # 751: # Clean out any bad parameters 752: $self->determine_parts(); 753: foreach my $param (keys(%parameters)) { 754: if (! $self->parameter_part_is_valid($param)) { 755: delete ($parameters{$param}); 756: } 757: } 758: # 759: # Set up the formulas and parameter values 760: my %f=$self->formulas(); 761: my %c; 762: # 763: # Check for blackout requirements 764: if ((!exists($ENV{'request.role.adv'}) || !$ENV{'request.role.adv'})) { 765: while (my ($parm,$value) = each(%parameters)) { 766: last if ($self->blackout()); 767: next if ($parm !~ /^(parameter_.*)_problemstatus$/); 768: if ($parameters{$1.'_answerdate'} ne '' && 769: $parameters{$1.'_answerdate'} < time) { 770: next; 771: } 772: if (lc($value) eq 'no') { 773: # We must blackout this sheet 774: $self->blackout(1); 775: } 776: } 777: } 778: if ($connection->aborted()) { $self->cleanup(); return; } 779: # 780: # Move the parameters into the spreadsheet 781: while (my ($parm,$value) = each(%parameters)) { 782: my $cell = 'A'.$self->get_row_number_from_key($parm); 783: $f{$cell} = $parm; 784: if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { 785: $value = 'witheld'; 786: } 787: $value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); 788: $c{$parm} = $value; 789: } 790: $self->formulas(\%f); 791: $self->constants(\%c); 792: if ($connection->aborted()) { $self->cleanup(); return; } 793: $self->calcsheet(); 794: # 795: # Store export row in cache 796: my @exportarray = $self->exportrow(); 797: $self->deal_with_export_row(@exportarray); 798: $self->save() if ($self->need_to_save()); 799: if ($connection->aborted()) { $self->cleanup(); return; } 800: return; 801: } 802: 803: ## 804: ## sett overrides Spreadsheet::sett 805: ## 806: sub sett { 807: my $self = shift; 808: my %t=(); 809: # 810: # Deal with the template row by copying the template formulas into each 811: # row. 812: foreach my $col ($self->template_cells()) { 813: next if ($col=~/^A/); 814: foreach my $row ($self->rows()) { 815: # Get the name of this cell 816: my $cell=$col.$row; 817: # Grab the template declaration 818: $t{$cell}=$self->formula('template_'.$col); 819: # Replace '#' with the row number 820: $t{$cell}=~s/\#/$row/g; 821: # Replace '....' with ',' 822: $t{$cell}=~s/\.\.+/\,/g; 823: # Replace 'A0' with the value from 'A0' 824: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 825: # Replace parameters 826: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 827: } 828: } 829: # 830: # Deal with the cells which have formulas 831: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { 832: next if ($cell =~ /template_/); 833: if ($cell =~ /^A/ && $cell ne 'A0') { 834: if ($formula !~ /^\!/) { 835: $t{$cell}=$self->{'constants'}->{$formula}; 836: } 837: } else { 838: $t{$cell}=$formula; 839: $t{$cell}=~s/\.\.+/\,/g; 840: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 841: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 842: } 843: } 844: # Put %t into the safe space 845: %{$self->{'safe'}->varglob('t')}=%t; 846: } 847: 848: 849: ######################################################## 850: ######################################################## 851: 852: =pod 853: 854: =item &load_cached_export_rows() 855: 856: Retrieves and parsers the export rows of the assessment spreadsheets. 857: These rows are saved in the students directory in the format: 858: 859: sname:sdom:assesscalc:symb.time => time 860: 861: sname:sdom:assesscalc:symb => filename___=___Adata___;___Bdata___;___ ... 862: 863: =cut 864: 865: ######################################################## 866: ######################################################## 867: sub load_cached_export_rows { 868: undef(%Exportrows); 869: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. 870: $ENV{'request.course.id'}, 871: $current_domain,$current_name,undef); 872: if ($tmp[0]!~/^error/) { 873: my %tmp = @tmp; 874: my $default_filename = $ENV{'course.'.$ENV{'request.course.id'}. 875: '.spreadsheet_default_assesscalc'}; 876: # We only got one key, so we will access it directly. 877: while (my ($key,$sheetdata) = each(%tmp)) { 878: my ($sname,$sdom,$sheettype,$symb) = split(':',$key); 879: if (! defined($sname) || $sname eq '' || 880: ! defined($sdom) || $sdom eq '' ) { 881: next; 882: } 883: if ($symb =~ /\.time$/) { 884: $symb =~ s/\.time$//; 885: $Exportrows{$symb}->{'time'} = $sheetdata; 886: } else { 887: $sheetdata =~ s/^(.*)___=___//; 888: my $filename = $1; 889: $filename = $default_filename if (! defined($filename)); 890: my @Data = split('___;___',$sheetdata); 891: $Exportrows{$symb}->{$filename} = \@Data; 892: } 893: } 894: } 895: } 896: 897: ############################################# 898: ############################################# 899: 900: =pod 901: 902: =item &export_data 903: 904: Returns the export data associated with the spreadsheet. Computes the 905: spreadsheet only if necessary. 906: 907: =cut 908: 909: ############################################# 910: ############################################# 911: sub export_data { 912: my $self = shift; 913: my ($r) = @_; 914: my $connection = $r->connection(); 915: my $symb = $self->{'symb'}; 916: if (! exists($ENV{'request.role.adv'}) || ! $ENV{'request.role.adv'} || 917: ! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) || 918: ! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || 919: ! exists($Exportrows{$symb}->{$self->{'filename'}}) || 920: ! defined($Exportrows{$symb}->{$self->{'filename'}}) || 921: ! ref($Exportrows{$symb}->{$self->{'filename'}}) 922: ) { 923: $self->compute($r); 924: } 925: if ($connection->aborted()) { $self->cleanup(); return; } 926: my @Data; 927: if ($self->badcalc()) { 928: @Data = (); 929: } else { 930: @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; 931: if ($Data[0] =~ /^(.*)___=___/) { 932: $self->{'sheetname'} = $1; 933: $Data[0] =~ s/^(.*)___=___//; 934: } 935: for (my $i=0;$i<$#Data;$i++) { 936: if ($Data[$i]=~/\D/ && defined($Data[$i])) { 937: $Data[$i]="'".$Data[$i]."'"; 938: } 939: } 940: } 941: return @Data; 942: } 943: 944: ############################################# 945: ############################################# 946: 947: =pod 948: 949: =item &save_export_data() 950: 951: Writes the export data for this spreadsheet to the students cache. 952: 953: =cut 954: 955: ############################################# 956: ############################################# 957: sub save_export_data { 958: my $self = shift; 959: return if ($self->temporary()); 960: my $student = $self->{'name'}.':'.$self->{'domain'}; 961: my $symb = $self->{'symb'}; 962: if ($self->badcalc()){ 963: # do not save data away when calculations have not been done properly. 964: delete($Exportrows{$symb}); 965: return; 966: } 967: if (! exists($Exportrows{$symb}) || 968: ! exists($Exportrows{$symb}->{$self->{'filename'}})) { 969: return; 970: } 971: my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb)); 972: my $timekey = $key.'.time'; 973: my $newstore= join('___;___', 974: map {s/[^[:print:]]//g;$_;} # strip out unprintable 975: @{$Exportrows{$symb}->{$self->{'filename'}}}); 976: $newstore = $self->{'filename'}.'___=___'.$newstore; 977: $newExportrows{$student}->{$key} = $newstore; 978: $newExportrows{$student}->{$timekey} = $Exportrows{$symb}->{'time'}; 979: return; 980: } 981: 982: 1; 983: 984: __END__