--- loncom/interface/loncommon.pm 2004/12/02 18:58:30 1.239
+++ loncom/interface/loncommon.pm 2005/05/26 20:49:23 1.262
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.239 2004/12/02 18:58:30 matthew Exp $
+# $Id: loncommon.pm,v 1.262 2005/05/26 20:49:23 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -55,7 +55,7 @@ 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);
@@ -311,8 +311,8 @@ END
}
sub lastresurl {
- if ($ENV{'environment.lastresurl'}) {
- return $ENV{'environment.lastresurl'}
+ if ($env{'environment.lastresurl'}) {
+ return $env{'environment.lastresurl'}
} else {
return '/res';
}
@@ -329,9 +329,9 @@ sub storeresurl {
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'})))
+ || ($env{'request.role'}=~/^(au|dc|su)/)
) { return ''; }
return (<<'ENDSTDBRW');
@@ -729,12 +743,12 @@ ENDTEMPLATE
sub help_open_bug {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
- unless ($ENV{'user.adv'}) { return ''; }
+ unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);
- if ($ENV{'browser.interface'} eq 'textual' ||
- $ENV{'environment.remote'} eq 'off' ) {
+ if ($env{'browser.interface'} eq 'textual' ||
+ $env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
}
$width = 600 if (not defined $width);
@@ -774,12 +788,12 @@ ENDTEMPLATE
sub help_open_faq {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
- unless ($ENV{'user.adv'}) { return ''; }
+ unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);
- if ($ENV{'browser.interface'} eq 'textual' ||
- $ENV{'environment.remote'} eq 'off' ) {
+ if ($env{'browser.interface'} eq 'textual' ||
+ $env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
}
$width = 350 if (not defined $width);
@@ -822,6 +836,98 @@ ENDTEMPLATE
=pod
+=item * change_content_javascript():
+
+This and the next function allow you to create small sections of an
+otherwise static HTML page that you can update on the fly with
+Javascript, even in Netscape 4.
+
+The Javascript fragment returned by this function (no EscriptE tag)
+must be written to the HTML page once. It will prove the Javascript
+function "change(name, content)". Calling the change function with the
+name of the section
+you want to update, matching the name passed to C, and
+the new content you want to put in there, will put the content into
+that area.
+
+B: Netscape 4 only reserves enough space for the changable area
+to contain room for the original contents. You need to "make space"
+for whatever changes you wish to make, and be B to check your
+code in Netscape 4. This feature in Netscape 4 is B powerful;
+it's adequate for updating a one-line status display, but little more.
+This script will set the space to 100% width, so you only need to
+worry about height in Netscape 4.
+
+Modern browsers are much less limiting, and if you can commit to the
+user not using Netscape 4, this feature may be used freely with
+pretty much any HTML.
+
+=cut
+
+sub change_content_javascript {
+ # If we're on Netscape 4, we need to use Layer-based code
+ if ($env{'browser.type'} eq 'netscape' &&
+ $env{'browser.version'} =~ /^4\./) {
+ return (<. $name is
+the name you will use to reference the area later; do not repeat the
+same name on a given HTML page more then once. $origContent is what
+the area will originally contain, which can be left blank.
+
+=cut
+
+sub changable_area {
+ my ($name, $origContent) = @_;
+
+ if ($env{'browser.type'} eq 'netscape' &&
+ $env{'browser.version'} =~ /^4\./) {
+ # If this is netscape 4, we need to use the Layer tag
+ return "$origContent";
+ } else {
+ return "$origContent";
+ }
+}
+
+=pod
+
+=back
+
+=head1 Excel and CSV file utility routines
+
+=over 4
+
+=cut
+
+###############################################################
+###############################################################
+
+=pod
+
=item * csv_translate($text)
Translate $text to allow it to be output as a 'comma separated values'
@@ -838,7 +944,6 @@ sub csv_translate {
return $text;
}
-
###############################################################
###############################################################
@@ -862,6 +967,10 @@ Currently supported formats:
=item h3
+=item h4
+
+=item i
+
=item date
=back
@@ -884,6 +993,8 @@ sub define_excel_formats {
$format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
$format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
$format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
+ $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
+ $format->{'i'} = $workbook->add_format(italic=>1);
$format->{'date'} = $workbook->add_format(num_format=>
'mm/dd/yyyy hh:mm:ss');
return $format;
@@ -894,84 +1005,83 @@ sub define_excel_formats {
=pod
-=item * change_content_javascript():
+=item * create_workbook
-This and the next function allow you to create small sections of an
-otherwise static HTML page that you can update on the fly with
-Javascript, even in Netscape 4.
+Create an Excel worksheet. If it fails, output message on the
+request object and return undefs.
-The Javascript fragment returned by this function (no EscriptE tag)
-must be written to the HTML page once. It will prove the Javascript
-function "change(name, content)". Calling the change function with the
-name of the section
-you want to update, matching the name passed to C, and
-the new content you want to put in there, will put the content into
-that area.
-
-B: Netscape 4 only reserves enough space for the changable area
-to contain room for the original contents. You need to "make space"
-for whatever changes you wish to make, and be B to check your
-code in Netscape 4. This feature in Netscape 4 is B powerful;
-it's adequate for updating a one-line status display, but little more.
-This script will set the space to 100% width, so you only need to
-worry about height in Netscape 4.
+Inputs: Apache request object
-Modern browsers are much less limiting, and if you can commit to the
-user not using Netscape 4, this feature may be used freely with
-pretty much any HTML.
+Returns (undef) on failure,
+ Excel worksheet object, scalar with filename, and formats
+ from &Apache::loncommon::define_excel_formats on success
=cut
-sub change_content_javascript {
- # If we're on Netscape 4, we need to use Layer-based code
- if ($ENV{'browser.type'} eq 'netscape' &&
- $ENV{'browser.version'} =~ /^4\./) {
- return (<new('/home/httpd'.$filename);
+ if (! defined($workbook)) {
+ $r->log_error("Error creating excel spreadsheet $filename: $!");
+ $r->print('
'.&mt("Unable to create new Excel file. ".
+ "This error has been logged. ".
+ "Please alert your LON-CAPA administrator").
+ '
');
+ return (undef);
}
+ #
+ $workbook->set_tempdir('/home/httpd/perl/tmp');
+ #
+ my $format = &Apache::loncommon::define_excel_formats($workbook);
+ return ($workbook,$filename,$format);
}
+###############################################################
+###############################################################
+
=pod
-=item * changable_area($name, $origContent):
+=item * create_text_file
-This provides a "changable area" that can be modified on the fly via
-the Javascript code provided in C. $name is
-the name you will use to reference the area later; do not repeat the
-same name on a given HTML page more then once. $origContent is what
-the area will originally contain, which can be left blank.
+Create a file to write to and eventually make available to the usre.
+If file creation fails, outputs an error message on the request object and
+return undefs.
-=cut
+Inputs: Apache request object, and file suffix
-sub changable_area {
- my ($name, $origContent) = @_;
+Returns (undef) on failure,
+ Filehandle and filename on success.
- if ($ENV{'browser.type'} eq 'netscape' &&
- $ENV{'browser.version'} =~ /^4\./) {
- # If this is netscape 4, we need to use the Layer tag
- return "$origContent";
- } else {
- return "$origContent";
+=cut
+
+###############################################################
+###############################################################
+sub create_text_file {
+ my ($r,$suffix) = @_;
+ if (! defined($suffix)) { $suffix = 'txt'; };
+ my $fh;
+ my $filename = '/prtspool/'.
+ $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
+ time.'_'.rand(1000000000).'.'.$suffix;
+ $fh = Apache::File->new('>/home/httpd'.$filename);
+ if (! defined($fh)) {
+ $r->log_error("Couldn't open $filename for output $!");
+ $r->print("Problems occured in creating the output file. ".
+ "This error has been logged. ".
+ "Please alert your LON-CAPA administrator.");
}
+ return ($fh,$filename)
}
-=pod
+
+=pod
=back
@@ -1033,7 +1143,7 @@ sub multiple_select_form {
$output.="\n\n";
@@ -1064,7 +1174,7 @@ sub select_form {
}
foreach (@keys) {
$selectform.="\n";
}
$selectform.="";
@@ -1101,7 +1211,7 @@ sub select_level_form {
my $selectform = "";
@@ -1131,7 +1241,7 @@ sub select_dom_form {
my $selectdomain = "";
@@ -1230,9 +1340,11 @@ Outputs:
###############################################################
###############################################################
sub decode_user_agent {
+ my ($r)=@_;
my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
+ if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
my $clientbrowser='unknown';
my $clientversion='0';
my $clientmathml='';
@@ -1793,13 +1905,13 @@ if the user does not
sub nickname {
my ($uname,$udom)=@_;
my %names;
- if ($uname eq $ENV{'user.name'} &&
- $udom eq $ENV{'user.domain'}) {
- %names=('nickname' => $ENV{'environment.nickname'} ,
- 'firstname' => $ENV{'environment.firstname'} ,
- 'middlename' => $ENV{'environment.middlename'},
- 'lastname' => $ENV{'environment.lastname'} ,
- 'generation' => $ENV{'environment.generation'});
+ if ($uname eq $env{'user.name'} &&
+ $udom eq $env{'user.domain'}) {
+ %names=('nickname' => $env{'environment.nickname'} ,
+ 'firstname' => $env{'environment.firstname'} ,
+ 'middlename' => $env{'environment.middlename'},
+ 'lastname' => $env{'environment.lastname'} ,
+ 'generation' => $env{'environment.generation'});
} else {
%names=&Apache::lonnet::get('environment',
['nickname','firstname','middlename',
@@ -1830,8 +1942,8 @@ Gets a users screenname and returns it a
sub screenname {
my ($uname,$udom)=@_;
- if ($uname eq $ENV{'user.name'} &&
- $udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};}
+ if ($uname eq $env{'user.name'} &&
+ $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
return $names{'screenname'};
}
@@ -2079,8 +2191,8 @@ sub display_languages {
$languages{$_}=1;
}
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
- if ($ENV{'form.displaylanguage'}) {
- foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'form.displaylanguage'})) {
+ if ($env{'form.displaylanguage'}) {
+ foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
$languages{$_}=1;
}
}
@@ -2089,24 +2201,24 @@ sub display_languages {
sub preferred_languages {
my @languages=();
- if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {
+ if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
- $ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));
+ $env{'course.'.$env{'request.course.id'}.'.languages'}));
}
- if ($ENV{'environment.languages'}) {
- @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'});
+ if ($env{'environment.languages'}) {
+ @languages=split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'});
}
my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
if ($browser) {
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
}
- if ($Apache::lonnet::domain_lang_def{$ENV{'user.domain'}}) {
+ if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{$ENV{'user.domain'}});
+ $Apache::lonnet::domain_lang_def{$env{'user.domain'}});
}
- if ($Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}}) {
+ if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {
@languages=(@languages,
- $Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}});
+ $Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});
}
if ($Apache::lonnet::domain_lang_def{
$Apache::lonnet::perlvar{'lonDefDomain'}}) {
@@ -2325,7 +2437,7 @@ sub get_student_answers {
=item * &submlink()
-Inputs: $text $uname $udom $symb
+Inputs: $text $uname $udom $symb $target
Returns: A link to grades.pm such as to see the SUBM view of a student
@@ -2333,15 +2445,64 @@ Returns: A link to grades.pm such as to
###############################################
sub submlink {
- my ($text,$uname,$udom,$symb)=@_;
+ my ($text,$uname,$udom,$symb,$target)=@_;
+ if (!($uname && $udom)) {
+ (my $cursymb, my $courseid,$udom,$uname)=
+ &Apache::lonxml::whichuser($symb);
+ if (!$symb) { $symb=$cursymb; }
+ }
+ if (!$symb) { $symb=&Apache::lonnet::symbread(); }
+ $symb=&Apache::lonnet::escape($symb);
+ if ($target) { $target="target=\"$target\""; }
+ return ''.$text.'';
+}
+##############################################
+
+=pod
+
+=item * &pgrdlink()
+
+Inputs: $text $uname $udom $symb $target
+
+Returns: A link to grades.pm such as to see the PGRD view of a student
+
+=cut
+
+###############################################
+sub pgrdlink {
+ my $link=&submlink(@_);
+ $link=~s/(&command=submission)/$1&showgrading=yes/;
+ return $link;
+}
+##############################################
+
+=pod
+
+=item * &pprmlink()
+
+Inputs: $text $uname $udom $symb $target
+
+Returns: A link to parmset.pm such as to see the PPRM view of a
+student andn resource
+
+=cut
+
+###############################################
+sub pprmlink {
+ my ($text,$uname,$udom,$symb,$target)=@_;
if (!($uname && $udom)) {
(my $cursymb, my $courseid,$udom,$uname)=
&Apache::lonxml::whichuser($symb);
if (!$symb) { $symb=$cursymb; }
}
- if (!$symb) { $symb=&symbread(); }
- return ''.$text.'';
+ if (!$symb) { $symb=&Apache::lonnet::symbread(); }
+ $symb=&Apache::lonnet::escape($symb);
+ if ($target) { $target="target=\"$target\""; }
+ return ''.$text.'';
}
##############################################
@@ -2379,9 +2540,9 @@ sub maketime {
sub findallcourses {
my %courses=();
my $now=time;
- foreach (keys %ENV) {
+ foreach (keys %env) {
if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
- my ($starttime,$endtime)=$ENV{$_};
+ my ($starttime,$endtime)=$env{$_};
my $active=1;
if ($starttime) {
if ($now<$starttime) { $active=0; }
@@ -2418,9 +2579,9 @@ sub determinedomain {
if (! $domain) {
# Determine domain if we have not been given one
$domain = $Apache::lonnet::perlvar{'lonDefDomain'};
- if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }
- if ($ENV{'request.role.domain'}) {
- $domain=$ENV{'request.role.domain'};
+ if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
+ if ($env{'request.role.domain'}) {
+ $domain=$env{'request.role.domain'};
}
}
return $domain;
@@ -2465,7 +2626,7 @@ Returns: value of designparamter $which
##############################################
sub designparm {
my ($which,$domain)=@_;
- if ($ENV{'browser.blackwhite'} eq 'on') {
+ if ($env{'browser.blackwhite'} eq 'on') {
if ($which=~/\.(font|alink|vlink|link)$/) {
return '#000000';
}
@@ -2476,8 +2637,8 @@ sub designparm {
return '#CCCCCC';
}
}
- if ($ENV{'environment.color.'.$which}) {
- return $ENV{'environment.color.'.$which};
+ if ($env{'environment.color.'.$which}) {
+ return $env{'environment.color.'.$which};
}
$domain=&determinedomain($domain);
if ($designhash{$domain.'.'.$which}) {
@@ -2543,16 +2704,16 @@ sub bodytag {
# Accessibility font enhance
unless ($addentries) { $addentries=''; }
my $addstyle='';
- if ($ENV{'browser.fontenhance'} eq 'on') {
+ if ($env{'browser.fontenhance'} eq 'on') {
$addstyle=' font-size: x-large;';
}
# role and realm
my ($role,$realm)
- =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
+ =&Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]);
# realm
- if ($ENV{'request.course.id'}) {
+ if ($env{'request.course.id'}) {
$realm=
- $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
+ $env{'course.'.$env{'request.course.id'}.'.description'};
}
unless ($realm) { $realm=' '; }
# Set messages
@@ -2569,25 +2730,32 @@ a:focus { color: red; background: yellow
END
+ if ($env{'environment.texengine'} eq 'jsMath') {
+ $bodytag.=''."\n".
+ ''."\n";
+ }
+
my $upperleft='';
if ($bodyonly) {
return $bodytag;
- } elsif ($ENV{'browser.interface'} eq 'textual') {
+ } elsif ($env{'browser.interface'} eq 'textual') {
# Accessibility
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).
'
LON-CAPA: '.$title.'
';
- } elsif ($ENV{'environment.remote'} eq 'off') {
+ } elsif ($env{'environment.remote'} eq 'off') {
# No Remote
my $roleinfo=(<
- $ENV{'environment.firstname'}
- $ENV{'environment.middlename'}
- $ENV{'environment.lastname'}
- $ENV{'environment.generation'}
+ $env{'environment.firstname'}
+ $env{'environment.middlename'}
+ $env{'environment.lastname'}
+ $env{'environment.generation'}
$role
@@ -2601,21 +2769,25 @@ ENDROLE
$titleinfo = $customtitle;
}
- if ($ENV{'request.state'} eq 'construct') {
+ if ($env{'request.state'} eq 'construct') {
my ($uname,$thisdisfn)=
- ($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
+ ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
my $formaction='/priv/'.$uname.'/'.$thisdisfn;
$formaction=~s/\/+/\//g;
unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
my $parentpath = '';
- if ($thisdisfn =~ m-(.+/)[^/]*$-) {
+ my $lastitem = '';
+ if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
$parentpath = $1;
+ $lastitem = $2;
+ } else {
+ $lastitem = $thisdisfn;
}
$titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
'Construction Space: '.
''
.&Apache::lonmenu::constspaceform();
@@ -2627,7 +2799,7 @@ ENDROLE
'cellspacing="3" cellpadding="3">'.
'
'.
$titleinfo.'
'.$roleinfo.'
';
- if ($ENV{'request.state'} eq 'construct') {
+ if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
} else {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
@@ -2643,6 +2815,17 @@ ENDROLE
if ($customtitle) {
$titleinfo = $customtitle;
}
+ #
+ # Extra info if you are the DC
+ my $dc_info = '';
+ if ($env{'user.adv'} && exists($env{'user.role.dc./'.
+ $env{'course.'.$env{'request.course.id'}.
+ '.domain'}.'/'})) {
+ my $cid = $env{'request.course.id'};
+ $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
+ $dc_info = '('.$dc_info.')';
+ }
+ #
return(<
@@ -2652,13 +2835,13 @@ $upperleft