--- loncom/interface/loncommon.pm 2003/10/30 13:57:06 1.140
+++ loncom/interface/loncommon.pm 2008/09/29 22:53:20 1.688
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.140 2003/10/30 13:57:06 matthew Exp $
+# $Id: loncommon.pm,v 1.688 2008/09/29 22:53:20 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
@@ -62,79 +55,124 @@ redundancy from other modules and increa
package Apache::loncommon;
use strict;
-use Apache::lonnet();
+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::lonenc();
use Apache::lonlocal;
+use Apache::lonnet();
use HTML::Entities;
+use Apache::lonhtmlcommon();
+use Apache::loncoursedata();
+use Apache::lontexconvert();
+use Apache::lonclonecourse();
+use LONCAPA qw(:DEFAULT :match);
+use DateTime::TimeZone;
+use DateTime::Locale::Catalog;
+
+# ---------------------------------------------- Designs
+use vars qw(%defaultdesign);
my $readit;
-=pod
-=head1 Global Variables
+##
+## Global Variables
+##
-=cut
-# ----------------------------------------------- Filetypes/Languages/Copyright
-my %language;
-my %supported_language;
-my %cprtag;
-my %fe; my %fd;
-my %category_extensions;
+# ----------------------------------------------- SSI with retries:
+#
-# ---------------------------------------------- Designs
+=pod
-my %designhash;
+=head1 Server Side include with retries:
-# ---------------------------------------------- Thesaurus variables
+=over 4
-# FIXME: I don't think it's necessary to document these things;
-# they're privately used - Jeremy
+=item * &ssi_with_retries(resource,retries form)
-=pod
+Performs an ssi with some number of retries. Retries continue either
+until the result is ok or until the retry count supplied by the
+caller is exhausted.
+
+Inputs:
=over 4
-=item * %Keywords
+resource - Identifies the resource to insert.
-A hash used by &keyword to determine if a word is considered a keyword.
+retries - Count of the number of retries allowed.
-=item * $thesaurus_db_file
+form - Hash that identifies the rendering options.
-Scalar containing the full path to the thesaurus database.
+=back
+
+Returns:
+
+=over 4
+
+content - The content of the response. If retries were exhausted this is empty.
+
+response - The response from the last attempt (which may or may not have been successful.
+
+=back
=back
=cut
-my %Keywords;
-my $thesaurus_db_file;
+sub ssi_with_retries {
+ my ($resource, $retries, %form) = @_;
-# ----------------------------------------------------------------------- BEGIN
-# FIXME: I don't think this needs to be documented, it prepares
-# private data structures - Jeremy
-=pod
+ my $ok = 0; # True if we got a good response.
+ my $content;
+ my $response;
-=head1 General Subroutines
+ # Try to get the ssi done. within the retries count:
-=over 4
+ do {
+ ($content, $response) = &Apache::lonnet::ssi($resource, %form);
+ $ok = $response->is_success;
+ if (!$ok) {
+ &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
+ }
+ $retries--;
+ } while (!$ok && ($retries > 0));
-=item * BEGIN()
+ if (!$ok) {
+ $content = ''; # On error return an empty content.
+ }
+ return ($content, $response);
-Initialize values from language.tab, copyright.tab, filetypes.tab,
-thesaurus.tab, and filecategories.tab.
+}
-=back
-=cut
-# ----------------------------------------------------------------------- BEGIN
+# ----------------------------------------------- Filetypes/Languages/Copyright
+my %language;
+my %supported_language;
+my %cprtag;
+my %scprtag;
+my %fe; my %fd; my %fm;
+my %category_extensions;
+
+# ---------------------------------------------- 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;
+
+#
+# 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,85 +180,95 @@ 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,$sup)=(split(/\t/,$_));
- $language{$key}=$val.' - '.$enc;
- if ($sup) {
- $supported_language{$key}=$sup;
- }
- }
- }
+ my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/language.tab';
+ if ( open(my $fh,"<$langtabfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line=~/^\#/);
+ chomp($line);
+ my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$line));
+ $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 (my $line = <$fh>) {
+ next if ($line=~/^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\s+/,$line,2));
+ $cprtag{$key}=$val;
+ }
+ close($fh);
+ }
}
-
-# -------------------------------------------------------------- domain designs
-
- my $filename;
- my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
- opendir(DIR,$designdir);
- while ($filename=readdir(DIR)) {
- my ($domain)=($filename=~/^(\w+)\./);
+# ----------------------------------------------------------- source copyrights
{
- 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 $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
+ '/source_copyright.tab';
+ if ( open (my $fh,"<$sourcecopyrightfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\s+/,$line,2));
+ $scprtag{$key}=$val;
+ }
+ close($fh);
+ }
}
+# -------------------------------------------------------------- default domain designs
+ my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
+ my $designfile = $designdir.'/default.tab';
+ if ( open (my $fh,"<$designfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($key,$val)=(split(/\=/,$line));
+ if ($val) { $defaultdesign{$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 (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($extension,$category)=(split(/\s+/,$line,2));
+ push @{$category_extensions{lc($category)}},$extension;
+ }
+ close($fh);
+ }
+
}
# ------------------------------------------------------------------ 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;
- }
- }
- }
+ my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filetypes.tab';
+ if ( open (my $fh,"<$typesfile") ) {
+ while (my $line = <$fh>) {
+ next if ($line =~ /^\#/);
+ chomp($line);
+ my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,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");
@@ -239,16 +287,14 @@ BEGIN {
=over 4
-=item * browser_and_searcher_javascript ()
+=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]
+=item * &openbrowser(formname,elementname,only,omit) [javascript]
inputs: formname, elementname, only, omit
@@ -256,45 +302,54 @@ 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=&escape_single(&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'})))
- || ($ENV{'request.role'}=~/^(au|dc|su)/)
+ (($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');
+ENDAUTHORBRW
+}
+
sub coursebrowser_javascript {
- my ($domainfilter)=@_;
- return (<
- var stdeditbrowser;
- function opencrsbrowser(formname,uname,udom) {
+ my ($domainfilter,$sec_element,$formname)=@_;
+ my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');
+ my $output = '
+
+
+ function getFormIdByName(formname) {
+ for (var i=0;i".&mt('Select Course')."";
+ my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
+ return "".&mt('Select Course')."";
+}
+
+sub selectauthor_link {
+ my ($form,$udom)=@_;
+ return ''.
+ &mt('Select Author').'';
+}
+
+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;
+}
+
+sub select_timezone {
+ my ($name,$selected,$onchange,$includeempty)=@_;
+ my $output='