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, 5 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__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>