Return to assesscalc.pm CVS log

Up to [LON-CAPA] / loncom / interface / spreadsheet

Added 'blackout' support.  A blackout occurs when an assessment has a part
flagged with 'problemstatus' equal to 'no'.  This prevents the display of
the students performance on the part until the answerdate has passed.

Spreadsheet.pm contains &blackout, which returns the blackout status of
the current spreadsheet.

assesscalc.pm contains code which
    a) causes the computation of the spreadsheet to determine the
       blackout status
    b) forces the recomputation of the spreadsheet if the user is a student.
  Obviously (b) is less than ideal and a new approach should be found.

studentcalc.pm's outsheet_html subroutine now supresses the display of the
export (aka 'summary') row, as well as the rows of any assessments which
are under blackout.

#
# $Id: assesscalc.pm,v 1.5 2003/05/22 21:16:35 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler
#
# POD required stuff:

=head1 NAME

assesscalc

=head1 SYNOPSIS

=head1 DESCRIPTION

=cut

###################################################
###                 AssessSheet                 ###
###################################################
package Apache::assesscalc;

use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use Apache::Spreadsheet;
use HTML::Entities();
use Spreadsheet::WriteExcel;
use GDBM_File;
use Time::HiRes;

@Apache::assesscalc::ISA = ('Apache::Spreadsheet');

########################################################
########################################################

=pod

=head2 Package Variables

=over 4

=item %Exportrows

=item $current_name

=item $current_domain

=item $current_course

=item %parmhash

=item %nice_parameter_name

=item %useropt

=item %courseopt

=back 

=cut

########################################################
########################################################

my %Exportrows;

my $current_name;
my $current_domain;
my $current_course;

my %parmhash;
my %nice_parameter_name;

my %useropt;
my %courseopt;

########################################################
########################################################

=pod

=head2 Package Subroutines

=item &clear_package()

Reset all package variables.  

=cut

########################################################
########################################################
sub clear_package {
    undef(%Exportrows);
    undef($current_name);
    undef($current_domain);
    undef($current_course);
    undef(%useropt);
    undef(%courseopt);
}

########################################################
########################################################

=pod

=item &initialize_package()

=cut

########################################################
########################################################
sub initialize_package {
    my ($sname,$sdomain) = @_;
    $current_course = $ENV{'request.course.id'};
    $current_name   = $sname;
    $current_domain = $sdomain;
    undef(%courseopt);
    &load_cached_export_rows();
    &load_parameter_caches();
}

########################################################
########################################################

=pod

=item &load_parameter_caches()

=cut

########################################################
########################################################
sub load_parameter_caches {
    my $userprefix = $current_name.':'.$current_domain.'_';
    $userprefix =~ s/:/_/g;
    #
    # Course Parameters Cache
    if (! %courseopt) {
        &Apache::lonnet::logthis("loading course options");
        $current_course = $ENV{'request.course.id'};
        undef(%courseopt);
        if (! defined($current_name) || ! defined($current_domain)) {
            &Apache::lonnet::logthis('bad call to setup_parameter_caches');
            return;
        }
        my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
        my $id  = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
        my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id);
        while (my ($name,$value) = each(%Tmp)) {
            $courseopt{$name}=$value;
        }
    }
    if (! %useropt) {
        my %Tmp = &Apache::lonnet::dump('resourcedata',
                                        $current_domain,$current_name);
        while (my ($name,$value) = each(%Tmp)) {
            if ($name =~ /^error: 2/ || $name =~ /no such file/) {
                undef(%useropt);
                last;
            }
            $useropt{$userprefix.$name}=$value;
        }
    }
}

########################################################
########################################################

=pod

=head2 assesscalc object methods

=cut

########################################################
########################################################
sub ensure_current_parameter_caches {
    my $self = shift;
    if (! defined($current_course) || 
        $current_course ne $ENV{'request.course.id'} ) {
        $current_course = $ENV{'request.course.id'};
        undef(%courseopt); 
    }
    if (! defined($current_name)   || $current_name ne $self->{'name'} ||
        ! defined($current_domain) || $current_domain ne $self->{'domain'}) {
        $current_domain = $self->{'domain'};
        $current_name   = $self->{'name'};
        undef(%useropt);
    }
    &load_parameter_caches();
}

