--- loncom/interface/spreadsheet/Spreadsheet.pm 2003/05/29 13:39:38 1.11 +++ loncom/interface/spreadsheet/Spreadsheet.pm 2005/04/29 18:12:21 1.37.2.2 @@ -1,5 +1,5 @@ # -# $Id: Spreadsheet.pm,v 1.11 2003/05/29 13:39:38 matthew Exp $ +# $Id: Spreadsheet.pm,v 1.37.2.2 2005/04/29 18:12:21 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -48,6 +48,8 @@ Spreadsheet package Apache::Spreadsheet; use strict; +#use warnings FATAL=>'all'; +#no warnings 'uninitialized'; use Apache::Constants qw(:common :http); use Apache::lonnet; use Safe; @@ -57,6 +59,7 @@ use HTML::Entities(); use HTML::TokeParser; use Spreadsheet::WriteExcel; use Time::HiRes; +use Apache::lonlocal; ## ## Package Variables @@ -83,6 +86,12 @@ sub new { my ($stype) = ($class =~ /Apache::(.*)$/); # my ($name,$domain,$filename,$usymb)=@_; + if (! defined($name) || $name eq '') { + $name = $ENV{'user.name'}; + } + if (! defined($domain) || $domain eq '') { + $domain = $ENV{'user.domain'}; + } # my $self = { name => $name, @@ -90,14 +99,17 @@ sub new { type => $stype, symb => $usymb, errorlog => '', - maxrow => '', + maxrow => 0, cid => $ENV{'request.course.id'}, cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'}, coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, coursefilename => $ENV{'request.course.fn'}, - temporary => '', + # + # Flags + temporary => 0, # true if this sheet has been modified but not saved + new_rows => 0, # true if this sheet has new rows # # blackout is used to determine if any data needs to be hidden from the # student. @@ -142,25 +154,22 @@ sub filename { if (@_) { my ($newfilename) = @_; if (! defined($newfilename) || $newfilename eq 'Default' || - $newfilename !~ /\w/) { - my %tmphash = &Apache::lonnet::get('environment', - ['spreadsheet_default_'. - $self->{'type'}], - $self->{'cdom'}, - $self->{'cnum'}); - my ($tmp) = keys(%tmphash); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $newfilename=$tmphash{'spreadsheet_default_'.$self->{'type'}}; - } - if (! defined($newfilename) || - $newfilename !~ /\w/ || - $newfilename =~ /^\W*$/) { - $newfilename = 'default.'.$self->{'type'}; + $newfilename !~ /\w/ || $newfilename eq '') { + my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'. + $self->{'type'}; + if (exists($ENV{$key}) && $ENV{$key} ne '') { + $newfilename = $ENV{$key}; + } else { + $newfilename = 'default_'.$self->{'type'}; } - } elsif ($newfilename !~ /^\/res\/.*\.spreadsheet/ && - $newfilename !~ /^default\.$self->{'type'}$/ ) { - my $regexp = '_'.$self->{'type'}.'$'; - if ($newfilename !~ /$regexp/) { + } + if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) { + $newfilename = 'default_'.$self->{'type'}; + } + if ($newfilename !~ /^default\.$self->{'type'}$/ && + $newfilename !~ /^\/res\/(.*)spreadsheet$/) { + if ($newfilename !~ /_$self->{'type'}$/) { + $newfilename =~ s/[\s_]*$//; $newfilename .= '_'.$self->{'type'}; } } @@ -185,7 +194,7 @@ default spreadsheets.......! sub make_default { my $self = shift(); my $result = &Apache::lonnet::put('environment', - {'spreadsheet_default_'.$self->{'type'} => $self->filename()}, + {'spreadsheet_default_'.$self->{'type'} => $self->filename()}, $self->{'cdom'},$self->{'cnum'}); return $result if ($result ne 'ok'); my $symb = $self->{'symb'}; @@ -218,6 +227,9 @@ sub is_default { if ($tmp !~ /^(con_lost|error|no_such_host)/i) { $default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}}; } + if ($default_filename =~ /^\s*$/) { + $default_filename = 'default_'.$self->{'type'}; + } return 1 if ($self->filename() eq $default_filename); return 0; } @@ -227,6 +239,16 @@ sub initialize { # the descendents of the spreadsheet class. } +sub clear_package { + # This method is here to remind you that it will be overridden by + # the descendents of the spreadsheet class. +} + +sub cleanup { + my $self = shift(); + $self->clear_package(); +} + sub initialize_spreadsheet_package { &load_spreadsheet_expirationdates(); &clear_spreadsheet_definition_cache(); @@ -246,18 +268,28 @@ sub load_spreadsheet_expirationdates { sub check_expiration_time { my $self = shift; my ($time)=@_; - my ($key1,$key2,$key3,$key4); + return 0 if (! defined($time)); + my ($key1,$key2,$key3,$key4,$key5); + # Description of keys + # + # key1: all sheets of this type have expired + # key2: all sheets of this type for this student + # key3: all sheets of this type in this map for this student + # key4: this assessment sheet for this student + # key5: this assessment sheet for all students $key1 = '::'.$self->{'type'}.':'; $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':'; $key3 = $key2.$self->{'container'} if (defined($self->{'container'})); - $key4 = $key2.$self->{'usymb'} if (defined($self->{'usymb'})); - foreach my $key ($key1,$key2,$key3,$key4) { + $key4 = $key2.$self->{'symb'} if (defined($self->{'symb'})); + $key5 = $key1.$self->{'symb'} if (defined($self->{'symb'})); + my $returnvalue = 1; # default to okay + foreach my $key ($key1,$key2,$key3,$key4,$key5) { next if (! defined($key)); - if (exists($expiredates{$key}) &&$expiredates{$key} > $time) { - return 0; + if (exists($expiredates{$key}) && $expiredates{$key} > $time) { + $returnvalue = 0; # need to recompute } } - return 1; + return $returnvalue; } ###################################################### @@ -275,18 +307,23 @@ Returns the safe space required by a Spr =cut ###################################################### +{ + + my $safeeval; + sub initialize_safe_space { - my $self = shift; - my $safeeval = new Safe(shift); - my $safehole = new Safe::Hole; - $safeeval->permit("entereval"); - $safeeval->permit(":base_math"); - $safeeval->permit("sort"); - $safeeval->deny(":base_io"); - $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); - $safehole->wrap(\&mask,$safeeval,'&mask'); - $safeeval->share('$@'); - my $code=<<'ENDDEFS'; + my $self = shift; + if (! defined($safeeval)) { + $safeeval = new Safe(shift); + my $safehole = new Safe::Hole; + $safeeval->permit("entereval"); + $safeeval->permit(":base_math"); + $safeeval->permit("sort"); + $safeeval->deny(":base_io"); + $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); + $safehole->wrap(\&mask,$safeeval,'&mask'); + $safeeval->share('$@'); + my $code=<<'ENDDEFS'; # ---------------------------------------------------- Inside of the safe space # # f: formulas @@ -351,7 +388,7 @@ returns the number of items in the range #------------------------------------------------------- sub NUM { my $mask=&mask(@_); - my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; + my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1; return $num; } @@ -368,7 +405,7 @@ sub BIN { my ($low,$high,$lower,$upper)=@_; my $mask=&mask($lower,$upper); my $num=0; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { $num++; } @@ -390,7 +427,7 @@ returns the sum of items in the range. sub SUM { my $mask=&mask(@_); my $sum=0; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { $sum+=$sheet_values{$_}; } return $sum; @@ -411,7 +448,7 @@ sub MEAN { my $mask=&mask(@_); my $sum=0; my $num=0; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { $sum+=$sheet_values{$_}; $num++; } @@ -436,14 +473,14 @@ compute the standard deviation of the it sub STDDEV { my $mask=&mask(@_); my $sum=0; my $num=0; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { $sum+=$sheet_values{$_}; $num++; } unless ($num>1) { return undef; } my $mean=$sum/$num; $sum=0; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { $sum+=($sheet_values{$_}-$mean)**2; } return sqrt($sum/($num-1)); @@ -463,7 +500,7 @@ compute the product of the items in the sub PROD { my $mask=&mask(@_); my $prod=1; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { $prod*=$sheet_values{$_}; } return $prod; @@ -483,7 +520,7 @@ compute the maximum of the items in the sub MAX { my $mask=&mask(@_); my $max='-'; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; @@ -506,7 +543,7 @@ compute the minimum of the items in the sub MIN { my $mask=&mask(@_); my $min='-'; - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } if (($sheet_values{$_}<$min) || ($min eq '-')) { $min=$sheet_values{$_}; @@ -531,10 +568,10 @@ sub SUMMAX { my ($num,$lower,$upper)=@_; my $mask=&mask($lower,$upper); my @inside=(); - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { push (@inside,$sheet_values{$_}); } - @inside=sort(@inside); + @inside=sort {$a <=> $b} (@inside); my $sum=0; my $i; for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { $sum+=$inside[$i]; @@ -558,10 +595,10 @@ sub SUMMIN { my ($num,$lower,$upper)=@_; my $mask=&mask($lower,$upper); my @inside=(); - foreach (grep /$mask/,keys(%sheet_values)) { + foreach (grep eval("/$mask/"),keys(%sheet_values)) { $inside[$#inside+1]=$sheet_values{$_}; } - @inside=sort(@inside); + @inside=sort {$a <=> $b} (@inside); my $sum=0; my $i; for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { $sum+=$inside[$i]; @@ -584,7 +621,6 @@ parametername should be a string such as sub MINPARM { my ($expression) = @_; my $min = undef; - study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($min > $c{$parameter})) { @@ -609,7 +645,6 @@ parametername should be a string such as sub MAXPARM { my ($expression) = @_; my $max = undef; - study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($max < $c{$parameter})) { @@ -648,12 +683,13 @@ sub calc { return $lastcalc.': Maximum calculation depth exceeded'; } } - return ''; + return 'okay'; } # ------------------------------------------- End of "Inside of the safe space" ENDDEFS - $safeeval->reval($code); + $safeeval->reval($code); + } $self->{'safe'} = $safeeval; $self->{'root'} = $self->{'safe'}->root(); # @@ -667,6 +703,9 @@ ENDDEFS $self->{'safe'}->reval($initstring); return $self; } + +} + ###################################################### =pod @@ -680,6 +719,17 @@ ENDDEFS ###################################################### +=pod + +=item &mask($lower,$upper) + +Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*"). + +Returns: Regular expression matching spreadsheet cells that are within +the rectangle defined by $lower and $upper. Due to the nature of the +regular expression this result must be used inside an eval(). + +=cut ###################################################### { @@ -694,78 +744,62 @@ sub mask { } $upper = $lower if (! defined($upper)); # - my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/); - my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/); + my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/); + my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/); # my $alpha=''; my $num=''; # + # Do not put parenthases around $alpha. + # $num depends on the value in $1. if (($la eq '*') || ($ua eq '*')) { - $alpha='[A-Za-z]'; + $alpha='[A-z]'; } else { - if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || - ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { - $alpha='['.$la.'-'.$ua.']'; - } else { - $alpha='['.$la.'-Za-'.$ua.']'; - } - } - if (($ld eq '*') || ($ud eq '*')) { - $num='\d+'; + if ($la gt $ua) { + my $tmp = $ua; + $ua = $la; + $la = $ua; + } + $alpha=qq/[$la-$ua]/; + } + if ($ld ne '*' && $ud ne '*') { + # Make sure $ld <= $ud + if ($ld > $ud) { + my $tmp = $ud; + $ud = $ld; + $ld = $tmp; + } + # Here we make a regular expression using some advanced regexp + # abilities. + # (\d+) will match the digits of the cell name and dump them in + # to $1 + # (?(?{ ... code ...} pattern_if_true | pattern_if_false)) will + # choose pattern_if_true if { ... code ... } is true and + # pattern_if_false if { ... code ... } is false. + # In this case, pattern_if_true is empty. pattern_if_false is + # 'donotmatch' and will not match our cells because none of + # them end with donotmatch. + # Unfortunately, the use of this type of regular expression + # requires that each match be wrapped in an eval(). Search for + # $mask in this module for examples + $num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})|donotmatch)'; } else { - if (length($ld)!=length($ud)) { - $num.='('; - foreach ($ld=~m/\d/g) { - $num.='['.$_.'-9]'; - } - if (length($ud)-length($ld)>1) { - $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; - } - $num.='|'; - foreach ($ud=~m/\d/g) { - $num.='[0-'.$_.']'; - } - $num.=')'; - } else { - my @lda=($ld=~m/\d/g); - my @uda=($ud=~m/\d/g); - my $i; - my $j=0; - my $notdone=1; - for ($i=0;($i<=$#lda)&&($notdone);$i++) { - if ($lda[$i]==$uda[$i]) { - $num.=$lda[$i]; - $j=$i; - } else { - $notdone=0; - } - } - if ($j<$#lda-1) { - $num.='('.$lda[$j+1]; - for ($i=$j+2;$i<=$#lda;$i++) { - $num.='['.$lda[$i].'-9]'; - } - if ($uda[$j+1]-$lda[$j+1]>1) { - $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'. - ($#lda-$j-1).'}'; - } - $num.='|'.$uda[$j+1]; - for ($i=$j+2;$i<=$#uda;$i++) { - $num.='[0-'.$uda[$i].']'; - } - $num.=')'; - } else { - if ($lda[-1]!=$uda[-1]) { - $num.='['.$lda[-1].'-'.$uda[-1].']'; - } - } - } + $num = '(\d+)'; } - my $expression ='^'.$alpha.$num."\$"; + my $expression = '^'.$alpha.$num.'$'; $memoizer{$key} = $expression; return $expression; } +# +# Debugging routine +sub dump_memoized_values { + while (my ($key,$value) = each(%memoizer)) { + &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value); + } + return; +} + } ## @@ -783,8 +817,8 @@ sub expandnamed { my @vars=split(/\W+/,$formula); my %values=(); foreach my $varname ( @vars ) { - if ($varname=~/\D/) { - $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; + if ($varname=~/^(parameter|stores|timestamp)/) { + $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; $varname=~s/$var/\([\\w:\\- ]\+\)/g; foreach (keys(%{$self->{'constants'}})) { if ($_=~/$varname/) { @@ -814,30 +848,31 @@ sub expandnamed { # 4. If there is a collision, return 'bad parameter name error' my $returnvalue = ''; my @matches = (); + my @values = (); $#matches = -1; - study $expression; - my $parameter; - foreach $parameter (keys(%{$self->{'constants'}})) { - push @matches,$parameter if ($parameter =~ /$expression/); + while (my($parameter,$value) = each(%{$self->{'constants'}})) { + next if ($parameter !~ /$expression/); + push(@matches,$parameter); + push(@values,$value); } if (scalar(@matches) == 0) { $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"'; } elsif (scalar(@matches) == 1) { # why do we not do this lookup here, instead of delaying it? - $returnvalue = '$c{\''.$matches[0].'\'}'; + $returnvalue = $values[0]; } elsif (scalar(@matches) > 0) { # more than one match. Look for a concise one $returnvalue = "'non-unique parameter name : $expression'"; - foreach (@matches) { - if (/^$expression$/) { + for (my $i=0; $i<=$#matches;$i++) { + if ($matches[$i] =~ /^$expression$/) { # why do we not do this lookup here? - $returnvalue = '$c{\''.$_.'\'}'; + $returnvalue = $values[$i]; } } } else { # There was a negative number of matches, which indicates # something is wrong with reality. Better warn the user. - $returnvalue = '"bizzare parameter: '.$parameter.'"'; + $returnvalue = '"bizzare parameter: '.$expression.'"'; } return $returnvalue; } @@ -876,7 +911,8 @@ sub sett { $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; } elsif ( $col =~ /^[A-Z]$/ ) { - if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) { + if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell}) + && $self->{'constants'}->{$cell} ne '') { my $data = $self->{'constants'}->{$cell}; $t{$cell} = $data; } @@ -1108,9 +1144,49 @@ sub calcsheet { # $self->logthis($self->get_errorlog()); %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')}; # $self->logthis($self->get_errorlog()); + if ($result ne 'okay') { + $self->set_calcerror($result); + } return $result; } +sub set_badcalc { + my $self = shift(); + $self->{'badcalc'} =1; + return; +} + +sub badcalc { + my $self = shift; + if (exists($self->{'badcalc'}) && $self->{'badcalc'}) { + return 1; + } else { + return 0; + } +} + +sub set_calcerror { + my $self = shift; + if (@_) { + $self->set_badcalc(); + if (exists($self->{'calcerror'})) { + $self->{'calcerror'}.="\n".$_[0]; + } else { + $self->{'calcerror'}.=$_[0]; + } + } +} + +sub calcerror { + my $self = shift; + if ($self->badcalc()) { + if (exists($self->{'calcerror'})) { + return $self->{'calcerror'}; + } + } + return; +} + ########################################################### ## ## Output Helpers @@ -1119,33 +1195,59 @@ sub calcsheet { sub display { my $self = shift; my ($r) = @_; - $self->compute($r); my $outputmode = 'html'; - if ($ENV{'form.output_format'} =~ /^(html|excel|csv)$/) { - $outputmode = $ENV{'form.output_format'}; + foreach ($self->output_options()) { + if ($ENV{'form.output_format'} eq $_->{'value'}) { + $outputmode = $_->{'value'}; + last; + } } if ($outputmode eq 'html') { + $self->compute($r); $self->outsheet_html($r); + } elsif ($outputmode eq 'htmlclasslist') { + # No computation neccessary... This is kludgy + $self->outsheet_htmlclasslist($r); } elsif ($outputmode eq 'excel') { + $self->compute($r); $self->outsheet_excel($r); } elsif ($outputmode eq 'csv') { + $self->compute($r); $self->outsheet_csv($r); + } elsif ($outputmode eq 'xml') { +# $self->compute($r); + $self->outsheet_xml($r); } + $self->cleanup(); return; } ############################################ ## HTML output routines ## ############################################ +sub html_report_error { + my $self = shift(); + my $Str = ''; + if ($self->badcalc()) { + $Str = '

