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