##################################################
##################################################

=pod

=item &parmval()

Determine the value of a parameter.

Inputs: $what, the parameter needed, $symb, $uname, $udom, $csec 

Returns: The value of a parameter, or '' if none.

This function cascades through the possible levels searching for a value for
a parameter.  The levels are checked in the following order:
user, course (at section level and course level), map, and lonnet::metadata.
This function uses %parmhash, which must be tied prior to calling it.
This function also requires %courseopt and %useropt to be initialized for
this user and course.

=cut

##################################################
##################################################
sub parmval {
    my $self = shift;
    my ($what,$symb,$uname,$udom,$csec)=@_;
    $uname = $self->{'name'}    if (! defined($uname));
    $udom  = $self->{'domain'}  if (! defined($udom));
    $csec  = $self->{'section'} if (! defined($csec));
    $symb  = $self->{'symb'}    if (! defined($symb));
    #
    my $result='';
    #
    # This should be a 
    my ($mapname,$id,$fn)=split(/___/,$symb);
    # Cascading lookup scheme
    my $rwhat=$what;
    $what =~ s/^parameter\_//;
    $what =~ s/\_([^\_]+)$/\.$1/;
    #
    my $symbparm = $symb.'.'.$what;
    my $mapparm  = $mapname.'___(all).'.$what;
    my $courseprefix = $self->{'cid'};
    my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'};
    #
    my $seclevel  = $courseprefix.'.['.$csec.'].'.$what;
    my $seclevelr = $courseprefix.'.['.$csec.'].'.$symbparm;
    my $seclevelm = $courseprefix.'.['.$csec.'].'.$mapparm;
    #
    my $courselevel  = $courseprefix.'.'.$what;
    my $courselevelr = $courseprefix.'.'.$symbparm;
    my $courselevelm = $courseprefix.'.'.$mapparm;
    #
    my $ucourselevel  = $usercourseprefix.'.'.$what;
    my $ucourselevelr = $usercourseprefix.'.'.$symbparm;
    my $ucourselevelm = $usercourseprefix.'.'.$mapparm;
   # check user
    if (defined($uname)) {
        return $useropt{$ucourselevelr} if (defined($useropt{$ucourselevelr}));
        return $useropt{$ucourselevelm} if (defined($useropt{$ucourselevelm}));
        return $useropt{$ucourselevel}  if (defined($useropt{$ucourselevel}));
    }
    # check section
    if (defined($csec)) {
        return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr}));
        return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm}));
        return $courseopt{$seclevel}  if (defined($courseopt{$seclevel}));
    }
    #
    # check course
    return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr}));
    return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm}));
    return $courseopt{$courselevel}  if (defined($courseopt{$courselevel}));
    # check map parms
    my $thisparm = $parmhash{$symbparm};
    return $thisparm if (defined($thisparm));
    # check default
    $thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default');
    return $thisparm if (defined($thisparm));
    #
    # Cascade Up
    my $space=$what;
    $space=~s/\.\w+$//;
    if ($space ne '0') {
	my @parts=split(/_/,$space);
	my $id=pop(@parts);
	my $part=join('_',@parts);
	if ($part eq '') { $part='0'; }
	my $newwhat=$rwhat;
	$newwhat=~s/\Q$space\E/$part/;
	my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec);
	if (defined($partgeneral)) { return $partgeneral; }
    }
    #nothing defined
    return '';
}

sub get_title {
    my $self = shift;
    my $title;
    if (($self->{'usymb'} eq '_feedback') ||
        ($self->{'usymb'} eq '_evaluation') ||
        ($self->{'usymb'} eq '_discussion') ||
        ($self->{'usymb'} eq '_tutoring')) {
        $title = $self->{'usymb'};
        $title =~ s/^_//;
        $title = '<h1>'.ucfirst($title)."</h1>\n";
    } else {
        $title = '<h1>'.&Apache::lonnet::gettitle($self->{'symb'})."</h1>\n";
    }
    # Look up the users identifying information
    # Get the users information
    my %userenv = &Apache::loncoursedata::GetUserName($self->{'name'},
                                                      $self->{'domain'});
    my $name = 
        join(' ',@userenv{'firstname','middlename','lastname','generation'});
    $name =~ s/\s+$//;
    $title .= '<h2>'.$name.', '.
        &Apache::loncommon::aboutmewrapper($self->{'name'}.'@'.$self->{'domain'},
                                           $self->{'name'},$self->{'domain'}).
                                           "</h2>\n";
    $title .= '<h3>'.localtime(time).'</h3>';
    #
    return $title;
}