'. + &mt('An error occurred while calculating this spreadsheet'). + "

\n". + '
'.$self->calcerror()."
\n"; + } + return $Str; +} + sub html_export_row { my $self = shift(); + my ($color) = @_; + $color = '#CCCCFF' if (! defined($color)); my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); my $row_html; my @rowdata = $self->get_row(0); foreach my $cell (@rowdata) { if ($cell->{'name'} =~ /^[A-Z]/) { - $row_html .= ''. - &html_editable_cell($cell,'#CCCCFF',$allowed).''; + $row_html .= ''. + &html_editable_cell($cell,$color,$allowed).''; } else { $row_html .= ''. &html_editable_cell($cell,'#DDCCFF',$allowed).''; @@ -1157,14 +1259,14 @@ sub html_export_row { sub html_template_row { my $self = shift(); my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); - my ($num_uneditable) = @_; + my ($num_uneditable,$importcolor) = @_; my $row_html; my @rowdata = $self->get_template_row(); my $count = 0; for (my $i = 0; $i<=$#rowdata; $i++) { my $cell = $rowdata[$i]; if ($i < $num_uneditable) { - $row_html .= ''. + $row_html .= ''. &html_uneditable_cell($cell,'#FFDDDD',$allowed).''; } else { $row_html .= ''. @@ -1193,16 +1295,20 @@ sub html_editable_cell { } elsif ($value =~ /^\s*$/ ) { $value = '#'; } else { - $value = &HTML::Entities::encode($value) if ($value !~/ /); + $value = &HTML::Entities::encode($value,'<>&"') if ($value !~/ /); } return $value if (! $allowed); - # Make the formula safe for outputting - $formula =~ s/\'/\"/g; + # # The formula will be parsed by the browser twice before being - # displayed to the user for editing. - $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula)); - # Escape newlines so they make it into the edit window - $formula =~ s/\n/\\n/gs; + # displayed to the user for editing. + # + # The encoding string "^A-blah" is placed in []'s inside a regexp, so + # we specify the characters we want left alone by putting a '^' in front. + $formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%-;=?~'); + # HTML::Entities::encode does not catch everything - we need '\' encoded + $formula =~ s/\\/&\#092/g; + # Escape it again - this time the only encodable character is '&' + $formula =~ s/\&/\&/g; # Glue everything together $result .= "".$value.""; @@ -1212,20 +1318,25 @@ sub html_editable_cell { sub html_uneditable_cell { my ($cell,$bgcolor) = @_; my $value = (defined($cell) ? $cell->{'value'} : ''); - $value = &HTML::Entities::encode($value) if ($value !~/ /); + $value = &HTML::Entities::encode($value,'<>&"') if ($value !~/ /); return ' '.$value.' '; } sub html_row { my $self = shift(); - my ($num_uneditable,$row) = @_; + my ($num_uneditable,$row,$exportcolor,$importcolor) = @_; my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); my @rowdata = $self->get_row($row); my $num_cols_output = 0; my $row_html; + my $color = $importcolor; + if ($row == 0) { + $color = $exportcolor; + } + $color = '#FFDDDD' if (! defined($color)); foreach my $cell (@rowdata) { if ($num_cols_output++ < $num_uneditable) { - $row_html .= ''; + $row_html .= ''; $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); } else { $row_html .= ''; @@ -1240,12 +1351,27 @@ sub html_header { my $self = shift; return '' if (! $ENV{'request.role.adv'}); return "\n". - ''."\n". - '\n". + ''."\n". + '\n". "
Output Format
'.&output_selector()."
'.&mt('Output Format').'
'.$self->output_selector()."
\n"; } +## +## Default output types are HTML, Excel, and CSV +sub output_options { + my $self = shift(); + return ({value => 'html', + description => 'HTML'}, + {value => 'excel', + description => 'Excel'}, +# {value => 'xml', +# description => 'XML'}, + {value => 'csv', + description => 'Comma Separated Values'},); +} + sub output_selector { + my $self = shift(); my $output_selector = '\n"; return $output_selector; @@ -1294,9 +1417,9 @@ sub create_excel_spreadsheet { my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); if (! defined($workbook)) { $r->log_error("Error creating excel spreadsheet $filename: $!"); - $r->print("Problems creating new Excel file. ". + $r->print(&mt("Problems creating new Excel file. ". "This error has been logged. ". - "Please alert your LON-CAPA administrator"); + "Please alert your LON-CAPA administrator")); return undef; } # @@ -1310,10 +1433,25 @@ sub create_excel_spreadsheet { return ($workbook,$filename); } +# +# This routine is just a stub +sub outsheet_htmlclasslist { + my $self = shift; + my ($r) = @_; + $r->print('

