--- loncom/interface/loncommon.pm 2003/06/24 22:16:32 1.107
+++ loncom/interface/loncommon.pm 2004/01/15 18:12:59 1.173
@@ -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.173 2004/01/15 18:12:59 www 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;
-
-=pod
+use Apache::lonlocal;
+use HTML::Entities;
-=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,23 +225,21 @@ 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 {
+ my $resurl=&lastresurl();
return < $resurl});
+ &Apache::lonnet::appenv('environment.lastresurl' => $resurl);
+ return 1;
+}
+
sub studentbrowser_javascript {
- unless ($ENV{'request.course.id'}) { return ''; }
- unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
- return '';
- }
+ unless (
+ (($ENV{'request.course.id'}) &&
+ (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})))
+ || ($ENV{'request.role'}=~/^(au|dc|su)/)
+ ) { return ''; }
return (<<'ENDSTDBRW');
block
and html for two