loncom/interface/spreadsheet/assesscalc.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / assesscalc.pm
Revision 1.50: download - view: text, annotated - select for diffs
Tue May 17 20:14:19 2005 UTC (19 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: version_2_0_2, version_2_0_1, version_2_0_0, version_1_99_3, version_1_99_2, version_1_99_1_tmcc, version_1_99_1, version_1_99_0, HEAD

- remove any formulas that don't have an associated const

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