sub parent_link {
    my $self = shift;
    my $link .= '<p><a href="/adm/studentcalc?'.
        'sname='.$self->{'name'}.
            '&sdomain='.$self->{'domain'}.'">'.
                'Student level sheet</a></p>'."\n";
    return $link;
}

sub outsheet_html {
    my $self = shift;
    my ($r) = @_;
    ###################################
    # Determine table structure
    ###################################
    my $num_uneditable = 1;
    my $num_left = 52-$num_uneditable;
    my $tableheader =<<"END";
<table border="2">
<tr>
  <th colspan="2" rowspan="2"><font size="+2">Assessment</font></th>
  <td bgcolor="#FFDDDD" colspan="$num_uneditable">&nbsp;</td>
  <td colspan="$num_left">
      <b><font size="+1">Calculations</font></b></td>
</tr><tr>
END
    my $label_num = 0;
    foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
        if ($label_num<$num_uneditable) { 
            $tableheader .= '<td bgcolor="#FFDDDD">';
        } else {
            $tableheader .= '<td>';
        }
        $tableheader .= "<b><font size=+1>$_</font></b></td>";
        $label_num++;
    }
    $tableheader.="</tr>\n";
    #
    $r->print($tableheader);
    #
    # Print out template row
    $r->print('<tr><td>Template</td><td>&nbsp;</td>'.
	      $self->html_template_row($num_uneditable)."</tr>\n");
    #
    # Print out summary/export row
    $r->print('<tr><td>Export</td><td>0</td>'.
	      $self->html_export_row()."</tr>\n");
    #
    # Prepare to output rows
    $tableheader =<<"END";
<table border="2">
<tr><th>row</th><th>Item</th>
END
    foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
	if ($label_num<$num_uneditable) { 
            $tableheader.='<th bgcolor="#FFDDDD">';
        } else {
            $tableheader.='<th>';
        }
        $tableheader.="<b><font size=+1>$_</font></b></th>";
    }
    #
    my $num_output = 0;
    foreach my $rownum ($self->rows()) {
	if ($num_output++ % 50 == 0) {
	    $r->print("</table>\n".$tableheader);
	}
	$r->print('<tr><td>'.$rownum.'</td>'.
                  $self->assess_html_row($num_uneditable,$rownum)."</tr>\n");
    }
    $r->print("</table>\n");
    return;
}

sub assess_html_row {
    my $self = shift();
    my ($num_uneditable,$row) = @_;
    my $requester_is_student = ($ENV{'request.role'} =~ /^st\./);
    my $parameter_name = $self->{'formulas'}->{'A'.$row};
    my @rowdata = $self->get_row($row);
    my $num_cols_output = 0;
    my $row_html;
    if (exists($nice_parameter_name{$parameter_name})) {
        my $name = $nice_parameter_name{$parameter_name};
        $name =~ s/ /\&nbsp;/g;
        $row_html .= '<td>'.$name.'<br />'.$parameter_name.'</td>';
    } else {
        $row_html .= '<td>'.$parameter_name.'</td>';
    }
    foreach my $cell (@rowdata) {
	if ($requester_is_student || 
	    $num_cols_output++ < $num_uneditable) {
	    $row_html .= '<td bgcolor="#FFDDDD">';
	    $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell,'#FFDDDD');
	} else {
	    $row_html .= '<td bgcolor="#EOFFDD">';
	    $row_html .= &Apache::Spreadsheet::html_editable_cell($cell,'#E0FFDD');
	}
	$row_html .= '</td>';
    }
    return $row_html;
}

