Annotation of loncom/interface/spreadsheet/assesscalc.pm, revision 1.1

1.1     ! matthew     1: #
        !             2: # $Id$
        !             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 Apache::Constants qw(:common :http);
        !            48: use Apache::lonnet;
        !            49: use Apache::Spreadsheet;
        !            50: use HTML::Entities();
        !            51: use Spreadsheet::WriteExcel;
        !            52: use GDBM_File;
        !            53: use Time::HiRes;
        !            54: 
        !            55: @Apache::assesscalc::ISA = ('Apache::Spreadsheet');
        !            56: 
        !            57: ########################################################
        !            58: ########################################################
        !            59: 
        !            60: =pod
        !            61: 
        !            62: =head2 Package Variables
        !            63: 
        !            64: =over 4
        !            65: 
        !            66: =item %Exportrows
        !            67: 
        !            68: =item $current_name
        !            69: 
        !            70: =item $current_domain
        !            71: 
        !            72: =item $current_course
        !            73: 
        !            74: =item %parmhash
        !            75: 
        !            76: =item %nice_parameter_name
        !            77: 
        !            78: =item %useropt
        !            79: 
        !            80: =item %courseopt
        !            81: 
        !            82: =back 
        !            83: 
        !            84: =cut
        !            85: 
        !            86: ########################################################
        !            87: ########################################################
        !            88: 
        !            89: my %Exportrows;
        !            90: 
        !            91: my $current_name;
        !            92: my $current_domain;
        !            93: my $current_course;
        !            94: 
        !            95: my %parmhash;
        !            96: my %nice_parameter_name;
        !            97: 
        !            98: my %useropt;
        !            99: my %courseopt;
        !           100: 
        !           101: ########################################################
        !           102: ########################################################
        !           103: 
        !           104: =pod
        !           105: 
        !           106: =head2 Package Subroutines
        !           107: 
        !           108: =item &clear_package()
        !           109: 
        !           110: Reset all package variables.  
        !           111: 
        !           112: =cut
        !           113: 
        !           114: ########################################################
        !           115: ########################################################
        !           116: sub clear_package {
        !           117:     undef(%Exportrows);
        !           118:     undef($current_name);
        !           119:     undef($current_domain);
        !           120:     undef($current_course);
        !           121:     undef(%useropt);
        !           122:     undef(%courseopt);
        !           123: }
        !           124: 
        !           125: ########################################################
        !           126: ########################################################
        !           127: 
        !           128: =pod
        !           129: 
        !           130: =item &initialize_package()
        !           131: 
        !           132: =cut
        !           133: 
        !           134: ########################################################
        !           135: ########################################################
        !           136: sub initialize_package {
        !           137:     my ($sname,$sdomain) = @_;
        !           138:     $current_course = $ENV{'request.course.id'};
        !           139:     $current_name   = $sname;
        !           140:     $current_domain = $sdomain;
        !           141:     undef(%courseopt);
        !           142:     &load_cached_export_rows();
        !           143:     &load_parameter_caches();
        !           144: }
        !           145: 
        !           146: ########################################################
        !           147: ########################################################
        !           148: 
        !           149: =pod
        !           150: 
        !           151: =item &load_parameter_caches()
        !           152: 
        !           153: =cut
        !           154: 
        !           155: ########################################################
        !           156: ########################################################
        !           157: sub load_parameter_caches {
        !           158:     my $userprefix = $current_name.':'.$current_domain.'_';
        !           159:     $userprefix =~ s/:/_/g;
        !           160:     #
        !           161:     # Course Parameters Cache
        !           162:     if (! %courseopt) {
        !           163:         &Apache::lonnet::logthis("loading course options");
        !           164:         $current_course = $ENV{'request.course.id'};
        !           165:         undef(%courseopt);
        !           166:         if (! defined($current_name) || ! defined($current_domain)) {
        !           167:             &Apache::lonnet::logthis('bad call to setup_parameter_caches');
        !           168:             return;
        !           169:         }
        !           170:         my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
        !           171:         my $id  = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
        !           172:         my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id);
        !           173:         while (my ($name,$value) = each(%Tmp)) {
        !           174:             $courseopt{$userprefix.$name}=$value;
        !           175:         }
        !           176:     }
        !           177:     if (! %useropt) {
        !           178:         my %Tmp = &Apache::lonnet::dump('resourcedata',
        !           179:                                         $current_domain,$current_name);
        !           180:         while (my ($name,$value) = each(%Tmp)) {
        !           181:             if ($name =~ /^error: 2/ || $name =~ /no such file/) {
        !           182:                 undef(%useropt);
        !           183:                 last;
        !           184:             }
        !           185:             $useropt{$userprefix.$name}=$value;
        !           186:         }
        !           187:     }
        !           188: }
        !           189: 
        !           190: ########################################################
        !           191: ########################################################
        !           192: 
        !           193: =pod
        !           194: 
        !           195: =head2 assesscalc object methods
        !           196: 
        !           197: =cut
        !           198: 
        !           199: ########################################################
        !           200: ########################################################
        !           201: 
        !           202: sub ensure_current_parameter_caches {
        !           203:     my $self = shift;
        !           204:     if (! defined($current_course) || 
        !           205:         $current_course ne $ENV{'request.course.id'} ) {
        !           206:         $current_course = $ENV{'request.course.id'};
        !           207:         undef(%courseopt); 
        !           208:     }
        !           209:     if (! defined($current_name)   || $current_name ne $self->{'name'} ||
        !           210:         ! defined($current_domain) || $current_domain ne $self->{'domain'}) {
        !           211:         $current_domain = $self->{'domain'};
        !           212:         $current_name   = $self->{'name'};
        !           213:         undef(%useropt);
        !           214:     }
        !           215:     &load_parameter_caches();
        !           216: }
        !           217: 
        !           218: ##################################################
        !           219: ##################################################
        !           220: 
        !           221: =pod
        !           222: 
        !           223: =item &parmval()
        !           224: 
        !           225: Determine the value of a parameter.
        !           226: 
        !           227: Inputs: $what, the parameter needed, $symb, $uname, $udom, $csec 
        !           228: 
        !           229: Returns: The value of a parameter, or '' if none.
        !           230: 
        !           231: This function cascades through the possible levels searching for a value for
        !           232: a parameter.  The levels are checked in the following order:
        !           233: user, course (at section level and course level), map, and lonnet::metadata.
        !           234: This function uses %parmhash, which must be tied prior to calling it.
        !           235: This function also requires %courseopt and %useropt to be initialized for
        !           236: this user and course.
        !           237: 
        !           238: =cut
        !           239: 
        !           240: ##################################################
        !           241: ##################################################
        !           242: sub parmval {
        !           243:     my $self = shift;
        !           244:     my ($what,$symb,$uname,$udom,$csec)=@_;
        !           245:     $uname = $self->{'name'}    if (! defined($uname));
        !           246:     $udom  = $self->{'domain'}  if (! defined($udom));
        !           247:     $csec  = $self->{'section'} if (! defined($csec));
        !           248:     $symb  = $self->{'symb'}    if (! defined($symb));
        !           249:     #
        !           250:     my $result='';
        !           251:     #
        !           252:     # This should be a 
        !           253:     my ($mapname,$id,$fn)=split(/___/,$symb);
        !           254:     # Cascading lookup scheme
        !           255:     my $rwhat=$what;
        !           256:     $what =~ s/^parameter\_//;
        !           257:     $what =~ s/\_([^\_]+)$/\.$1/;
        !           258:     #
        !           259:     my $symbparm = $symb.'.'.$what;
        !           260:     my $mapparm  = $mapname.'___(all).'.$what;
        !           261:     my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'};
        !           262:     #
        !           263:     my $seclevel  = $usercourseprefix.'.['.$csec.'].'.$what;
        !           264:     my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
        !           265:     my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
        !           266:     #
        !           267:     my $courselevel  = $usercourseprefix.'.'.$what;
        !           268:     my $courselevelr = $usercourseprefix.'.'.$symbparm;
        !           269:     my $courselevelm = $usercourseprefix.'.'.$mapparm;
        !           270:    # check user
        !           271:     if (defined($uname)) {
        !           272:         return $useropt{$courselevelr} if (defined($useropt{$courselevelr}));
        !           273:         return $useropt{$courselevelm} if (defined($useropt{$courselevelm}));
        !           274:         return $useropt{$courselevel}  if (defined($useropt{$courselevel}));
        !           275:     }
        !           276:     # check section
        !           277:     if (defined($csec)) {
        !           278:         return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr}));
        !           279:         return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm}));
        !           280:         return $courseopt{$seclevel}  if (defined($courseopt{$seclevel}));
        !           281:     }
        !           282:     #
        !           283:     # check course
        !           284:     return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr}));
        !           285:     return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm}));
        !           286:     return $courseopt{$courselevel}  if (defined($courseopt{$courselevel}));
        !           287:     # check map parms
        !           288:     my $thisparm = $parmhash{$symbparm};
        !           289:     return $thisparm if (defined($thisparm));
        !           290:     # check default
        !           291:     $thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default');
        !           292:     return $thisparm if (defined($thisparm));
        !           293:     #
        !           294:     # Cascade Up
        !           295:     my $space=$what;
        !           296:     $space=~s/\.\w+$//;
        !           297:     if ($space ne '0') {
        !           298: 	my @parts=split(/_/,$space);
        !           299: 	my $id=pop(@parts);
        !           300: 	my $part=join('_',@parts);
        !           301: 	if ($part eq '') { $part='0'; }
        !           302: 	my $newwhat=$rwhat;
        !           303: 	$newwhat=~s/\Q$space\E/$part/;
        !           304: 	my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec);
        !           305: 	if (defined($partgeneral)) { return $partgeneral; }
        !           306:     }
        !           307:     #nothing defined
        !           308:     return '';
        !           309: }
        !           310: 
        !           311: sub get_title {
        !           312:     my $self = shift;
        !           313:     my $title;
        !           314:     if (($self->{'usymb'} eq '_feedback') ||
        !           315:         ($self->{'usymb'} eq '_evaluation') ||
        !           316:         ($self->{'usymb'} eq '_discussion') ||
        !           317:         ($self->{'usymb'} eq '_tutoring')) {
        !           318:         $title = $self->{'usymb'};
        !           319:         $title =~ s/^_//;
        !           320:         $title = '<h1>'.ucfirst($title)."</h1>\n";
        !           321:     } else {
        !           322:         $title = '<h1>'.&Apache::lonnet::gettitle($self->{'symb'})."</h1>\n";
        !           323:     }
        !           324:     $title .= '<h2>'.$self->{'name'}.'@'.$self->{'domain'}."</h2>\n";
        !           325:     $title .= '<h3>'.localtime(time).'</h3>';
        !           326:     #
        !           327:     return $title;
        !           328: }
        !           329: 
        !           330: sub parent_link {
        !           331:     my $self = shift;
        !           332:     my $link .= '<p><a href="/adm/studentcalc?'.
        !           333:         'sname='.$self->{'name'}.
        !           334:             '&sdomain='.$self->{'domain'}.'">'.
        !           335:                 'Student level sheet</a></p>'."\n";
        !           336:     return $link;
        !           337: }
        !           338: 
        !           339: sub outsheet_html {
        !           340:     my $self = shift;
        !           341:     my ($r) = @_;
        !           342:     ###################################
        !           343:     # Determine table structure
        !           344:     ###################################
        !           345:     my $num_uneditable = 1;
        !           346:     my $num_left = 52-$num_uneditable;
        !           347:     my $tableheader =<<"END";
        !           348: <table border="2">
        !           349: <tr>
        !           350:   <th colspan="2" rowspan="2"><font size="+2">Assessment</font></th>
        !           351:   <td bgcolor="#FFDDDD" colspan="$num_uneditable">&nbsp;</td>
        !           352:   <td colspan="$num_left">
        !           353:       <b><font size="+1">Calculations</font></b></td>
        !           354: </tr><tr>
        !           355: END
        !           356:     my $label_num = 0;
        !           357:     foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
        !           358:         if ($label_num<$num_uneditable) { 
        !           359:             $tableheader .= '<td bgcolor="#FFDDDD">';
        !           360:         } else {
        !           361:             $tableheader .= '<td>';
        !           362:         }
        !           363:         $tableheader .= "<b><font size=+1>$_</font></b></td>";
        !           364:         $label_num++;
        !           365:     }
        !           366:     $tableheader.="</tr>\n";
        !           367:     #
        !           368:     $r->print($tableheader);
        !           369:     #
        !           370:     # Print out template row
        !           371:     $r->print('<tr><td>Template</td><td>&nbsp;</td>'.
        !           372: 	      $self->html_template_row($num_uneditable)."</tr>\n");
        !           373:     #
        !           374:     # Print out summary/export row
        !           375:     $r->print('<tr><td>Export</td><td>0</td>'.
        !           376: 	      $self->html_export_row()."</tr>\n");
        !           377:     #
        !           378:     # Prepare to output rows
        !           379:     $tableheader =<<"END";
        !           380: <table border="2">
        !           381: <tr><th>row</th><th>Item</th>
        !           382: END
        !           383:     foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
        !           384: 	if ($label_num<$num_uneditable) { 
        !           385:             $tableheader.='<th bgcolor="#FFDDDD">';
        !           386:         } else {
        !           387:             $tableheader.='<th>';
        !           388:         }
        !           389:         $tableheader.="<b><font size=+1>$_</font></b></th>";
        !           390:     }
        !           391:     #
        !           392:     my $num_output = 0;
        !           393:     foreach my $rownum ($self->rows()) {
        !           394: 	if ($num_output++ % 50 == 0) {
        !           395: 	    $r->print("</table>\n".$tableheader);
        !           396: 	}
        !           397: 	$r->print('<tr><td>'.$rownum.'</td>'.
        !           398:                   $self->assess_html_row($num_uneditable,$rownum)."</tr>\n");
        !           399:     }
        !           400:     $r->print("</table>\n");
        !           401:     return;
        !           402: }
        !           403: 
        !           404: sub assess_html_row {
        !           405:     my $self = shift();
        !           406:     my ($num_uneditable,$row) = @_;
        !           407:     my $requester_is_student = ($ENV{'request.role'} =~ /^st\./);
        !           408:     my $parameter_name = $self->{'formulas'}->{'A'.$row};
        !           409:     my @rowdata = $self->get_row($row);
        !           410:     my $num_cols_output = 0;
        !           411:     my $row_html;
        !           412:     if (exists($nice_parameter_name{$parameter_name})) {
        !           413:         my $name = $nice_parameter_name{$parameter_name};
        !           414:         $name =~ s/ /\&nbsp;/g;
        !           415:         $row_html .= '<td>'.$name.'<br />'.$parameter_name.'</td>';
        !           416:     } else {
        !           417:         $row_html .= '<td>'.$parameter_name.'</td>';
        !           418:     }
        !           419:     foreach my $cell (@rowdata) {
        !           420: 	if ($requester_is_student || 
        !           421: 	    $num_cols_output++ < $num_uneditable) {
        !           422: 	    $row_html .= '<td bgcolor="#FFDDDD">';
        !           423: 	    $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell,'#FFDDDD');
        !           424: 	} else {
        !           425: 	    $row_html .= '<td bgcolor="#EOFFDD">';
        !           426: 	    $row_html .= &Apache::Spreadsheet::html_editable_cell($cell,'#E0FFDD');
        !           427: 	}
        !           428: 	$row_html .= '</td>';
        !           429:     }
        !           430:     return $row_html;
        !           431: }
        !           432: 
        !           433: sub outsheet_csv {
        !           434:     my $self = shift;
        !           435:     my ($r)=@_;
        !           436: }
        !           437: 
        !           438: sub outsheet_excel {
        !           439:     my $self = shift;
        !           440:     my ($r)=@_;
        !           441: }
        !           442: 
        !           443: sub display {
        !           444:     my $self = shift;
        !           445:     my ($r) = @_;
        !           446:     $self->compute();
        !           447:     $self->outsheet_html($r);
        !           448: }
        !           449: 
        !           450: sub compute {
        !           451:     my $self = shift;
        !           452:     $self->logthis('computing');
        !           453:     $self->initialize_safe_space();
        !           454:     #
        !           455:     # Definitions
        !           456:     undef(%nice_parameter_name);
        !           457:     my %parameters;   # holds underscored parameters by name
        !           458:     #
        !           459:     # Get the metadata fields and determine their proper names
        !           460:     my ($symap,$syid,$srcf)=split(/___/,$self->{'symb'});
        !           461:     my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
        !           462:     foreach my $parm (@Metadata) {
        !           463:         next if ($parm !~ /^(resource\.|stores|parameter)_/);
        !           464:         my $cleaned_name = $parm;
        !           465:         $cleaned_name =~ s/^resource\./stores_/;
        !           466:         $cleaned_name =~ s/\./_/g;
        !           467:         my $display = &Apache::lonnet::metadata($srcf,
        !           468:                                                 $cleaned_name.'.display');
        !           469:         if (! $display) {
        !           470:             $display .= &Apache::lonnet::metadata($srcf,$cleaned_name.'.name');
        !           471:         }
        !           472:         $parameters{$cleaned_name}++;
        !           473:         $nice_parameter_name{$cleaned_name} = $display;
        !           474:     }
        !           475:     #
        !           476:     # Get the values of the metadata fields
        !           477:     $self->ensure_current_parameter_caches();
        !           478:     my $filename = $self->{'coursefilename'}.'_parms.db';
        !           479:     if (tie(%parmhash,'GDBM_File',
        !           480:             $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
        !           481:         foreach my $parmname (keys(%parameters)) {
        !           482:             my $value =  $self->parmval($parmname);
        !           483:             $parameters{$parmname} =$value;
        !           484:         }
        !           485:         untie(%parmhash);
        !           486:     } else {
        !           487:         $self->logthis('unable to tie '.$filename);
        !           488:     }
        !           489:     #
        !           490:     # Clean out unnecessary parameters
        !           491:     foreach (keys(%parameters)) {
        !           492:         delete($parameters{$_}) if (! /(resource\.|stores_|parameter_)/);
        !           493:     }
        !           494:     #
        !           495:     # Get the students performance data
        !           496:     my %student_parameters = 
        !           497:         &Apache::loncoursedata::get_current_state($self->{'name'},
        !           498:                                                   $self->{'domain'},
        !           499:                                                   $self->{'symb'},
        !           500:                                                   $self->{'cid'});
        !           501:     while (my ($parm,$value) = each(%student_parameters)) {
        !           502:         $parm =~ s/^resource\./stores_/;
        !           503:         $parm =~ s/\./_/g;
        !           504:         $parameters{$parm} = $value;
        !           505:     }
        !           506:     #
        !           507:     # Set up the formulas and parameter values
        !           508:     my %f=$self->formulas();
        !           509:     my %c;
        !           510:     #
        !           511:     while (my ($parm,$value) = each(%parameters)) {
        !           512:         my $cell = 'A'.$self->get_row_number_from_key($parm);
        !           513:         $f{$cell} = $parm;
        !           514:         $c{$parm} = $value;
        !           515:     }
        !           516:     $self->formulas(%f);
        !           517:     $self->constants(%c);
        !           518:     $self->calcsheet();
        !           519:     #
        !           520:     # Store export row in cache
        !           521:     my @exportarray = $self->exportrow();
        !           522:     $Exportrows{$self->{'symb'}}->{'time'} = time;
        !           523:     $Exportrows{$self->{'symb'}}->{$self->{'filename'}} = \@exportarray;
        !           524:     #
        !           525:     # Save the export data
        !           526:     $self->save_export_data();
        !           527:     return;
        !           528: }
        !           529: 
        !           530: ##
        !           531: ## sett overrides Spreadsheet::sett
        !           532: ##
        !           533: sub sett {
        !           534:     my $self = shift;
        !           535:     my %t=();
        !           536:     #
        !           537:     # Deal with the template row by copying the template formulas into each
        !           538:     # row.
        !           539:     foreach my $col ($self->template_cells()) {
        !           540:         next if ($col=~/^A/);
        !           541:         foreach my $row ($self->rows()) {
        !           542:             # Get the name of this cell
        !           543:             my $cell=$col.$row;
        !           544:             # Grab the template declaration
        !           545:             $t{$cell}=$self->formula('template_'.$col);
        !           546:             # Replace '#' with the row number
        !           547:             $t{$cell}=~s/\#/$row/g;
        !           548:             # Replace '....' with ','
        !           549:             $t{$cell}=~s/\.\.+/\,/g;
        !           550:             # Replace 'A0' with the value from 'A0'
        !           551:             $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
        !           552:             # Replace parameters
        !           553:             $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
        !           554:         }
        !           555:     }
        !           556:     #
        !           557:     # Deal with the cells which have formulas
        !           558:     while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
        !           559: 	next if ($cell =~ /template_/);
        !           560:         if ($cell =~ /^A/ && $cell ne 'A0') {
        !           561:             if ($formula !~ /^\!/) {
        !           562:                 $t{$cell}=$self->{'constants'}->{$formula};
        !           563:             }
        !           564:         } else {
        !           565:             $t{$cell}=$formula;
        !           566:             $t{$cell}=~s/\.\.+/\,/g;
        !           567:             $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
        !           568:             $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
        !           569:         }
        !           570:     }
        !           571:     # Put %t into the safe space
        !           572:     %{$self->{'safe'}->varglob('t')}=%t;
        !           573: }
        !           574: 
        !           575: 
        !           576: ########################################################
        !           577: ########################################################
        !           578: 
        !           579: =pod
        !           580: 
        !           581: =item &load_cached_export_rows()
        !           582: 
        !           583: Retrieves and parsers the export rows of the assessment spreadsheets.
        !           584: These rows are saved in the students directory in the format:
        !           585: 
        !           586:  sname:sdom:assesscalc:symb.time => time
        !           587: 
        !           588:  sname:sdom:assesscalc:symb => filename___=___Adata___;___Bdata___;___ ...
        !           589: 
        !           590: =cut
        !           591: 
        !           592: ########################################################
        !           593: ########################################################
        !           594: sub load_cached_export_rows {
        !           595:     %Exportrows = undef;
        !           596:     &Apache::lonnet::logthis("loading cached assess sheets for $current_name $current_domain");
        !           597:     my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'.
        !           598:                                     $ENV{'request.course.id'},
        !           599:                                     $current_domain,$current_name,undef);
        !           600:     if ($tmp[0]!~/^error/) {
        !           601:         my %tmp = @tmp;
        !           602:         my $default_filename =  $ENV{'course.'.$ENV{'request.course.id'}.
        !           603:                                          '.spreadsheet_default_assesscalc'};
        !           604:         # We only got one key, so we will access it directly.
        !           605:         while (my ($key,$sheetdata) = each(%tmp)) {
        !           606:             my ($sname,$sdom,$sheettype,$symb) = split(':',$key);
        !           607:             if ($symb =~ /\.time$/) {
        !           608:                 $symb =~ s/\.time$//;
        !           609:                 $Exportrows{$symb}->{'time'} = $sheetdata;
        !           610:             } else {
        !           611:                 $sheetdata =~ s/^(.*)___=___//;
        !           612:                 my $filename = $1;
        !           613:                 $filename = $default_filename if (! defined($filename));
        !           614:                 my @Data = split('___;___',$sheetdata);
        !           615:                 $Exportrows{$symb}->{$filename} = \@Data;
        !           616:             }
        !           617:         }
        !           618:     }
        !           619: }
        !           620: 
        !           621: #############################################
        !           622: #############################################
        !           623: 
        !           624: =pod
        !           625: 
        !           626: =item &export_data
        !           627: 
        !           628: Returns the export data associated with the spreadsheet.  Computes the
        !           629: spreadsheet only if necessary.
        !           630: 
        !           631: =cut
        !           632: 
        !           633: #############################################
        !           634: #############################################
        !           635: sub export_data {
        !           636:     my $self = shift;
        !           637:     my $symb = $self->{'symb'};
        !           638:     if (! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb})  ||
        !           639:         ! $self->check_expiration_time($Exportrows{$symb}->{'time'}) ||
        !           640:         ! exists($Exportrows{$symb}->{$self->{'filename'}}) ||
        !           641:         ! defined($Exportrows{$symb}->{$self->{'filename'}})) {
        !           642:         $self->compute();
        !           643:     }
        !           644:     my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}};
        !           645:     if ($Data[0] =~ /^(.*)___=___/) {
        !           646:         $self->{'sheetname'} = $1;
        !           647:         $Data[0] =~ s/^(.*)___=___//;
        !           648:     }
        !           649:     for (my $i=0;$i<$#Data;$i++) {
        !           650:         $Data[$i]="'".$Data[$i]."'" if ($Data[$i]=~/\D/ && defined($Data[$i]));
        !           651:     }
        !           652:     return @Data;
        !           653: }
        !           654: 
        !           655: #############################################
        !           656: #############################################
        !           657: 
        !           658: =pod
        !           659: 
        !           660: =item &save_export_data()
        !           661: 
        !           662: Writes the export data for this spreadsheet to the students cache.
        !           663: 
        !           664: =cut
        !           665: 
        !           666: #############################################
        !           667: #############################################
        !           668: sub save_export_data {
        !           669:     my $self = shift;
        !           670:     my $student = $self->{'name'}.':'.$self->{'domain'};
        !           671:     my $symb    = $self->{'symb'};
        !           672:     if (! exists($Exportrows{$symb}) || 
        !           673:         ! exists($Exportrows{$symb}->{$self->{'filename'}})) {
        !           674:         return;
        !           675:     }
        !           676:     my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb));
        !           677:     my $timekey = $key.'.time';
        !           678:     my $newstore= join('___;___',@{$Exportrows{$symb}->{$self->{'filename'}}});
        !           679:     $newstore = $self->{'filename'}.'___=___'.$newstore;
        !           680:     my $result = &Apache::lonnet::put
        !           681:         ('nohist_calculatedsheets_'.$ENV{'request.course.id'},
        !           682:          { $key     => $newstore,
        !           683:            $timekey => $Exportrows{$symb}->{'time'} },
        !           684:          $self->{'domain'},
        !           685:          $self->{'name'});
        !           686: 
        !           687:     return;
        !           688: }
        !           689: 
        !           690: 1;
        !           691: 
        !           692: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>