--- loncom/interface/loncommon.pm 2001/07/26 16:00:24 1.3
+++ loncom/interface/loncommon.pm 2003/09/16 19:23:47 1.117
@@ -1,19 +1,1693 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# a pile of common routines
-# 2/13 Guy Albertelli
+#
+# $Id: loncommon.pm,v 1.117 2003/09/16 19:23:47 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
+
+Common routines for manipulating connections, student answers,
+ domains, common Javascript fragments, etc.
+
+=head1 OVERVIEW
+
+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.
+
+=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();
+use Apache::lonlocal;
+
+my $readit;
+
+=pod
+
+=head1 Global Variables
+
+=cut
+
+# ----------------------------------------------- Filetypes/Languages/Copyright
+my %language;
+my %cprtag;
+my %fe; my %fd;
+my %category_extensions;
+
+# ---------------------------------------------- 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
+
+=head1 General Subroutines
+
+=over 4
+
+=item * BEGIN()
+
+Initialize values from language.tab, copyright.tab, filetypes.tab,
+thesaurus.tab, and filecategories.tab.
+
+=back
+
+=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)
+
+}
+
+###############################################################
+## HTML and Javascript Helper Functions ##
+###############################################################
+
+=pod
+
+=head1 HTML and Javascript Functions
+
+=over 4
+
+=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]
+
+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