sub outsheet_csv {
    my $self = shift;
    my ($r)=@_;
}

sub outsheet_excel {
    my $self = shift;
    my ($r)=@_;
}

sub display {
    my $self = shift;
    my ($r) = @_;
    $self->compute();
    $self->outsheet_html($r);
}

sub compute {
    my $self = shift;
    $self->logthis('computing');
    $self->initialize_safe_space();
    #
    # Definitions
    undef(%nice_parameter_name);
    my %parameters;   # holds underscored parameters by name
    #
    # Get the metadata fields and determine their proper names
    my ($symap,$syid,$srcf)=split(/___/,$self->{'symb'});
    my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
    foreach my $parm (@Metadata) {
        next if ($parm !~ /^(resource\.|stores|parameter)_/);
        my $cleaned_name = $parm;
        $cleaned_name =~ s/^resource\./stores_/;
        $cleaned_name =~ s/\./_/g;
        my $display = &Apache::lonnet::metadata($srcf,
                                                $cleaned_name.'.display');
        if (! $display) {
            $display .= &Apache::lonnet::metadata($srcf,$cleaned_name.'.name');
        }
        $parameters{$cleaned_name}++;
        $nice_parameter_name{$cleaned_name} = $display;
    }
    #
    # Get the values of the metadata fields
    $self->ensure_current_parameter_caches();
    my $filename = $self->{'coursefilename'}.'_parms.db';
    if (tie(%parmhash,'GDBM_File',
            $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
        foreach my $parmname (keys(%parameters)) {
            my $value = $self->parmval($parmname);
            $parameters{$parmname} =$value;
        }
        untie(%parmhash);
    } else {
        $self->logthis('unable to tie '.$filename);
    }
    #
    # Clean out unnecessary parameters
    foreach (keys(%parameters)) {
        delete($parameters{$_}) if (! /(resource\.|stores_|parameter_)/);
    }
    #
    # Get the students performance data
    my %student_parameters = 
        &Apache::loncoursedata::get_current_state($self->{'name'},
                                                  $self->{'domain'},
                                                  $self->{'symb'},
                                                  $self->{'cid'});
    while (my ($parm,$value) = each(%student_parameters)) {
        $parm =~ s/^resource\./stores_/;
        $parm =~ s/\./_/g;
        $parameters{$parm} = $value;
    }
    #
    # Set up the formulas and parameter values
    my %f=$self->formulas();
    my %c;
    #
    # Check for blackout requirements
    if ((!exists($ENV{'request.role.adv'}) || !$ENV{'request.role.adv'})) {
        while (my ($parm,$value) = each(%parameters)) {
            last if ($self->blackout());
            next if ($parm !~ /^(parameter_.*)_problemstatus$/);
            next if ($parameters{$1.'_answerdate'}<time);
            if (lc($value) eq 'no') {
                # We must blackout this sheet
                $self->blackout(1);
            }
        }
    }
    #
    # Move the parameters into the spreadsheet
    while (my ($parm,$value) = each(%parameters)) {
        my $cell = 'A'.$self->get_row_number_from_key($parm);
        $f{$cell} = $parm;
        $c{$parm} = '';
        if ($value ne '') {
            $c{$parm} = '"'.$value.'"';
        }
    }
    $self->formulas(%f);
    $self->constants(%c);
    $self->calcsheet();
    #
    # Store export row in cache
    my @exportarray = $self->exportrow();
    $Exportrows{$self->{'symb'}}->{'time'} = time;
    $Exportrows{$self->{'symb'}}->{$self->{'filename'}} = \@exportarray;
    #
    # Save the export data
    $self->save_export_data();
    return;
}

##
## sett overrides Spreadsheet::sett
##
sub sett {
    my $self = shift;
    my %t=();
    #
    # Deal with the template row by copying the template formulas into each
    # row.
    foreach my $col ($self->template_cells()) {
        next if ($col=~/^A/);
        foreach my $row ($self->rows()) {
            # Get the name of this cell
            my $cell=$col.$row;
            # Grab the template declaration
            $t{$cell}=$self->formula('template_'.$col);
            # Replace '#' with the row number
            $t{$cell}=~s/\#/$row/g;
            # Replace '....' with ','
            $t{$cell}=~s/\.\.+/\,/g;
            # Replace 'A0' with the value from 'A0'
            $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
            # Replace parameters
            $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
        }
    }
    #
    # Deal with the cells which have formulas
    while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
	next if ($cell =~ /template_/);
        if ($cell =~ /^A/ && $cell ne 'A0') {
            if ($formula !~ /^\!/) {
                $t{$cell}=$self->{'constants'}->{$formula};
            }
        } else {
            $t{$cell}=$formula;
            $t{$cell}=~s/\.\.+/\,/g;
            $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
            $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
        }
    }
    # Put %t into the safe space
    %{$self->{'safe'}->varglob('t')}=%t;
}


