--- loncom/interface/loncommon.pm 2002/08/26 12:47:28 1.59
+++ loncom/interface/loncommon.pm 2006/04/25 15:18:47 1.353
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.59 2002/08/26 12:47:28 www Exp $
+# $Id: loncommon.pm,v 1.353 2006/04/25 15:18:47 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,15 +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
-# 6/24,7/2 H. K. Ng
# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id
@@ -49,92 +40,63 @@ 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
package Apache::loncommon;
use strict;
-use Apache::lonnet();
+use Apache::lonnet;
use GDBM_File;
use POSIX qw(strftime mktime);
-use Apache::Constants qw(:common);
-use Apache::lonmsg();
-my $readit;
-
-=pod
+use Apache::lonmenu();
+use Apache::lonlocal;
+use HTML::Entities;
+use Apache::lonhtmlcommon();
+use Apache::loncoursedata();
+use Apache::lontexconvert();
-=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 %scprtag;
+my %fe; my %fd; my %fm;
my %category_extensions;
-# ---------------------------------------------- Thesaurus variables
-
-=pod
+# ---------------------------------------------- Designs
-=item %Keywords
+my %designhash;
-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
+# ---------------------------------------------- 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.
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";
@@ -142,58 +104,107 @@ BEGIN {
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);
+ }
+ }
+# ----------------------------------------------------------- source copyrights
+ {
+ 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);
+ }
+ }
+
+# -------------------------------------------------------------- domain designs
+
+ my $filename;
+ my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
+ opendir(DIR,$designdir);
+ while ($filename=readdir(DIR)) {
+ if ($filename!~/\.tab$/) { next; }
+ my ($domain)=($filename=~/^(\w+)\./);
+ {
+ 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);
}
}
+
}
+ 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;
- }
- }
+ 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,$mime,$descr)=split(/\s+/,$_,4);
+ if ($descr ne '') {
+ $fe{$ending}=lc($emb);
+ $fd{$ending}=$descr;
+ if ($mime ne 'unk') { $fm{$ending}=$mime; }
+ }
+ }
+ close($fh);
+ }
}
&Apache::lonnet::logthis(
"INFO: Read file types");
@@ -201,21 +212,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
@@ -223,56 +238,71 @@ formname and elementname indicate the na
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.
+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 seperated list.
+with the given extension. Can be a comma separated 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 ($mode)=@_;
+ if (!defined($mode)) { $mode='edit'; }
+ my $resurl=&lastresurl();
return <
END
}
+sub lastresurl {
+ if ($env{'environment.lastresurl'}) {
+ return $env{'environment.lastresurl'}
+ } else {
+ return '/res';
+ }
+}
+sub storeresurl {
+ my $resurl=&Apache::lonnet::clutter(shift);
+ unless ($resurl=~/^\/res/) { return 0; }
+ $resurl=~s/\/$//;
+ &Apache::lonnet::put('environment',{'lastresurl' => $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'})
+ || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ '/'.$env{'request.course.sec'})
+ ))
+ || ($env{'request.role'}=~/^(au|dc|su)/)
+ ) { return ''; }
+ return (<<'ENDSTDBRW');
+
+ENDSTDBRW
+}
+
+sub selectstudent_link {
+ my ($form,$unameele,$udomele)=@_;
+ if ($env{'request.course.id'}) {
+ if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
+ && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ '/'.$env{'request.course.sec'})) {
+ 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,extra_element,multflag) {
+ 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;
+ if (extra_element !=null && extra_element != '' && formname == 'rolechoice') {
+ url += '&roleelement='+extra_element;
+ if (domainfilter == null || domainfilter == '') {
+ url += '&domainfilter='+extra_element;
+ }
+ }
+ if (multflag !=null && multflag != '') {
+ url += '&multiple='+multflag;
+ }
+ 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,$extra_element,$multflag)=@_;
+ return "".&mt('Select Course')."";
+}
+
+sub check_uncheck_jscript {
+ my $jscript = <<"ENDSCRT";
+function checkAll(field) {
+ if (field.length > 0) {
+ for (i = 0; i < field.length; i++) {
+ field[i].checked = true ;
+ }
+ } else {
+ field.checked = true
+ }
+}
+
+function uncheckAll(field) {
+ if (field.length > 0) {
+ for (i = 0; i < field.length; i++) {
+ field[i].checked = false ;
+ } } else {
+ field.checked = false ;
+ }
+}
+ENDSCRT
+ return $jscript;
+}
-###############################################################
=pod
-=item linked_select_forms(...)
+=item * linked_select_forms(...)
linked_select_forms returns a string containing a block
and html for two