--- loncom/interface/loncommon.pm 2001/12/11 19:37:12 1.14 +++ loncom/interface/loncommon.pm 2001/12/25 21:57:54 1.21 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.14 2001/12/11 19:37:12 harris41 Exp $ +# $Id: loncommon.pm,v 1.21 2001/12/25 21:57:54 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -27,10 +27,14 @@ # # YEAR=2001 # 2/13-12/7 Guy Albertelli -# 12/11 Scott Harrison +# 12/11,12/12,12/17 Scott Harrison +# 12/21 Gerd Kortemeyer +# 12/21 Scott Harrison +# 12/25 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; @@ -39,87 +43,206 @@ use POSIX qw(strftime); use Apache::Constants qw(:common); use Apache::lonmsg(); +# ----------------------------------------------- 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 -sub BEGIN { +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; + 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'}. - '/copyright.tab'); - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\s+/,$_,2)); - $cprtag{$key}=$val; + '/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("$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); + 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; + } +} +# ============================================================= 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 { @@ -132,17 +255,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.':'.$_})); @@ -150,10 +273,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{$_})); @@ -161,7 +284,7 @@ sub get_previous_attempt { $value=$lasthash{$_}; } $prevattempts.=''; - } sort(keys %lasthash); + } $prevattempts.='
History'.$_.'
Attempt '.$version.''.$value.'
Current'.$value.'
'; } else { $prevattempts='Nothing submitted - no attempts.'; @@ -224,12 +347,12 @@ sub get_student_answers { sub get_unprocessed_cgi { my ($query)= @_; - map { + 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)); + } } sub cacheheader { @@ -249,3 +372,108 @@ sub no_cache { } 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 + +=back + +=cut