--- loncom/interface/loncommon.pm 2002/07/03 21:12:38 1.43 +++ loncom/interface/loncommon.pm 2003/10/24 13:35:37 1.134 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.43 2002/07/03 21:12:38 ng Exp $ +# $Id: loncommon.pm,v 1.134 2003/10/24 13:35:37 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -27,9 +27,7 @@ # # 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 @@ -41,35 +39,23 @@ # 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); +Common routines for manipulating connections, student answers, + domains, common Javascript fragments, etc. -=head1 INTRODUCTION +=head1 OVERVIEW -Common collection of used subroutines. This collection helps remove +A collection of commonly used subroutines that don't have a natural +home anywhere else. 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 @@ -77,41 +63,81 @@ package Apache::loncommon; use strict; use Apache::lonnet(); -use POSIX qw(strftime); -use Apache::Constants qw(:common); +use GDBM_File; +use POSIX qw(strftime mktime); +use Apache::Constants qw(:common :http :methods); use Apache::lonmsg(); +use Apache::lonmenu(); +use Apache::lonlocal; + my $readit; +=pod + +=head1 Global Variables + +=cut + # ----------------------------------------------- Filetypes/Languages/Copyright my %language; +my %supported_language; my %cprtag; my %fe; my %fd; my %category_extensions; -# -------------------------------------------------------------- Thesaurus data -my @therelated; -my @theword; -my @thecount; -my %theindex; -my $thetotalcount; -my $thefuzzy=2; -my $thethreshold=0.1/$thefuzzy; -my $theavecount; +# ---------------------------------------------- Designs + +my %designhash; + +# ---------------------------------------------- Thesaurus variables + +# FIXME: I don't think it's necessary to document these things; +# they're privately used - Jeremy + +=pod + +=over 4 + +=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. + +=back + +=cut + +my %Keywords; +my $thesaurus_db_file; # ----------------------------------------------------------------------- BEGIN +# FIXME: I don't think this needs to be documented, it prepares +# private data structures - Jeremy =pod -=item BEGIN() +=head1 General Subroutines + +=over 4 + +=item * BEGIN() Initialize values from language.tab, copyright.tab, filetypes.tab, -and filecategories.tab. +thesaurus.tab, and filecategories.tab. + +=back =cut + # ----------------------------------------------------------------------- BEGIN BEGIN { - + # Variable initialization + $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db"; + # unless ($readit) { # ------------------------------------------------------------------- languages { @@ -121,8 +147,11 @@ BEGIN { while (<$fh>) { next if /^\#/; chomp; - my ($key,$val)=(split(/\s+/,$_,2)); - $language{$key}=$val; + my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_)); + $language{$key}=$val.' - '.$enc; + if ($sup) { + $supported_language{$key}=$sup; + } } } } @@ -139,6 +168,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'}. @@ -168,43 +221,33 @@ 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 +=head1 HTML and Javascript Functions + +=over 4 -Returns scalar containing javascript to open a browser window -or a searcher window. Also creates +=item * browser_and_searcher_javascript () + +XXReturns a string +containing javascript with two functions, C and +C. Returned string does not contain EscriptE +tags. =over 4 -=item openbrowser(formname,elementname,only,omit) [javascript] +=item * openbrowser(formname,elementname,only,omit) [javascript] inputs: formname, elementname, only, omit @@ -217,7 +260,7 @@ with the given extension. Can be a comm 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] +=item * opensearcher(formname, elementname) [javascript] Inputs: formname, elementname @@ -228,10 +271,9 @@ of the element the selection from the se =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 "".&mt('Select User').""; + } + if ($ENV{'request.role'}=~/^(au|dc|su)/) { + return "".&mt('Select User').""; + } + return ''; +} + +sub coursebrowser_javascript { + my ($domainfilter)=@_; + return (< + var stdeditbrowser; + function opencrsbrowser(formname,uname,udom) { + var url = '/adm/pickcourse?'; + var filter; + if (filter != null) { + if (filter != '') { + url += 'filter='+filter+'&'; + } + } + var domainfilter='$domainfilter'; + if (domainfilter != null) { + if (domainfilter != '') { + url += 'domainfilter='+domainfilter+'&'; + } + } + url += 'form=' + formname + '&cnumelement='+uname+ + '&cdomelement='+udom; + var title = 'Course_Browser'; + var options = 'scrollbars=1,resizable=1,menubar=0'; + options += ',width=700,height=600'; + stdeditbrowser = open(url,title,options,'1'); + stdeditbrowser.focus(); + } + +ENDSTDBRW +} -############################################################### +sub selectcourse_link { + my ($form,$unameele,$udomele)=@_; + return "".&mt('Select Course').""; +} =pod -=item linked_select_forms(...) +=item * linked_select_forms(...) linked_select_forms returns a string containing a block and html for two tags +=item * $middletext, the text which appears between the tag +=item * $firstselectname, the name of the first tag +=item * $secondselectname, the name of the second \n"; my %select2 = %{$hashref->{$firstdefault}->{'select2'}}; @@ -419,16 +537,102 @@ END foreach my $value (sort(keys(%select2))) { $result.="