'.&mt("This output is not supported").'

'); + $r->rflush(); + return; +} + sub outsheet_excel { my $self = shift; my ($r) = @_; - $r->print("

Preparing Excel Spreadsheet

"); + my $connection = $r->connection(); + # + $r->print($self->html_report_error()); + $r->rflush(); + # + $r->print("

".&mt('Preparing Excel Spreadsheet')."

"); # # Create excel worksheet my ($workbook,$filename) = $self->create_excel_spreadsheet($r); @@ -1336,7 +1474,7 @@ sub outsheet_excel { $self->excel_output_row($worksheet,0,$rows_output++,'Summary'); $rows_output++; # skip a line # - $self->excel_rows($worksheet,$cols_output,$rows_output); + $self->excel_rows($connection,$worksheet,$cols_output,$rows_output); # # # Close the excel file @@ -1354,6 +1492,11 @@ sub outsheet_excel { sub outsheet_csv { my $self = shift; my ($r) = @_; + my $connection = $r->connection(); + # + $r->print($self->html_report_error()); + $r->rflush(); + # my $csvdata = ''; my @Values; # @@ -1364,9 +1507,9 @@ sub outsheet_csv { my $file; unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) { $r->log_error("Couldn't open $filename for output $!"); - $r->print("Problems occured in writing the csv file. ". + $r->print(&mt("Problems occured in writing the csv file. ". "This error has been logged. ". - "Please alert your LON-CAPA administrator."); + "Please alert your LON-CAPA administrator.")); $r->print("
\n".$csvdata."
\n"); return 0; } @@ -1377,12 +1520,12 @@ sub outsheet_csv { } # # Output the body of the spreadsheet - $self->csv_rows($file); + $self->csv_rows($connection,$file); # # Close the csv file close($file); $r->print('

