--- loncom/interface/loncommon.pm 2003/06/24 22:16:32 1.107
+++ loncom/interface/loncommon.pm 2003/12/27 23:55:10 1.165
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.107 2003/06/24 22:16:32 albertel Exp $
+# $Id: loncommon.pm,v 1.165 2003/12/27 23:55:10 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,13 +25,6 @@
#
# 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
@@ -47,29 +40,15 @@ Apache::loncommon - pile of common routi
=head1 SYNOPSIS
-Referenced by other mod_perl Apache modules.
+Common routines for manipulating connections, student answers,
+ domains, common Javascript fragments, etc.
-Invocation:
- &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
+=head1 OVERVIEW
-=head1 INTRODUCTION
-
-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
@@ -82,17 +61,18 @@ use POSIX qw(strftime mktime);
use Apache::Constants qw(:common :http :methods);
use Apache::lonmsg();
use Apache::lonmenu();
-my $readit;
+use Apache::lonlocal;
+use HTML::Entities;
-=pod
-
-=item Global Variables
+my $readit;
-=over 4
+##
+## Global Variables
+##
-=cut
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
+my %supported_language;
my %cprtag;
my %fe; my %fd;
my %category_extensions;
@@ -102,42 +82,19 @@ my %category_extensions;
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
+#
+# %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.
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
-
+#
+# 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";
@@ -145,29 +102,34 @@ BEGIN {
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;
- }
- }
+ 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);
+ }
}
# -------------------------------------------------------------- domain designs
@@ -178,15 +140,16 @@ BEGIN {
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; }
- }
- }
+ my $designfile = $designdir.'/'.$filename;
+ if ( open (my $fh,"<$designfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\=/,$_));
+ if ($val) { $designhash{$domain.'.'.$key}=$val; }
+ }
+ close($fh);
+ }
}
}
@@ -195,32 +158,35 @@ BEGIN {
# ------------------------------------------------------------- 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;
- }
- }
+ 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);
+ }
+
}
# ------------------------------------------------------------------ file types
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/filetypes.tab');
- if ($fh) {
+ my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filetypes.tab';
+ if ( open (my $fh,"<$typesfile") ) {
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 ($ending,$emb,$descr)=split(/\s+/,$_,3);
+ if ($descr ne '') {
+ $fe{$ending}=lc($emb);
+ $fd{$ending}=$descr;
+ }
+ }
+ close($fh);
+ }
}
&Apache::lonnet::logthis(
"INFO: Read file types");
@@ -228,21 +194,25 @@ BEGIN {
} # 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
+=head1 HTML and Javascript Functions
=over 4
-=item openbrowser(formname,elementname,only,omit) [javascript]
+=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
@@ -255,22 +225,19 @@ 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
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) {
+ function openstdbrowser(formname,uname,udom,roleflag) {
var url = '/adm/pickstudent?';
var filter;
eval('filter=document.'+formname+'.'+uname+'.value;');
@@ -329,6 +303,7 @@ sub studentbrowser_javascript {
}
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';
@@ -340,17 +315,24 @@ ENDSTDBRW
}
sub selectstudent_link {
- my ($form,$unameele,$udomele)=@_;
- unless ($ENV{'request.course.id'}) { return ''; }
- unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
- return '';
+ 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 "Select User";
+ return '';
}
sub coursebrowser_javascript {
- return (<<'ENDSTDBRW');
+ my ($domainfilter)=@_;
+ return (<
var stdeditbrowser;
function opencrsbrowser(formname,uname,udom) {
@@ -361,6 +343,12 @@ sub coursebrowser_javascript {
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';
@@ -376,14 +364,12 @@ ENDSTDBRW
sub selectcourse_link {
my ($form,$unameele,$udomele)=@_;
return "Select Course";
+ '","'.$udomele.'");'."'>".&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