loncom/interface/spreadsheet/assesscalc.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / assesscalc.pm
Revision 1.53: download - view: text, annotated - select for diffs
Mon May 1 06:17:16 2006 UTC (18 years, 2 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

Determination of parameters for spreadsheet now correctly cascades for cases where a user has multiple active groups. Also groups are passed in argument list for Spreadsheet object as array reference. Lastly lonnet::get_users_groups function modified to only return user's active groups, except in case when user status has expired (and default end access date for students has also passed), in which case user's groups which were still active less than 24 hours before default end date are also included in user's groups. [For consistency with students groups returned by loncoursedata::get_students_groups()].

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