'. - 'Your CSV spreadsheet.'."\n"); + ''.&mt('Your CSV spreadsheet.').''."\n"); # return 1; } @@ -1418,17 +1561,20 @@ sub outsheet_xml { ## But not on this day my $Str = ''."\n"; while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { - if ($cell =~ /^template_(\d+)/) { + if ($cell =~ /^template_(\w+)/) { my $col = $1; $Str .= ''."\n"; } else { - my ($row,$col) = ($cell =~ /^([A-z])(\d+)/); + my ($col,$row) = ($cell =~ /^([A-z])(\d+)/); next if (! defined($row) || ! defined($col)); - $Str .= ''.$formula.'' + next if ($row != 0); + $Str .= + ''.$formula.'' ."\n"; } } $Str.=""; + $r->print("
\n\n\n".$Str."\n\n\n
"); return $Str; } @@ -1455,8 +1601,7 @@ sub parse_sheet { $formulas{$cell} = $formula; $sources{$cell} = $source if (defined($source)); $parser->get_text('/field'); - } - if ($token->[1] eq 'template') { + } elsif ($token->[1] eq 'template') { $formulas{'template_'.$token->[2]->{'col'}}= $parser->get_text('/template'); } @@ -1473,16 +1618,33 @@ sub clear_spreadsheet_definition_cache { undef(%spreadsheets); } -sub load { +sub load_system_default_sheet { my $self = shift; my $includedir = $Apache::lonnet::perlvar{'lonIncludes'}; + # load in the default defined spreadsheet + my $sheetxml=''; + my $fh; + if ($fh=Apache::File->new($includedir.'/default_'.$self->{'type'})) { + $sheetxml=join('',<$fh>); + $fh->close(); + } else { + # $sheetxml='"Error"'; + $sheetxml=''; + } + $self->filename('default_'); + my ($formulas,undef) = &parse_sheet(\$sheetxml); + return $formulas; +} + +sub load { + my $self = shift; # my $stype = $self->{'type'}; my $cnum = $self->{'cnum'}; my $cdom = $self->{'cdom'}; my $chome = $self->{'chome'}; - my $filename = $self->{'filename'}; # + my $filename = $self->filename(); my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); # # see if sheet is cached @@ -1491,19 +1653,9 @@ sub load { $formulas = $spreadsheets{$cachekey}->{'formulas'}; } else { # Not cached, need to read - if (! defined($self->filename())) { - # load in the default defined spreadsheet - my $sheetxml=''; - my $fh; - if ($fh=Apache::File->new($includedir.'/default.'.$filename)) { - $sheetxml=join('',<$fh>); - $fh->close(); - } else { - # $sheetxml='"Error"'; - $sheetxml=''; - } - ($formulas,undef) = &parse_sheet(\$sheetxml); - } elsif($self->filename() =~ /^\/res\/.*\.spreadsheet$/) { + if (! defined($filename)) { + $formulas = $self->load_system_default_sheet(); + } elsif($filename =~ /^\/res\/.*\.spreadsheet$/) { # Load a spreadsheet definition file my $sheetxml=&Apache::lonnet::getfile (&Apache::lonnet::filelocation('',$filename)); @@ -1512,31 +1664,27 @@ sub load { .$self->filename().'"'; } ($formulas,undef) = &parse_sheet(\$sheetxml); + # Get just the filename and set the sheets filename + my ($newfilename) = ($filename =~ /\/([^\/]*)\.spreadsheet$/); + if ($self->is_default()) { + $self->filename($newfilename); + $self->make_default(); + } else { + $self->filename($newfilename); + } } else { # Load the spreadsheet definition file from the save file - my %tmphash = &Apache::lonnet::dump($self->filename(),$cdom,$cnum); + my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum); my ($tmp) = keys(%tmphash); if ($tmp !~ /^(con_lost|error|no_such_host)/i) { while (my ($cell,$formula) = each(%tmphash)) { $formulas->{$cell}=$formula; } } else { - # Unable to grab the specified spreadsheet, - # so we get the default ones instead. - $filename = 'default.'.$stype; - $self->filename($filename); - my $sheetxml; - if (my $fh=Apache::File->new($includedir.'/'.$filename)) { - $sheetxml = join('',<$fh>); - $fh->close(); - } else { - $sheetxml=''. - '"Unable to load spreadsheet"'; - } - ($formulas,undef) = &parse_sheet(\$sheetxml); - $self->formulas($formulas); + $formulas = $self->load_system_default_sheet(); } } + $filename=$self->filename(); # filename may have changed $cachekey = join('_',($cnum,$cdom,$stype,$filename)); %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas}; } @@ -1548,18 +1696,31 @@ sub load { sub set_row_sources { my $self = shift; while (my ($cell,$value) = each(%{$self->{'formulas'}})) { - next if ($cell !~ /^A(\d+)/ && $1 > 0); + next if ($cell !~ /^A(\d+)/ || $1 < 1); my $row = $1; $self->{'row_source'}->{$row} = $value; } return; } +sub set_row_numbers { + my $self = shift; + while (my ($cell,$value) = each(%{$self->{'formulas'}})) { + next if ($cell !~ /^A(\d+)$/); + next if (! defined($value)); + $self->{'row_numbers'}->{$value} = $1; + $self->{'maxrow'} = $1 if ($1 > $self->{'maxrow'}); + } +} + ## ## exportrow is *not* used to get the export row from a computed sub-sheet. ## sub exportrow { my $self = shift; + if (exists($self->{'badcalc'}) && $self->{'badcalc'}) { + return (); + } my @exportarray; foreach my $column (@UC_Columns) { push(@exportarray,$self->value($column.'0')); @@ -1579,27 +1740,33 @@ sub save { my $cnum = $self->{'cnum'}; my $cdom = $self->{'cdom'}; my $chome = $self->{'chome'}; - my $fn = $self->{'filename'}; + my $filename = $self->{'filename'}; + my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); # Cache new sheet - $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); + %{$spreadsheets{$cachekey}->{'formulas'}}=%f; # Write sheet foreach (keys(%f)) { delete($f{$_}) if ($f{$_} eq 'import'); } - my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum); + my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum); return $reply if ($reply ne 'ok'); $reply = &Apache::lonnet::put($stype.'_spreadsheets', - {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, + {$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, $cdom,$cnum); return $reply if ($reply ne 'ok'); if ($makedef) { $reply = &Apache::lonnet::put('environment', - {'spreadsheet_default_'.$stype => $fn }, + {'spreadsheet_default_'.$stype => $filename }, $cdom,$cnum); return $reply if ($reply ne 'ok'); } if ($self->is_default()) { - &Apache::lonnet::expirespread('','',$self->{'type'},''); + if ($self->{'type'} eq 'studentcalc') { + &Apache::lonnet::expirespread('','','studentcalc',''); + } elsif ($self->{'type'} eq 'assesscalc') { + &Apache::lonnet::expirespread('','','assesscalc',''); + &Apache::lonnet::expirespread('','','studentcalc',''); + } } return $reply; } @@ -1611,7 +1778,7 @@ sub save { sub save_tmp { my $self = shift; my $filename=$ENV{'user.name'}.'_'. - $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. + $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. $self->{'filename'}; $filename=~s/\W/\_/g; $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; @@ -1631,7 +1798,7 @@ sub save_tmp { sub load_tmp { my $self = shift; my $filename=$ENV{'user.name'}.'_'. - $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. + $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. $self->{'filename'}; $filename=~s/\W/\_/g; $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; @@ -1689,9 +1856,9 @@ sub othersheets { $self->{'cdom'}, $self->{'cnum'}); my ($tmp) = keys(%results); if ($tmp =~ /^(con_lost|error|no_such_host)/i ) { - @alternatives = ('Default'); + @alternatives = (&mt('Default')); } else { - @alternatives = sort (keys(%results)); + @alternatives = (&mt('Default'), sort (keys(%results))); } return @alternatives; } @@ -1727,14 +1894,12 @@ sub get_template_row { return @cols; } -sub set_row_numbers { +sub need_to_save { my $self = shift; - my %f=$self->formulas(); - while (my ($cell,$value) = each(%{$self->{'formulas'}})) { - next if ($cell !~ /^A(\d+)$/); - next if (! defined($value)); - $self->{'row_numbers'}->{$value} = $1; + if ($self->{'new_rows'} && ! $self->temporary()) { + return 1; } + return 0; } sub get_row_number_from_key { @@ -1746,6 +1911,9 @@ sub get_row_number_from_key { # may not be the key we need to save $self->{'maxrow'}++; $self->{'row_numbers'}->{$key} = $self->{'maxrow'}; +# $self->logthis('added row '.$self->{'row_numbers'}->{$key}. +# ' for '.$key); + $self->{'new_rows'} = 1; } return $self->{'row_numbers'}->{$key}; } 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.