--- loncom/interface/loncommon.pm 2002/05/09 15:56:02 1.37
+++ loncom/interface/loncommon.pm 2004/07/12 17:02:07 1.198
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.37 2002/05/09 15:56:02 matthew Exp $
+# $Id: loncommon.pm,v 1.198 2004/07/12 17:02:07 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,14 +25,6 @@
#
# http://www.lon-capa.org/
#
-# 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
# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id
@@ -40,35 +32,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 Subroutines
-
-=over 4
-
=cut
# End of POD header
@@ -76,120 +56,354 @@ 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;
+use HTML::Entities;
my $readit;
+##
+## Global Variables
+##
+
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
+my %supported_language;
my %cprtag;
+my %scprtag;
my %fe; my %fd;
-my %fc;
+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
-# ----------------------------------------------------------------------- BEGIN
-=item BEGIN()
+my %designhash;
-Initialize values from language.tab, copyright.tab, filetypes.tab,
-and filecategories.tab.
+# ---------------------------------------------- Thesaurus variables
+#
+# %Keywords:
+# A hash used by &keyword to determine if a word is considered a keyword.
+# $thesaurus_db_file
+# Scalar containing the full path to the thesaurus database.
-=cut
-# ----------------------------------------------------------------------- BEGIN
+my %Keywords;
+my $thesaurus_db_file;
+#
+# Initialize values from language.tab, copyright.tab, filetypes.tab,
+# thesaurus.tab, and filecategories.tab.
+#
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,$val)=(split(/\s+/,$_,2));
- $language{$key}=$val;
- }
- }
+ my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/language.tab';
+ if ( open(my $fh,"<$langtabfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
+ $language{$key}=$val.' - '.$enc;
+ if ($sup) {
+ $supported_language{$key}=$sup;
+ }
+ }
+ close($fh);
+ }
}
# ------------------------------------------------------------------ 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;
- }
- }
+ my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
+ '/copyright.tab';
+ if ( open (my $fh,"<$copyrightfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\s+/,$_,2));
+ $cprtag{$key}=$val;
+ }
+ close($fh);
+ }
}
-# ------------------------------------------------------------- file categories
+# ------------------------------------------------------------------ source copyrights
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/filecategories.tab');
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
- push @{$fc{$key}},$val;
- }
- }
+ my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
+ '/source_copyright.tab';
+ if ( open (my $fh,"<$sourcecopyrightfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\s+/,$_,2));
+ $scprtag{$key}=$val;
+ }
+ close($fh);
+ }
}
-# ------------------------------------------------------------------ file types
+
+# -------------------------------------------------------------- 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($Apache::lonnet::perlvar{'lonTabDir'}.
- '/filetypes.tab');
- if ($fh) {
+ my $designfile = $designdir.'/'.$filename;
+ if ( open (my $fh,"<$designfile") ) {
while (<$fh>) {
- next if (/^\#/);
- chomp;
- my ($ending,$emb,$descr)=split(/\s+/,$_,3);
- if ($descr ne '') {
- $fe{$ending}=lc($emb);
- $fd{$ending}=$descr;
- }
- }
- }
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\=/,$_));
+ if ($val) { $designhash{$domain.'.'.$key}=$val; }
+ }
+ close($fh);
+ }
+ }
+
+ }
+ closedir(DIR);
+
+
+# ------------------------------------------------------------- file categories
+ {
+ my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filecategories.tab';
+ if ( open (my $fh,"<$categoryfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($extension,$category)=(split(/\s+/,$_,2));
+ push @{$category_extensions{lc($category)}},$extension;
+ }
+ close($fh);
+ }
+
}
-# -------------------------------------------------------------- Thesaurus data
+# ------------------------------------------------------------------ file types
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/thesaurus.dat');
- if ($fh) {
+ my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filetypes.tab';
+ if ( open (my $fh,"<$typesfile") ) {
while (<$fh>) {
- my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_);
- $theindex{$tword}=$tindex;
- $theword[$tindex]=$tword;
- $thecount[$tindex]=$tcount;
- $thetotalcount+=$tcount;
- $therelated[$tindex]=$trelated;
- }
+ next if (/^\#/);
+ chomp;
+ my ($ending,$emb,$descr)=split(/\s+/,$_,3);
+ if ($descr ne '') {
+ $fe{$ending}=lc($emb);
+ $fd{$ending}=$descr;
+ }
+ }
+ close($fh);
}
- $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
-=item linked_select_forms(...)
+###############################################################
+## 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.
+
+=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 separated list.
+
+Specifying 'omit' will restrict the browser to NOT displaying files
+with the given extension. Can be a comma separated 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.
+
+=cut
+
+sub browser_and_searcher_javascript {
+ my $resurl=&lastresurl();
+ return < $resurl});
+ &Apache::lonnet::appenv('environment.lastresurl' => $resurl);
+ return 1;
+}
+
+sub studentbrowser_javascript {
+ unless (
+ (($ENV{'request.course.id'}) &&
+ (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})))
+ || ($ENV{'request.role'}=~/^(au|dc|su)/)
+ ) { return ''; }
+ return (<<'ENDSTDBRW');
+
+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,desc) {
+ 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+
+ '&cnameelement='+desc;
+ 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,$desc)=@_;
+ return "".&mt('Select Course')."";
+}
+
+=pod
+
+=item * linked_select_forms(...)
linked_select_forms returns a string containing a block
and html for two