--- loncom/interface/loncommon.pm 2001/07/26 15:50:25 1.2 +++ loncom/interface/loncommon.pm 2001/12/11 13:51:38 1.13 @@ -1,6 +1,33 @@ -# The LearningOnline Network +# The LearningOnline Network with CAPA # a pile of common routines -# 2/13 Guy Albertelli +# +# $Id: loncommon.pm,v 1.13 2001/12/11 13:51:38 harris41 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/ +# +# YEAR=2001 +# 2/13-12/7 Guy Albertelli +# 12/11 Scott Harrison # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id @@ -8,44 +35,93 @@ package Apache::loncommon; use strict; +use POSIX qw(strftime); use Apache::Constants qw(:common); use Apache::lonmsg(); +my %language; +my %cprtag; +my %fe; my %fd; + +# ----------------------------------------------------------------------- BEGIN +sub BEGIN { +# ------------------------------------------------------------------- languages + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/language.tab'); + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,2)); + $language{$key}=$val; + } + } +# ------------------------------------------------------------------ copyrights + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/copyright.tab'); + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,2)); + $cprtag{$key}=$val; + } + } +# ------------------------------------------------------------------ file types + { + my $fh=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab"); + while (<$fh>) { + next if (/^\#/); + chomp; + my ($ending,$emb,$descr)=split(/\s+/,$_,3); + if ($descr ne '') { + $fe{$ending}=lc($emb); + $fd{$ending}=join(' ',@descr); + } + } + } +} + sub get_previous_attempt { my ($symb,$username,$domain,$course)=@_; my $prevattempts=''; if ($symb) { - my $answer=&Apache::lonnet::reply( - "restore:".$domain.':'.$username.':'.$course.':'. - &Apache::lonnet::escape($symb)); - my %returnhash=(); - map { - my ($name,$value)=split(/\=/,$_); - $returnhash{&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); - } split(/\&/,$answer); + my (%returnhash)= + &Apache::lonnet::restore($symb,$course,$domain,$username); if ($returnhash{'version'}) { my %lasthash=(); my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { map { $lasthash{$_}=$returnhash{$version.':'.$_}; - } split(/\:/,$returnhash{$version.':keys'}); + } sort(split(/\:/,$returnhash{$version.':keys'})); } $prevattempts=''; map { $prevattempts.=''; - } keys %lasthash; + } sort(keys %lasthash); for ($version=1;$version<=$returnhash{'version'};$version++) { $prevattempts.=''; map { - $prevattempts.=''; - } keys %lasthash; + my $value; + if ($_ =~ /timestamp/) { + $value=scalar(localtime($returnhash{$version.':'.$_})); + } else { + $value=$returnhash{$version.':'.$_}; + } + $prevattempts.=''; + } sort(keys %lasthash); } $prevattempts.=''; map { - $prevattempts.=''; - } keys %lasthash; + my $value; + if ($_ =~ /timestamp/) { + $value=scalar(localtime($lasthash{$_})); + } else { + $value=$lasthash{$_}; + } + $prevattempts.=''; + } sort(keys %lasthash); $prevattempts.='
History'.$_.'
Attempt '.$version.''.$returnhash{$version.':'.$_}.''.$value.'
Current'.$lasthash{$_}.''.$value.'
'; } else { $prevattempts='Nothing submitted - no attempts.'; @@ -55,5 +131,81 @@ sub get_previous_attempt { } } +sub get_student_view { + my ($symb,$username,$domain,$courseid) = @_; + my ($map,$id,$feedurl) = split(/___/,$symb); + my (%old,%moreenv); + my @elements=('symb','courseid','domain','username'); + foreach my $element (@elements) { + $old{$element}=$ENV{'form.grade_'.$element}; + $moreenv{'form.grade_'.$element}=eval '$'.$element #' + } + &Apache::lonnet::appenv(%moreenv); + my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); + &Apache::lonnet::delenv('form.grade_'); + foreach my $element (@elements) { + $ENV{'form.grade_'.$element}=$old{$element}; + } + $userview=~s/\]*\>//gi; + $userview=~s/\<\/body\>//gi; + $userview=~s/\//gi; + $userview=~s/\<\/html\>//gi; + $userview=~s/\//gi; + $userview=~s/\<\/head\>//gi; + $userview=~s/action\s*\=/would_be_action\=/gi; + return $userview; +} + +sub get_student_answers { + my ($symb,$username,$domain,$courseid) = @_; + my ($map,$id,$feedurl) = split(/___/,$symb); + my (%old,%moreenv); + my @elements=('symb','courseid','domain','username'); + foreach my $element (@elements) { + $old{$element}=$ENV{'form.grade_'.$element}; + $moreenv{'form.grade_'.$element}=eval '$'.$element #' + } + $moreenv{'form.grade_target'}='answer'; + &Apache::lonnet::appenv(%moreenv); + my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); + &Apache::lonnet::delenv('form.grade_'); + foreach my $element (@elements) { + $ENV{'form.grade_'.$element}=$old{$element}; + } + $userview=~s/\]*\>//gi; + $userview=~s/\<\/body\>//gi; + $userview=~s/\//gi; + $userview=~s/\<\/html\>//gi; + $userview=~s/\//gi; + $userview=~s/\<\/head\>//gi; + $userview=~s/action\s*\=/would_be_action\=/gi; + return $userview; +} + +sub get_unprocessed_cgi { + my ($query)= @_; + map { + my ($name, $value) = split(/=/,$_); + $value =~ tr/+/ /; + $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + if (!defined($ENV{'form.'.$name})) { $ENV{'form.'.$name}=$value; } + } (split(/&/,$query)); +} + +sub cacheheader { + my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); + my $output .=' + + '; + return $output; +} + +sub no_cache { + my ($r) = @_; + my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); + $r->no_cache(1); + $r->header_out("Pragma" => "no-cache"); + $r->header_out("Expires" => $date); +} 1; __END__;