--- loncom/interface/loncommon.pm 2004/11/13 21:06:27 1.231
+++ loncom/interface/loncommon.pm 2005/05/30 19:50:43 1.263
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.231 2004/11/13 21:06:27 albertel Exp $
+# $Id: loncommon.pm,v 1.263 2005/05/30 19:50:43 www 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');
<script type="text/javascript" language="Javascript" >
@@ -360,14 +360,14 @@ ENDSTDBRW
sub selectstudent_link {
my ($form,$unameele,$udomele)=@_;
- if ($ENV{'request.course.id'}) {
- unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
+ if ($env{'request.course.id'}) {
+ unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
return '';
}
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'");'."'>".&mt('Select User')."</a>";
}
- if ($ENV{'request.role'}=~/^(au|dc|su)/) {
+ if ($env{'request.role'}=~/^(au|dc|su)/) {
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
}
@@ -375,12 +375,11 @@ sub selectstudent_link {
}
sub coursebrowser_javascript {
- my ($domainfilter,$roleelement)=@_;
+ my ($domainfilter)=@_;
return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >
- var extra_element = "$roleelement"
var stdeditbrowser;
- function opencrsbrowser(formname,uname,udom,desc) {
+ function opencrsbrowser(formname,uname,udom,desc,extra_element) {
var url = '/adm/pickcourse?';
var filter;
if (filter != null) {
@@ -397,8 +396,11 @@ sub coursebrowser_javascript {
url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom+
'&cnameelement='+desc;
- if (extra_element != '') {
- url += '&roleelement=$roleelement';
+ if (extra_element !=null && extra_element != '' && formname == 'rolechoice') {
+ url += '&roleelement='+extra_element;
+ if (domainfilter == null || domainfilter == '') {
+ url += '&domainfilter='+extra_element;
+ }
}
var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';
@@ -411,9 +413,9 @@ ENDSTDBRW
}
sub selectcourse_link {
- my ($form,$unameele,$udomele,$desc)=@_;
+ my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course')."</a>";
+ '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";
}
=pod
@@ -545,7 +547,7 @@ END
$result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
foreach my $value (sort(keys(%$hashref))) {
$result.=" <option value=\"$value\" ";
- $result.=" selected=\"true\" " if ($value eq $firstdefault);
+ $result.=" selected=\"selected\" " if ($value eq $firstdefault);
$result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
}
$result .= "</select>\n";
@@ -555,7 +557,7 @@ END
my $seconddefault = $hashref->{$firstdefault}->{'default'};
foreach my $value (sort(keys(%select2))) {
$result.=" <option value=\"$value\" ";
- $result.=" selected=\"true\" " if ($value eq $seconddefault);
+ $result.=" selected=\"selected\" " if ($value eq $seconddefault);
$result.=">".&mt($select2{$value})."</option>\n";
}
$result .= "</select>\n";
@@ -591,8 +593,8 @@ sub help_open_topic {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
$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);
@@ -657,8 +659,8 @@ sub help_open_menu {
my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
$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 = 620 if (not defined $width);
@@ -685,25 +687,39 @@ sub help_open_menu {
"<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".
"<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
}
+ my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
+ my $html=&Apache::lonxml::xmlbegin();
my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
$template .= <<"ENDTEMPLATE";
<script type="text/javascript">
-//<!-- BEGIN LON-CAPA Internal
-function helpMenu(caller) {
- if (caller == 'open') {
- newWindow = window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )
- caller = newWindow.document
- } else {
- caller = this.document
- }
- caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")
- caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
- caller.write("</html>")
- caller.close()
- if (caller == newWindow.document) {
- caller.focus()
+// <!-- BEGIN LON-CAPA Internal
+// <![CDATA[
+function helpMenu(target) {
+ var caller = this;
+ if (target == 'open') {
+ var newWindow = null;
+ try {
+ newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
+ }
+ catch(error) {
+ writeHelp(caller);
+ return;
+ }
+ if (newWindow) {
+ caller = newWindow;
+ }
}
+ writeHelp(caller);
+ return;
+}
+function writeHelp(caller) {
+ caller.document.write('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
+ caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
+ caller.document.write("</html>")
+ caller.document.close()
+ caller.focus()
}
+// ]]>
// END LON-CAPA Internal -->
</script>
<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
@@ -727,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);
@@ -772,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);
@@ -820,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 E<lt>scriptE<gt> 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<changable_area>, and
+the new content you want to put in there, will put the content into
+that area.
+
+B<Note>: 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<sure> to check your
+code in Netscape 4. This feature in Netscape 4 is B<not> 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 (<<NETSCAPE4);
+ function change(name, content) {
+ doc = document.layers[name+"___escape"].layers[0].document;
+ doc.open();
+ doc.write(content);
+ doc.close();
+ }
+NETSCAPE4
+ } else {
+ # Otherwise, we need to use semi-standards-compliant code
+ # (technically, "innerHTML" isn't standard but the equivalent
+ # is really scary, and every useful browser supports it
+ return (<<DOMBASED);
+ function change(name, content) {
+ element = document.getElementById(name);
+ element.innerHTML = content;
+ }
+DOMBASED
+ }
+}
+
+=pod
+
+=item * changable_area($name, $origContent):
+
+This provides a "changable area" that can be modified on the fly via
+the Javascript code provided in C<change_content_javascript>. $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 "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
+ } else {
+ return "<span id='$name'>$origContent</span>";
+ }
+}
+
+=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'
@@ -836,7 +944,6 @@ sub csv_translate {
return $text;
}
-
###############################################################
###############################################################
@@ -860,6 +967,10 @@ Currently supported formats:
=item h3
+=item h4
+
+=item i
+
=item date
=back
@@ -882,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;
@@ -892,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.
-
-The Javascript fragment returned by this function (no E<lt>scriptE<gt> 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<changable_area>, and
-the new content you want to put in there, will put the content into
-that area.
+Create an Excel worksheet. If it fails, output message on the
+request object and return undefs.
-B<Note>: 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<sure> to check your
-code in Netscape 4. This feature in Netscape 4 is B<not> 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 (<<NETSCAPE4);
- function change(name, content) {
- doc = document.layers[name+"___escape"].layers[0].document;
- doc.open();
- doc.write(content);
- doc.close();
- }
-NETSCAPE4
- } else {
- # Otherwise, we need to use semi-standards-compliant code
- # (technically, "innerHTML" isn't standard but the equivalent
- # is really scary, and every useful browser supports it
- return (<<DOMBASED);
- function change(name, content) {
- element = document.getElementById(name);
- element.innerHTML = content;
- }
-DOMBASED
+###############################################################
+###############################################################
+sub create_workbook {
+ my ($r) = @_;
+ #
+ # Create the excel spreadsheet
+ my $filename = '/prtspool/'.
+ $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
+ time.'_'.rand(1000000000).'.xls';
+ my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
+ if (! defined($workbook)) {
+ $r->log_error("Error creating excel spreadsheet $filename: $!");
+ $r->print('<p>'.&mt("Unable to create new Excel file. ".
+ "This error has been logged. ".
+ "Please alert your LON-CAPA administrator").
+ '</p>');
+ 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<change_content_javascript>. $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 "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
- } else {
- return "<span id='$name'>$origContent</span>";
+=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
@@ -1031,7 +1143,7 @@ sub multiple_select_form {
$output.="\n<select name='$name' size='$size' multiple='1'>";
foreach (sort(keys(%hash))) {
$output.='<option value="'.$_.'" ';
- $output.='selected ' if ($selected{$_});
+ $output.='selected="selected" ' if ($selected{$_});
$output.='>'.$hash{$_}."</option>\n";
}
$output.="</select>\n";
@@ -1062,7 +1174,7 @@ sub select_form {
}
foreach (@keys) {
$selectform.="<option value=\"$_\" ".
- ($_ eq $def ? 'selected' : '').
+ ($_ eq $def ? 'selected="selected" ' : '').
">".&mt($hash{$_})."</option>\n";
}
$selectform.="</select>";
@@ -1099,7 +1211,7 @@ sub select_level_form {
my $selectform = "<select name=\"$name\" size=\"1\">\n";
for (my $i=0; $i<=18; $i++) {
$selectform.="<option value=\"$i\" ".
- ($i==$deflevel ? 'selected' : '').
+ ($i==$deflevel ? 'selected="selected" ' : '').
">".&gradeleveldescription($i)."</option>\n";
}
$selectform.="</select>";
@@ -1129,7 +1241,7 @@ sub select_dom_form {
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach (@domains) {
$selectdomain.="<option value=\"$_\" ".
- ($_ eq $defdom ? 'selected' : '').
+ ($_ eq $defdom ? 'selected="selected" ' : '').
">$_</option>\n";
}
$selectdomain.="</select>";
@@ -1228,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='';
@@ -1791,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',
@@ -1828,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'};
}
@@ -2077,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;
}
}
@@ -2087,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'}}) {
@@ -2283,7 +2397,7 @@ sub get_student_view {
if (defined($moreenv)) {
%form=(%form,%{$moreenv});
}
- if ($target eq 'tex') {$form{'grade_target'} = 'tex';}
+ if (defined($target)) { $form{'grade_target'} = $target; }
$feedurl=&Apache::lonnet::clutter($feedurl);
my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;
@@ -2323,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
@@ -2331,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 '<a href="/adm/grades?&command=submission&'.
+ 'symb='.$symb.'&student='.$uname.
+ '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
+}
+##############################################
+
+=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 '<a href="/adm/grades?symb='.$symb.'&student='.$uname.
- '&userdom='.$udom.'&command=submission">'.$text.'</a>';
+ if (!$symb) { $symb=&Apache::lonnet::symbread(); }
+ $symb=&Apache::lonnet::escape($symb);
+ if ($target) { $target="target=\"$target\""; }
+ return '<a href="/adm/parmset?&command=set&'.
+ 'symb='.$symb.'&uname='.$uname.
+ '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
}
##############################################
@@ -2377,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; }
@@ -2416,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;
@@ -2463,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';
}
@@ -2474,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}) {
@@ -2541,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
@@ -2567,25 +2730,32 @@ a:focus { color: red; background: yellow
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="margin-top: 0px;$addstyle" $addentries>
END
+ if ($env{'environment.texengine'} eq 'jsMath') {
+ $bodytag.='<script type="text/javascript">
+ function NoFontMessage () {}
+ </script>'."\n".
+ '<script src="/adm/jsMath/jsMath.js"></script>'."\n";
+ }
+
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
$lonhttpdPort.$img.'" alt="'.$function.'" />';
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).
'<h1>LON-CAPA: '.$title.'</h1>';
- } elsif ($ENV{'environment.remote'} eq 'off') {
+ } elsif ($env{'environment.remote'} eq 'off') {
# No Remote
my $roleinfo=(<<ENDROLE);
<td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">
- $ENV{'environment.firstname'}
- $ENV{'environment.middlename'}
- $ENV{'environment.lastname'}
- $ENV{'environment.generation'}
+ $env{'environment.firstname'}
+ $env{'environment.middlename'}
+ $env{'environment.lastname'}
+ $env{'environment.generation'}
</font>
<br />
<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
@@ -2597,27 +2767,45 @@ ENDROLE
$font.'"><b>'.$title.'</b></font>';
if ($customtitle) {
$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;
- $titleinfo = '<form name="dirs" method="post" action="'.$formaction
- .'" target="_top">'
- .&Apache::lonhtmlcommon::crumbs($uname.'/'.$thisdisfn,'_top','/priv','',-1,1)."<br />"
- .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
- .'</form>'
- .&Apache::lonmenu::constspaceform();
-
- &Apache::lonhtmlcommon::store_recent('construct',$formaction,$formaction);
- if ($thisdisfn!~m|/$|) { $forcereg=1; }
- }
+ unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
+ my $parentpath = '';
+ my $lastitem = '';
+ if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
+ $parentpath = $1;
+ $lastitem = $2;
+ } else {
+ $lastitem = $thisdisfn;
+ }
+ $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
+ '<font face="Arial, Helvetica, sans-serif"><b>Construction Space</b>:</font> '.
+ '<form name="dirs" method="post" action="'.$formaction
+ .'" target="_top"><tt><b>'
+ .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
+ .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
+ .'</form>'
+ .&Apache::lonmenu::constspaceform();
- &Apache::lonnet::logthis("hrrm");
- return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
- $forcereg).
- '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td rowspan="3" bgcolor="'.$tabbg.'">'.$titleinfo.'</td>'.$roleinfo.'</tr></table>';
+ }
+ $forcereg=1;
+ }
+ my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
+ 'cellspacing="3" cellpadding="3">'.
+ '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.
+ $titleinfo.'</td>'.$roleinfo.'</tr></table>';
+ if ($env{'request.state'} eq 'construct') {
+ $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
+ } else {
+ $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
+ $titletable;
+ }
+ return $bodytag;
}
#
@@ -2627,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(<<ENDBODY);
$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">
@@ -2636,13 +2835,13 @@ $upperleft</td>
</tr>
<tr>
<td rowspan="3" bgcolor="$tabbg">
-$titleinfo
-<td bgcolor="$tabbg" align="right">
+$titleinfo $dc_info
+</td><td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">
- $ENV{'environment.firstname'}
- $ENV{'environment.middlename'}
- $ENV{'environment.lastname'}
- $ENV{'environment.generation'}
+ $env{'environment.firstname'}
+ $env{'environment.middlename'}
+ $env{'environment.lastname'}
+ $env{'environment.generation'}
</font>
</td>
</tr>
@@ -2656,6 +2855,40 @@ ENDBODY
}
###############################################
+###############################################
+
+=pod
+
+=back
+
+=head1 HTTP Helpers
+
+=over 4
+
+=item * &endbodytag()
+
+Returns a uniform footer for LON-CAPA web pages.
+
+Inputs:
+
+=over 4
+
+=back
+
+Returns: A uniform footer for LON-CAPA web pages.
+
+=cut
+
+sub endbodytag {
+ my $endbodytag='</body>';
+ if ($env{'environment.texengine'} eq 'jsMath') {
+ $endbodytag='<script type="text/javascript">jsMath.Process()</script>'.
+ "\n".$endbodytag;
+ }
+ return $endbodytag;
+}
+
+###############################################
=pod
@@ -2669,13 +2902,13 @@ Returns either 'student','coordinator','
###############################################
sub get_users_function {
my $function = 'student';
- if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
+ if ($env{'request.role'}=~/^(cc|in|ta|ep)/) {
$function='coordinator';
}
- if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
+ if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
$function='admin';
}
- if (($ENV{'request.role'}=~/^(au|ca)/) ||
+ if (($env{'request.role'}=~/^(au|ca)/) ||
($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
$function='author';
}
@@ -2684,12 +2917,68 @@ sub get_users_function {
###############################################
+=pod
+
+=item get_sections
+
+Determines all the sections for a course including
+sections with students and sections containing other roles.
+Incoming parameters: domain, course number, reference to
+section hash (keys to be section/group IDs), reference to
+array containing roles for which sections should be gathered
+(optional). If the fourth argument is undefined, sections
+are gathered for any role.
+
+Returns number of sections.
+
+=cut
+
+###############################################
+sub get_sections {
+ my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
+ if (!($cdom && $cnum)) { return 0; }
+ my $cid = $cdom.'_'.$cnum;
+ my $numsections = 0;
+
+ if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) {
+ my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum);
+ my $sec_index = &Apache::loncoursedata::CL_SECTION();
+ my $status_index = &Apache::loncoursedata::CL_STATUS();
+ while (my ($student,$data) = each %$classlist) {
+ my ($section,$status) = ($data->[$sec_index],
+ $data->[$status_index]);
+ unless ($section eq '-1' || $section =~ /^\s*$/) {
+ if (!defined($$sectioncount{$section})) { $numsections++; }
+ $$sectioncount{$section}++;
+ }
+ }
+ }
+ my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
+ foreach my $user (sort(keys(%courseroles))) {
+ if ($user !~ /^(\w{2})/) { next; }
+ my ($role) = ($user =~ /^(\w{2})/);
+ if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
+ my $section;
+ if ($role eq 'cr' &&
+ $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
+ $section=$1;
+ }
+ if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
+ if (!defined($section) || $section eq '-1') { next; }
+ if (!defined($$sectioncount{$section})) { $numsections++; }
+ $$sectioncount{$section}++;
+ }
+ return $numsections;
+}
+
+
sub get_posted_cgi {
my $r=shift;
my $buffer;
-
- $r->read($buffer,$r->header_in('Content-length'),0);
+ if ($r->header_in('Content-length')) {
+ $r->read($buffer,$r->header_in('Content-length'),0);
+ }
unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
my @pairs=split(/&/,$buffer);
my $pair;
@@ -2714,8 +3003,8 @@ sub get_posted_cgi {
if ($name) {
chomp($value);
if ($fname) {
- $ENV{"form.$name.filename"}=$fname;
- $ENV{"form.$name.mimetype"}=$fmime;
+ $env{"form.$name.filename"}=$fname;
+ $env{"form.$name.mimetype"}=$fmime;
} else {
$value=~s/\s+$//s;
}
@@ -2747,7 +3036,7 @@ sub get_posted_cgi {
}
}
}
- $ENV{'request.method'}=$ENV{'REQUEST_METHOD'};
+ $env{'request.method'}=$ENV{'REQUEST_METHOD'};
$r->method_number(M_GET);
$r->method('GET');
$r->headers_in->unset('Content-length');
@@ -2757,14 +3046,14 @@ sub get_posted_cgi {
=item * get_unprocessed_cgi($query,$possible_names)
-Modify the %ENV hash to contain unprocessed CGI form parameters held in
+Modify the %env hash to contain unprocessed CGI form parameters held in
$query. The parameters listed in $possible_names (an array reference),
-will be set in $ENV{'form.name'} if they do not already exist.
+will be set in $env{'form.name'} if they do not already exist.
Typically called with $ENV{'QUERY_STRING'} as the first parameter.
$possible_names is an ref to an array of form element names. As an example:
get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
-will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
+will result in $env{'form.uname'} and $env{'form.udom'} being set.
=cut
@@ -2778,7 +3067,7 @@ sub get_unprocessed_cgi {
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
&Apache::lonxml::debug("Seting :$name: to :$value:");
- unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
+ unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
}
}
}
@@ -2792,7 +3081,7 @@ returns cache-controlling header code
=cut
sub cacheheader {
- unless ($ENV{'request.method'} eq 'GET') { return ''; }
+ unless ($env{'request.method'} eq 'GET') { return ''; }
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
@@ -2811,7 +3100,7 @@ specifies header code to not have cache
sub no_cache {
my ($r) = @_;
if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
- $ENV{'request.method'} ne 'GET') { return ''; }
+ $env{'request.method'} ne 'GET') { return ''; }
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
$r->no_cache(1);
$r->header_out("Expires" => $date);
@@ -2820,6 +3109,7 @@ sub no_cache {
sub content_type {
my ($r,$type,$charset) = @_;
+ if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
unless ($charset) {
$charset=&Apache::lonlocal::current_encoding;
}
@@ -2835,7 +3125,7 @@ sub content_type {
=item * add_to_env($name,$value)
-adds $name to the %ENV hash with value
+adds $name to the %env hash with value
$value, if $name already exists, the entry is converted to an array
reference and $value is added to the array.
@@ -2843,18 +3133,18 @@ reference and $value is added to the arr
sub add_to_env {
my ($name,$value)=@_;
- if (defined($ENV{$name})) {
- if (ref($ENV{$name})) {
+ if (defined($env{$name})) {
+ if (ref($env{$name})) {
#already have multiple values
- push(@{ $ENV{$name} },$value);
+ push(@{ $env{$name} },$value);
} else {
#first time seeing multiple values, convert hash entry to an arrayref
- my $first=$ENV{$name};
- undef($ENV{$name});
- push(@{ $ENV{$name} },$first,$value);
+ my $first=$env{$name};
+ undef($env{$name});
+ push(@{ $env{$name} },$first,$value);
}
} else {
- $ENV{$name}=$value;
+ $env{$name}=$value;
}
}
@@ -2862,7 +3152,7 @@ sub add_to_env {
=item * get_env_multiple($name)
-gets $name from the %ENV hash, it seemlessly handles the cases where multiple
+gets $name from the %env hash, it seemlessly handles the cases where multiple
values may be defined and end up as an array ref.
returns an array of values
@@ -2872,12 +3162,12 @@ returns an array of values
sub get_env_multiple {
my ($name) = @_;
my @values;
- if (defined($ENV{$name})) {
+ if (defined($env{$name})) {
# exists is it an array
- if (ref($ENV{$name})) {
- @values=@{ $ENV{$name} };
+ if (ref($env{$name})) {
+ @values=@{ $env{$name} };
} else {
- $values[0]=$ENV{$name};
+ $values[0]=$env{$name};
}
}
return(@values);
@@ -2895,25 +3185,25 @@ sub get_env_multiple {
=item * upfile_store($r)
Store uploaded file, $r should be the HTTP Request object,
-needs $ENV{'form.upfile'}
+needs $env{'form.upfile'}
returns $datatoken to be put into hidden field
=cut
sub upfile_store {
my $r=shift;
- $ENV{'form.upfile'}=~s/\r/\n/gs;
- $ENV{'form.upfile'}=~s/\f/\n/gs;
- $ENV{'form.upfile'}=~s/\n+/\n/gs;
- $ENV{'form.upfile'}=~s/\n+$//gs;
+ $env{'form.upfile'}=~s/\r/\n/gs;
+ $env{'form.upfile'}=~s/\f/\n/gs;
+ $env{'form.upfile'}=~s/\n+/\n/gs;
+ $env{'form.upfile'}=~s/\n+$//gs;
- my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
- '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
+ my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
+ '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
{
my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,">$datafile") ) {
- print $fh $ENV{'form.upfile'};
+ print $fh $env{'form.upfile'};
close($fh);
}
}
@@ -2925,8 +3215,8 @@ sub upfile_store {
=item * load_tmp_file($r)
Load uploaded file from tmp, $r should be the HTTP Request object,
-needs $ENV{'form.datatoken'},
-sets $ENV{'form.upfile'} to the contents of the file
+needs $env{'form.datatoken'},
+sets $env{'form.upfile'} to the contents of the file
=cut
@@ -2935,13 +3225,13 @@ sub load_tmp_file {
my @studentdata=();
{
my $studentfile = $r->dir_config('lonDaemons').
- '/tmp/'.$ENV{'form.datatoken'}.'.tmp';
+ '/tmp/'.$env{'form.datatoken'}.'.tmp';
if ( open(my $fh,"<$studentfile") ) {
@studentdata=<$fh>;
close($fh);
}
}
- $ENV{'form.upfile'}=join('',@studentdata);
+ $env{'form.upfile'}=join('',@studentdata);
}
=pod
@@ -2950,14 +3240,19 @@ sub load_tmp_file {
Separate uploaded file into records
returns array of records,
-needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
+needs $env{'form.upfile'} and $env{'form.upfiletype'}
=cut
sub upfile_record_sep {
- if ($ENV{'form.upfiletype'} eq 'xml') {
+ if ($env{'form.upfiletype'} eq 'xml') {
} else {
- return split(/\n/,$ENV{'form.upfile'});
+ my @records;
+ foreach my $line (split(/\n/,$env{'form.upfile'})) {
+ if ($line=~/^\s*$/) { next; }
+ push(@records,$line);
+ }
+ return @records;
}
}
@@ -2965,30 +3260,35 @@ sub upfile_record_sep {
=item * record_sep($record)
-Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
+Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
=cut
+sub takeleft {
+ my $index=shift;
+ return substr('0000'.$index,-4,4);
+}
+
sub record_sep {
my $record=shift;
my %components=();
- if ($ENV{'form.upfiletype'} eq 'xml') {
- } elsif ($ENV{'form.upfiletype'} eq 'space') {
+ if ($env{'form.upfiletype'} eq 'xml') {
+ } elsif ($env{'form.upfiletype'} eq 'space') {
my $i=0;
foreach (split(/\s+/,$record)) {
my $field=$_;
$field=~s/^(\"|\')//;
$field=~s/(\"|\')$//;
- $components{$i}=$field;
+ $components{&takeleft($i)}=$field;
$i++;
}
- } elsif ($ENV{'form.upfiletype'} eq 'tab') {
+ } elsif ($env{'form.upfiletype'} eq 'tab') {
my $i=0;
foreach (split(/\t/,$record)) {
my $field=$_;
$field=~s/^(\"|\')//;
$field=~s/(\"|\')$//;
- $components{$i}=$field;
+ $components{&takeleft($i)}=$field;
$i++;
}
} else {
@@ -3006,7 +3306,7 @@ sub record_sep {
$field=~s/^\s*$delimiter//;
$field=~s/$delimiter\s*$//;
}
- $components{$i}=$field;
+ $components{&takeleft($i)}=$field;
$i++;
}
}
@@ -3115,7 +3415,7 @@ sub csv_print_select_table {
$r->print('<option value="none"></option>');
foreach (sort({$a <=> $b} keys(%sone))) {
$r->print('<option value="'.$_.'"'.
- ($_ eq $defaultcol ? ' selected ' : '').
+ ($_ eq $defaultcol ? ' selected="selected" ' : '').
'>Column '.($_+1).'</option>');
}
$r->print('</select></td></tr>'."\n");
@@ -3159,13 +3459,13 @@ sub csv_samples_select_table {
foreach (@$d) {
my ($value,$display,$defaultcol)=@{ $_ };
$r->print('<option value="'.$value.'"'.
- ($i eq $defaultcol ? ' selected ':'').'>'.
+ ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
$display.'</option>');
}
$r->print('</select></td><td>');
- if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
- if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
- if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
+ if (defined($sone{$_})) { $r->print($sone{$_}."<br />\n"); }
+ if (defined($stwo{$_})) { $r->print($stwo{$_}."<br />\n"); }
+ if (defined($sthree{$_})) { $r->print($sthree{$_}."<br />\n"); }
$r->print('</td></tr>');
$i++;
}
@@ -3290,6 +3590,9 @@ they are plotted. If undefined, default
=item @Values: An array of array references. Each array reference holds data
to be plotted in a stacked bar chart.
+=item If the final element of @Values is a hash reference the key/value
+pairs will be added to the graph definition.
+
=back
Returns:
@@ -3670,34 +3973,34 @@ Returns: both routines return nothing
sub store_course_settings {
# save to the environment
# appenv the same items, just to be safe
- my $courseid = $ENV{'request.course.id'};
- my $coursedom = $ENV{'course.'.$courseid.'.domain'};
+ my $courseid = $env{'request.course.id'};
+ my $coursedom = $env{'course.'.$courseid.'.domain'};
my ($prefix,$Settings) = @_;
my %SaveHash;
my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {
my $basename = 'internal.'.$prefix.'.'.$setting;
my $envname = 'course.'.$courseid.'.'.$basename;
- if (exists($ENV{'form.'.$setting})) {
+ if (exists($env{'form.'.$setting})) {
# Save this value away
if ($type eq 'scalar' &&
- (! exists($ENV{$envname}) ||
- $ENV{$envname} ne $ENV{'form.'.$setting})) {
- $SaveHash{$basename} = $ENV{'form.'.$setting};
- $AppHash{$envname} = $ENV{'form.'.$setting};
+ (! exists($env{$envname}) ||
+ $env{$envname} ne $env{'form.'.$setting})) {
+ $SaveHash{$basename} = $env{'form.'.$setting};
+ $AppHash{$envname} = $env{'form.'.$setting};
} elsif ($type eq 'array') {
my $stored_form;
- if (ref($ENV{'form.'.$setting})) {
+ if (ref($env{'form.'.$setting})) {
$stored_form = join(',',
map {
&Apache::lonnet::escape($_);
- } sort(@{$ENV{'form.'.$setting}}));
+ } sort(@{$env{'form.'.$setting}}));
} else {
$stored_form =
- &Apache::lonnet::escape($ENV{'form.'.$setting});
+ &Apache::lonnet::escape($env{'form.'.$setting});
}
# Determine if the array contents are the same.
- if ($stored_form ne $ENV{$envname}) {
+ if ($stored_form ne $env{$envname}) {
$SaveHash{$basename} = $stored_form;
$AppHash{$envname} = $stored_form;
}
@@ -3706,7 +4009,7 @@ sub store_course_settings {
}
my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
$coursedom,
- $ENV{'course.'.$courseid.'.num'});
+ $env{'course.'.$courseid.'.num'});
if ($put_result !~ /^(ok|delayed)/) {
&Apache::lonnet::logthis('unable to save form parameters, '.
'got error:'.$put_result);
@@ -3717,20 +4020,20 @@ sub store_course_settings {
}
sub restore_course_settings {
- my $courseid = $ENV{'request.course.id'};
+ my $courseid = $env{'request.course.id'};
my ($prefix,$Settings) = @_;
while (my ($setting,$type) = each(%$Settings)) {
- next if (exists($ENV{'form.'.$setting}));
+ next if (exists($env{'form.'.$setting}));
my $envname = 'course.'.$courseid.'.internal.'.$prefix.
'.'.$setting;
- if (exists($ENV{$envname})) {
+ if (exists($env{$envname})) {
if ($type eq 'scalar') {
- $ENV{'form.'.$setting} = $ENV{$envname};
+ $env{'form.'.$setting} = $env{$envname};
} elsif ($type eq 'array') {
- $ENV{'form.'.$setting} = [
+ $env{'form.'.$setting} = [
map {
&Apache::lonnet::unescape($_);
- } split(',',$ENV{$envname})
+ } split(',',$env{$envname})
];
}
}
@@ -3763,7 +4066,7 @@ sub icon {
$curfext.".gif";
}
}
- return $iconname;
+ return &lonhttpdurl($iconname);
}
sub lonhttpdurl {
@@ -3801,7 +4104,7 @@ sub escape_double {
# Escapes the last element of a full URL.
sub escape_url {
my ($url) = @_;
- my @urlslices = split(/\//, $url);
+ my @urlslices = split(/\//, $url,-1);
my $lastitem = &Apache::lonnet::escape(pop(@urlslices));
return join('/',@urlslices).'/'.$lastitem;
}