--- loncom/interface/loncommon.pm 2002/03/28 22:15:56 1.30 +++ loncom/interface/loncommon.pm 2002/10/18 13:49:49 1.70 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.30 2002/03/28 22:15:56 albertel Exp $ +# $Id: loncommon.pm,v 1.70 2002/10/18 13:49:49 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,40 +33,116 @@ # 12/25,12/28 Gerd Kortemeyer # YEAR=2002 # 1/4 Gerd Kortemeyer +# 6/24,7/2 H. K. Ng # Makes a table out of the previous attempts # Inputs result_from_symbread, user, domain, course_id # Reads in non-network-related .tab files +# POD header: + +=pod + +=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. + +=head2 General Subroutines + +=over 4 + +=cut + +# End of POD header package Apache::loncommon; use strict; use Apache::lonnet(); -use POSIX qw(strftime); +use GDBM_File; +use POSIX qw(strftime mktime); use Apache::Constants qw(:common); use Apache::lonmsg(); - my $readit; +=pod + +=item Global Variables + +=over 4 + +=cut # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %cprtag; my %fe; my %fd; -my %fc; +my %category_extensions; + +# ---------------------------------------------- Designs + +my %designhash; + +# ---------------------------------------------- Thesaurus variables -# -------------------------------------------------------------- Thesaurus data -my @therelated; -my @theword; -my @thecount; -my %theindex; -my $thetotalcount; -my $thefuzzy=2; -my $thethreshold=0.1/$thefuzzy; -my $theavecount; +=pod + +=item %Keywords + +A hash used by &keyword to determine if a word is considered a keyword. + +=item $thesaurus_db_file + +Scalar containing the full path to the thesaurus database. + +=cut + +my %Keywords; +my $thesaurus_db_file; + + +=pod + +=back + +=cut # ----------------------------------------------------------------------- BEGIN -BEGIN { +=pod + +=item BEGIN() + +Initialize values from language.tab, copyright.tab, filetypes.tab, +thesaurus.tab, and filecategories.tab. + +=cut + +# ----------------------------------------------------------------------- BEGIN + +BEGIN { + # Variable initialization + $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db"; + # unless ($readit) { # ------------------------------------------------------------------- languages { @@ -94,6 +170,30 @@ BEGIN { } } } + +# -------------------------------------------------------------- domain designs + + my $filename; + my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; + opendir(DIR,$designdir); + while ($filename=readdir(DIR)) { + my ($domain)=($filename=~/^(\w+)\./); + { + my $fh=Apache::File->new($designdir.'/'.$filename); + if ($fh) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\=/,$_)); + if ($val) { $designhash{$domain.'.'.$key}=$val; } + } + } + } + + } + closedir(DIR); + + # ------------------------------------------------------------- file categories { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. @@ -102,8 +202,8 @@ BEGIN { while (<$fh>) { next if /^\#/; chomp; - my ($key,$val)=(split(/\s+/,$_,2)); - push @{$fc{$key}},$val; + my ($extension,$category)=(split(/\s+/,$_,2)); + push @{$category_extensions{lc($category)}},$extension; } } } @@ -123,87 +223,806 @@ BEGIN { } } } -# -------------------------------------------------------------- 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"); + "INFO: Read file types"); $readit=1; + } # end of unless($readit) + } +# ============================================================= END BEGIN BLOCK +############################################################### +## HTML and Javascript Helper Functions ## +############################################################### + +=pod + +=item browser_and_searcher_javascript + +Returns scalar containing javascript to open a browser window +or a searcher window. Also creates + +=over 4 + +=item openbrowser(formname,elementname,only,omit) [javascript] + +inputs: formname, elementname, only, omit + +formname and elementname indicate the name of the html form and name of +the element that the results of the browsing selection are to be placed in. + +Specifying 'only' will restrict the browser to displaying only files +with the given extension. Can be a comma seperated list. + +Specifying 'omit' will restrict the browser to NOT displaying files +with the given extension. Can be a comma seperated list. + +=item opensearcher(formname, elementname) [javascript] + +Inputs: formname, elementname +formname and elementname specify the name of the html form and the name +of the element the selection from the search results will be placed in. + +=back + +=cut + +############################################################### +sub browser_and_searcher_javascript { + return <$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; - } - } - } - } +############################################################### + +=pod + +=item linked_select_forms(...) + +linked_select_forms returns a string containing a block +and html for two tags + +=item $firstdefault, the default value for the first menu + +=item $firstselectname, the name of the first tag + +=item $hashref, a reference to a hash containing the data for the menus. + +=back + +Below is an example of such a hash. Only the 'text', 'default', and +'select2' keys must appear as stated. keys(%menu) are the possible +values for the first select menu. The text that coincides with the +first menu value is given in $menu{$choice1}->{'text'}. The values +and text for the second menu are given in the hash pointed to by +$menu{$choice1}->{'select2'}. + +my %menu = ( A1 => { text =>"Choice A1" , + default => "B3", + select2 => { + B1 => "Choice B1", + B2 => "Choice B2", + B3 => "Choice B3", + B4 => "Choice B4" + } + }, + A2 => { text =>"Choice A2" , + default => "C2", + select2 => { + C1 => "Choice C1", + C2 => "Choice C2", + C3 => "Choice C3" + } + }, + A3 => { text =>"Choice A3" , + default => "D6", + select2 => { + D1 => "Choice D1", + D2 => "Choice D2", + D3 => "Choice D3", + D4 => "Choice D4", + D5 => "Choice D5", + D6 => "Choice D6", + D7 => "Choice D7" + } } - } + ); + +=cut + +# ------------------------------------------------ + +sub linked_select_forms { + my ($formname, + $middletext, + $firstdefault, + $firstselectname, + $secondselectname, + $hashref + ) = @_; + my $second = "document.$formname.$secondselectname"; + my $first = "document.$formname.$firstselectname"; + # output the javascript to do the changing + my $result = ''; + $result.=" +END + # output the initial values for the selection lists + $result .= "\n"; + my $seconddefault = $hashref->{$firstdefault}->{'default'}; + foreach my $value (sort(keys(%select2))) { + $result.=" \n"; + } + $selectdomain.=""; + return $selectdomain; +} + +#------------------------------------------- + +=pod + +=item get_library_servers($domain) + +Returns a hash which contains keys like '103l3' and values like +'kirk.lite.msu.edu'. All of the keys will be for machines in the +given $domain. + +=cut + +#------------------------------------------- +sub get_library_servers { + my $domain = shift; + my %library_servers; + foreach (keys(%Apache::lonnet::libserv)) { + if ($Apache::lonnet::hostdom{$_} eq $domain) { + $library_servers{$_} = $Apache::lonnet::hostname{$_}; + } + } + return %library_servers; +} + +#------------------------------------------- + +=pod + +=item home_server_option_list($domain) + +returns a string which contains an