--- loncom/interface/loncommon.pm 2001/07/26 16:00:24 1.3 +++ loncom/interface/loncommon.pm 2003/08/13 20:40:31 1.111 @@ -1,19 +1,1466 @@ -# The LearningOnline Network +# The LearningOnline Network with CAPA # a pile of common routines -# 2/13 Guy Albertelli +# +# $Id: loncommon.pm,v 1.111 2003/08/13 20:40:31 www 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/21 Gerd Kortemeyer +# 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::Constants qw(:common); +use Apache::lonnet(); +use GDBM_File; +use POSIX qw(strftime mktime); +use Apache::Constants qw(:common :http :methods); use Apache::lonmsg(); +use Apache::lonmenu(); +my $readit; + +=pod + +=item Global Variables + +=over 4 + +=cut +# ----------------------------------------------- Filetypes/Languages/Copyright +my %language; +my %cprtag; +my %fe; my %fd; +my %category_extensions; + +# ---------------------------------------------- Designs + +my %designhash; + +# ---------------------------------------------- Thesaurus variables + +=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 + +=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 + { + my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. + '/language.tab'); + if ($fh) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_)); + $language{$key}=$val.' - '.$enc; + } + } + } +# ------------------------------------------------------------------ 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; + } + } + } + +# -------------------------------------------------------------- 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'}. + '/filecategories.tab'); + if ($fh) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($extension,$category)=(split(/\s+/,$_,2)); + push @{$category_extensions{lc($category)}},$extension; + } + } + } +# ------------------------------------------------------------------ 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; + } + } + } + } + &Apache::lonnet::logthis( + "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 < + var stdeditbrowser; + function openstdbrowser(formname,uname,udom,roleflag) { + var url = '/adm/pickstudent?'; + var filter; + eval('filter=document.'+formname+'.'+uname+'.value;'); + if (filter != null) { + if (filter != '') { + url += 'filter='+filter+'&'; + } + } + url += 'form=' + formname + '&unameelement='+uname+ + '&udomelement='+udom; + if (roleflag) { url+="&roles=1"; } + var title = 'Student_Browser'; + var options = 'scrollbars=1,resizable=1,menubar=0'; + options += ',width=700,height=600'; + stdeditbrowser = open(url,title,options,'1'); + stdeditbrowser.focus(); + } + +ENDSTDBRW +} + +sub selectstudent_link { + my ($form,$unameele,$udomele)=@_; + if ($ENV{'request.course.id'}) { + unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { + return ''; + } + return "Select User"; + } + if ($ENV{'request.role'}=~/^(au|dc|su)/) { + return "Select User"; + } + return ''; +} + +sub coursebrowser_javascript { + return (<<'ENDSTDBRW'); + +ENDSTDBRW +} + +sub selectcourse_link { + my ($form,$unameele,$udomele)=@_; + return "Select Course"; +} + +############################################################### + +=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"; + } + $selectform.=""; + return $selectform; +} + + +#------------------------------------------- + +=pod + +=item select_dom_form($defdom,$name,$includeempty) + +Returns a string containing a \n"; + foreach (@domains) { + $selectdomain.="\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