########################################################
########################################################

=pod

=item &load_cached_export_rows()

Retrieves and parsers the export rows of the assessment spreadsheets.
These rows are saved in the students directory in the format:

 sname:sdom:assesscalc:symb.time => time

 sname:sdom:assesscalc:symb => filename___=___Adata___;___Bdata___;___ ...

=cut

########################################################
########################################################
sub load_cached_export_rows {
    %Exportrows = undef;
    my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'.
                                    $ENV{'request.course.id'},
                                    $current_domain,$current_name,undef);
    if ($tmp[0]!~/^error/) {
        my %tmp = @tmp;
        my $default_filename =  $ENV{'course.'.$ENV{'request.course.id'}.
                                         '.spreadsheet_default_assesscalc'};
        # We only got one key, so we will access it directly.
        while (my ($key,$sheetdata) = each(%tmp)) {
            my ($sname,$sdom,$sheettype,$symb) = split(':',$key);
            if ($symb =~ /\.time$/) {
                $symb =~ s/\.time$//;
                $Exportrows{$symb}->{'time'} = $sheetdata;
            } else {
                $sheetdata =~ s/^(.*)___=___//;
                my $filename = $1;
                $filename = $default_filename if (! defined($filename));
                my @Data = split('___;___',$sheetdata);
                $Exportrows{$symb}->{$filename} = \@Data;
            }
        }
    }
}

#############################################
#############################################

=pod

=item &export_data

Returns the export data associated with the spreadsheet.  Computes the
spreadsheet only if necessary.

=cut

#############################################
#############################################
sub export_data {
    my $self = shift;
    my $symb = $self->{'symb'};
    if (! exists($ENV{'request.role.adv'}) || ! $ENV{'request.role.adv'} ||
        ! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb})  ||
        ! $self->check_expiration_time($Exportrows{$symb}->{'time'}) ||
        ! exists($Exportrows{$symb}->{$self->{'filename'}}) ||
        ! defined($Exportrows{$symb}->{$self->{'filename'}})) {
        $self->compute();
    }
    my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}};
    if ($Data[0] =~ /^(.*)___=___/) {
        $self->{'sheetname'} = $1;
        $Data[0] =~ s/^(.*)___=___//;
    }
    for (my $i=0;$i<$#Data;$i++) {
        $Data[$i]="'".$Data[$i]."'" if ($Data[$i]=~/\D/ && defined($Data[$i]));
    }
    return @Data;
}

#############################################
#############################################

=pod

=item &save_export_data()

Writes the export data for this spreadsheet to the students cache.

=cut

#############################################
#############################################
sub save_export_data {
    my $self = shift;
    my $student = $self->{'name'}.':'.$self->{'domain'};
    my $symb    = $self->{'symb'};
    if (! exists($Exportrows{$symb}) || 
        ! exists($Exportrows{$symb}->{$self->{'filename'}})) {
        return;
    }
    my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb));
    my $timekey = $key.'.time';
    my $newstore= join('___;___',@{$Exportrows{$symb}->{$self->{'filename'}}});
    $newstore = $self->{'filename'}.'___=___'.$newstore;
    my $result = &Apache::lonnet::put
        ('nohist_calculatedsheets_'.$ENV{'request.course.id'},
         { $key     => $newstore,
           $timekey => $Exportrows{$symb}->{'time'} },
         $self->{'domain'},
         $self->{'name'});

    return;
}

1;

__END__