--- loncom/interface/loncommon.pm 2001/10/26 17:09:04 1.7 +++ loncom/interface/loncommon.pm 2002/03/06 20:24:44 1.26 @@ -1,16 +1,262 @@ -# The LearningOnline Network +# The LearningOnline Network with CAPA # a pile of common routines -# 2/13 Guy Albertelli +# +# $Id: loncommon.pm,v 1.26 2002/03/06 20:24:44 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/ +# +# YEAR=2001 +# 2/13-12/7 Guy Albertelli +# 12/11,12/12,12/17 Scott Harrison +# 12/21 Gerd Kortemeyer +# 12/21 Scott Harrison +# 12/25,12/28 Gerd Kortemeyer +# YEAR=2002 +# 1/4 Gerd Kortemeyer # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id +# Reads in non-network-related .tab files package Apache::loncommon; use strict; +use Apache::lonnet(); +use POSIX qw(strftime); use Apache::Constants qw(:common); use Apache::lonmsg(); +my $readit; + +# ----------------------------------------------- Filetypes/Languages/Copyright +my %language; +my %cprtag; +my %fe; my %fd; +my %fc; + +# -------------------------------------------------------------- Thesaurus data +my @therelated; +my @theword; +my @thecount; +my %theindex; +my $thetotalcount; +my $thefuzzy=2; +my $thethreshold=0.1/$thefuzzy; +my $theavecount; + +# ----------------------------------------------------------------------- BEGIN +BEGIN { + + unless ($readit) { +# ------------------------------------------------------------------- languages + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/language.tab'); + if ($fh) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,2)); + $language{$key}=$val; + } + } + } +# ------------------------------------------------------------------ copyrights + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}. + '/copyright.tab'); + if ($fh) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,2)); + $cprtag{$key}=$val; + } + } + } +# ------------------------------------------------------------- file categories + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/filecategories.tab'); + if ($fh) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,2)); + push @{$fc{$key}},$val; + } + } + } +# ------------------------------------------------------------------ file types + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/filetypes.tab'); + if ($fh) { + while (<$fh>) { + next if (/^\#/); + chomp; + my ($ending,$emb,$descr)=split(/\s+/,$_,3); + if ($descr ne '') { + $fe{$ending}=lc($emb); + $fd{$ending}=$descr; + } + } + } + } +# -------------------------------------------------------------- Thesaurus data + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/thesaurus.dat'); + if ($fh) { + while (<$fh>) { + my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_); + $theindex{$tword}=$tindex; + $theword[$tindex]=$tword; + $thecount[$tindex]=$tcount; + $thetotalcount+=$tcount; + $therelated[$tindex]=$trelated; + } + } + $theavecount=$thetotalcount/$#thecount; + } + &Apache::lonnet::logthis( + "INFO: Read file types and thesaurus"); + $readit=1; +} + +} +# ============================================================= END BEGIN BLOCK + + +# ---------------------------------------------------------- Is this a keyword? + +sub keyword { + my $newword=shift; + $newword=~s/\W//g; + $newword=~tr/A-Z/a-z/; + my $tindex=$theindex{$newword}; + if ($tindex) { + if ($thecount[$tindex]>$theavecount) { + return 1; + } + } + return 0; +} +# -------------------------------------------------------- Return related words + +sub related { + my $newword=shift; + $newword=~s/\W//g; + $newword=~tr/A-Z/a-z/; + my $tindex=$theindex{$newword}; + if ($tindex) { + my %found=(); + foreach (split(/\,/,$therelated[$tindex])) { +# - Related word found + my ($ridx,$rcount)=split(/\:/,$_); +# - Direct relation index + my $directrel=$rcount/$thecount[$tindex]; + if ($directrel>$thethreshold) { + foreach (split(/\,/,$therelated[$ridx])) { + my ($rridx,$rrcount)=split(/\:/,$_); + if ($rridx==$tindex) { +# - Determine reverse relation index + my $revrel=$rrcount/$thecount[$ridx]; +# - Calculate full index + $found{$ridx}=$directrel*$revrel; + if ($found{$ridx}>$thethreshold) { + foreach (split(/\,/,$therelated[$ridx])) { + my ($rrridx,$rrrcount)=split(/\:/,$_); + unless ($found{$rrridx}) { + my $revrevrel=$rrrcount/$thecount[$ridx]; + if ( + $directrel*$revrel*$revrevrel>$thethreshold + ) { + $found{$rrridx}= + $directrel*$revrel*$revrevrel; + } + } + } + } + } + } + } + } + } + return (); +} + +# ---------------------------------------------------------------- Language IDs +sub languageids { + return sort(keys(%language)); +} + +# -------------------------------------------------------- Language Description +sub languagedescription { + return $language{shift(@_)}; +} + +# --------------------------------------------------------------- Copyright IDs +sub copyrightids { + return sort(keys(%cprtag)); +} + +# ------------------------------------------------------- Copyright Description +sub copyrightdescription { + return $cprtag{shift(@_)}; +} + +# ------------------------------------------------------------- File Categories +sub filecategories { + return sort(keys(%fc)); +} + +# -------------------------------------- File Types within a specified category +sub filecategorytypes { + return @{$fc{lc(shift(@_))}}; +} + +# ------------------------------------------------------------------ File Types +sub fileextensions { + return sort(keys(%fe)); +} + +# ------------------------------------------------------------- Embedding Style +sub fileembstyle { + return $fe{lc(shift(@_))}; +} + +# ------------------------------------------------------------ Description Text +sub filedescription { + return $fd{lc(shift(@_))}; +} + +# ------------------------------------------------------------ Description Text +sub filedescriptionex { + my $ex=shift; + return '.'.$ex.' '.$fd{lc($ex)}; +} + sub get_previous_attempt { my ($symb,$username,$domain,$course)=@_; my $prevattempts=''; @@ -21,17 +267,17 @@ sub get_previous_attempt { my %lasthash=(); my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { - map { + foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { $lasthash{$_}=$returnhash{$version.':'.$_}; - } sort(split(/\:/,$returnhash{$version.':keys'})); + } } $prevattempts=''; - map { + foreach (sort(keys %lasthash)) { $prevattempts.=''; - } sort(keys %lasthash); + } for ($version=1;$version<=$returnhash{'version'};$version++) { $prevattempts.=''; - map { + foreach (sort(keys %lasthash)) { my $value; if ($_ =~ /timestamp/) { $value=scalar(localtime($returnhash{$version.':'.$_})); @@ -39,10 +285,10 @@ sub get_previous_attempt { $value=$returnhash{$version.':'.$_}; } $prevattempts.=''; - } sort(keys %lasthash); + } } $prevattempts.=''; - map { + foreach (sort(keys %lasthash)) { my $value; if ($_ =~ /timestamp/) { $value=scalar(localtime($lasthash{$_})); @@ -50,7 +296,7 @@ sub get_previous_attempt { $value=$lasthash{$_}; } $prevattempts.=''; - } sort(keys %lasthash); + } $prevattempts.='
History'.$_.'
Attempt '.$version.''.$value.'
Current'.$value.'
'; } else { $prevattempts='Nothing submitted - no attempts.'; @@ -60,23 +306,216 @@ 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 ($query,$possible_names)= @_; + # $Apache::lonxml::debug=1; + foreach (split(/&/,$query)) { 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)); + $name = &Apache::lonnet::unescape($name); + if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { + $value =~ tr/+/ /; + $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + &Apache::lonxml::debug("Seting :$name: to :$value:"); + &add_to_env('form.'.$name,$value); + } + } } sub cacheheader { - my $date=localtime; + unless ($ENV{'request.method'} eq 'GET') { return ''; } + my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); my $output .=' '; return $output; } +sub no_cache { + my ($r) = @_; + unless ($ENV{'request.method'} eq 'GET') { return ''; } + #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); +} + +sub add_to_env { + my ($name,$value)=@_; + if ($ENV{$name}) { + if (defined(@{ $ENV{$name} })) { + #already have multiple values + push(@{ $ENV{$name} },$value); + } else { + #first time seeing multiple values, convert hash entry to an arrayref + my $first=$ENV{$name}; + undef($ENV{$name}); + push(@{ $ENV{$name} },$first,$value); + } + } else { + $ENV{$name}=$value; + } +} 1; __END__; + + +=head1 NAME + +Apache::loncommon - pile of common routines + +=head1 SYNOPSIS + +Referenced by other mod_perl Apache modules. + +Invocation: + &Apache::loncommon::SUBROUTINENAME(ARGUMENTS); + +=head1 INTRODUCTION + +Common collection of used subroutines. This collection helps remove +redundancy from other modules and increase efficiency of memory usage. + +Current things done: + + Makes a table out of the previous homework attempts + Inputs result_from_symbread, user, domain, course_id + Reads in non-network-related .tab files + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 HANDLER SUBROUTINE + +There is no handler subroutine. + +=head1 OTHER SUBROUTINES + +=over 4 + +=item * + +BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab, +and filecategories.tab. + +=item * + +languageids() : returns list of all language ids + +=item * + +languagedescription() : returns description of a specified language id + +=item * + +copyrightids() : returns list of all copyrights + +=item * + +copyrightdescription() : returns description of a specified copyright id + +=item * + +filecategories() : returns list of all file categories + +=item * + +filecategorytypes() : returns list of file types belonging to a given file +category + +=item * + +fileembstyle() : returns embedding style for a specified file type + +=item * + +filedescription() : returns description for a specified file type + +=item * + +filedescriptionex() : returns description for a specified file type with +extra formatting + +=item * + +get_previous_attempt() : return string with previous attempt on problem + +=item * + +get_student_view() : show a snapshot of what student was looking at + +=item * + +get_student_answers() : show a snapshot of how student was answering problem + +=item * + +get_unprocessed_cgi() : get unparsed CGI parameters + +=item * + +cacheheader() : returns cache-controlling header code + +=item * + +nocache() : specifies header code to not have cache + +=item * + +add_to_env($name,$value) : adds $name to the %ENV hash with value +$value, if $name already exists, the entry is converted to an array +reference and $value is added to the array. + +=back + +=cut