File:  [LON-CAPA] / loncom / interface / spreadsheet / assesscalc.pm
Revision 1.14: download - view: text, annotated - select for diffs
Mon Jun 23 19:58:18 2003 UTC (21 years ago) by matthew
Branches: MAIN
CVS tags: HEAD
Bug 1729 - color hints on export/import rows.  The color of the export
row of the assessment sheet is the same as the import row of the
student sheet.  The export row of the student sheet is the same color
as the import rows of the course level sheet.

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

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