version 1.254, 2005/03/02 20:35:46
|
version 1.262, 2005/05/26 20:49:23
|
Line 55 redundancy from other modules and increa
|
Line 55 redundancy from other modules and increa
|
package Apache::loncommon; |
package Apache::loncommon; |
|
|
use strict; |
use strict; |
use Apache::lonnet(); |
use Apache::lonnet; |
use GDBM_File; |
use GDBM_File; |
use POSIX qw(strftime mktime); |
use POSIX qw(strftime mktime); |
use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
Line 311 END
|
Line 311 END
|
} |
} |
|
|
sub lastresurl { |
sub lastresurl { |
if ($ENV{'environment.lastresurl'}) { |
if ($env{'environment.lastresurl'}) { |
return $ENV{'environment.lastresurl'} |
return $env{'environment.lastresurl'} |
} else { |
} else { |
return '/res'; |
return '/res'; |
} |
} |
Line 329 sub storeresurl {
|
Line 329 sub storeresurl {
|
|
|
sub studentbrowser_javascript { |
sub studentbrowser_javascript { |
unless ( |
unless ( |
(($ENV{'request.course.id'}) && |
(($env{'request.course.id'}) && |
(&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) |
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) |
|| ($ENV{'request.role'}=~/^(au|dc|su)/) |
|| ($env{'request.role'}=~/^(au|dc|su)/) |
) { return ''; } |
) { return ''; } |
return (<<'ENDSTDBRW'); |
return (<<'ENDSTDBRW'); |
<script type="text/javascript" language="Javascript" > |
<script type="text/javascript" language="Javascript" > |
Line 360 ENDSTDBRW
|
Line 360 ENDSTDBRW
|
|
|
sub selectstudent_link { |
sub selectstudent_link { |
my ($form,$unameele,$udomele)=@_; |
my ($form,$unameele,$udomele)=@_; |
if ($ENV{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { |
unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { |
return ''; |
return ''; |
} |
} |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
'","'.$udomele.'");'."'>".&mt('Select User')."</a>"; |
'","'.$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. |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>"; |
'","'.$udomele.'",1);'."'>".&mt('Select User')."</a>"; |
} |
} |
Line 593 sub help_open_topic {
|
Line 593 sub help_open_topic {
|
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
$text = "" if (not defined $text); |
$text = "" if (not defined $text); |
$stayOnPage = 0 if (not defined $stayOnPage); |
$stayOnPage = 0 if (not defined $stayOnPage); |
if ($ENV{'browser.interface'} eq 'textual' || |
if ($env{'browser.interface'} eq 'textual' || |
$ENV{'environment.remote'} eq 'off' ) { |
$env{'environment.remote'} eq 'off' ) { |
$stayOnPage=1; |
$stayOnPage=1; |
} |
} |
$width = 350 if (not defined $width); |
$width = 350 if (not defined $width); |
Line 659 sub help_open_menu {
|
Line 659 sub help_open_menu {
|
my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_; |
my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_; |
$text = "" if (not defined $text); |
$text = "" if (not defined $text); |
$stayOnPage = 0 if (not defined $stayOnPage); |
$stayOnPage = 0 if (not defined $stayOnPage); |
if ($ENV{'browser.interface'} eq 'textual' || |
if ($env{'browser.interface'} eq 'textual' || |
$ENV{'environment.remote'} eq 'off' ) { |
$env{'environment.remote'} eq 'off' ) { |
$stayOnPage=1; |
$stayOnPage=1; |
} |
} |
$width = 620 if (not defined $width); |
$width = 620 if (not defined $width); |
Line 687 sub help_open_menu {
|
Line 687 sub help_open_menu {
|
"<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>". |
"<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>". |
"<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>"; |
"<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 $html=&Apache::lonxml::xmlbegin(); |
my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif"); |
my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif"); |
$template .= <<"ENDTEMPLATE"; |
$template .= <<"ENDTEMPLATE"; |
Line 698 function helpMenu(target) {
|
Line 699 function helpMenu(target) {
|
if (target == 'open') { |
if (target == 'open') { |
var newWindow = null; |
var newWindow = null; |
try { |
try { |
newWindow = window.open("/adm/rat/empty.html","helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" ) |
newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" ) |
} |
} |
catch(error) { |
catch(error) { |
writeHelp(caller); |
writeHelp(caller); |
Line 742 ENDTEMPLATE
|
Line 743 ENDTEMPLATE
|
|
|
sub help_open_bug { |
sub help_open_bug { |
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
unless ($ENV{'user.adv'}) { return ''; } |
unless ($env{'user.adv'}) { return ''; } |
unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; } |
unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; } |
$text = "" if (not defined $text); |
$text = "" if (not defined $text); |
$stayOnPage = 0 if (not defined $stayOnPage); |
$stayOnPage = 0 if (not defined $stayOnPage); |
if ($ENV{'browser.interface'} eq 'textual' || |
if ($env{'browser.interface'} eq 'textual' || |
$ENV{'environment.remote'} eq 'off' ) { |
$env{'environment.remote'} eq 'off' ) { |
$stayOnPage=1; |
$stayOnPage=1; |
} |
} |
$width = 600 if (not defined $width); |
$width = 600 if (not defined $width); |
Line 787 ENDTEMPLATE
|
Line 788 ENDTEMPLATE
|
|
|
sub help_open_faq { |
sub help_open_faq { |
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
my ($topic, $text, $stayOnPage, $width, $height) = @_; |
unless ($ENV{'user.adv'}) { return ''; } |
unless ($env{'user.adv'}) { return ''; } |
unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; } |
unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; } |
$text = "" if (not defined $text); |
$text = "" if (not defined $text); |
$stayOnPage = 0 if (not defined $stayOnPage); |
$stayOnPage = 0 if (not defined $stayOnPage); |
if ($ENV{'browser.interface'} eq 'textual' || |
if ($env{'browser.interface'} eq 'textual' || |
$ENV{'environment.remote'} eq 'off' ) { |
$env{'environment.remote'} eq 'off' ) { |
$stayOnPage=1; |
$stayOnPage=1; |
} |
} |
$width = 350 if (not defined $width); |
$width = 350 if (not defined $width); |
Line 835 ENDTEMPLATE
|
Line 836 ENDTEMPLATE
|
|
|
=pod |
=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) |
=item * csv_translate($text) |
|
|
Translate $text to allow it to be output as a 'comma separated values' |
Translate $text to allow it to be output as a 'comma separated values' |
Line 851 sub csv_translate {
|
Line 944 sub csv_translate {
|
return $text; |
return $text; |
} |
} |
|
|
|
|
############################################################### |
############################################################### |
############################################################### |
############################################################### |
|
|
Line 875 Currently supported formats:
|
Line 967 Currently supported formats:
|
|
|
=item h3 |
=item h3 |
|
|
|
=item h4 |
|
|
|
=item i |
|
|
=item date |
=item date |
|
|
=back |
=back |
Line 897 sub define_excel_formats {
|
Line 993 sub define_excel_formats {
|
$format->{'h1'} = $workbook->add_format(bold=>1, size=>18); |
$format->{'h1'} = $workbook->add_format(bold=>1, size=>18); |
$format->{'h2'} = $workbook->add_format(bold=>1, size=>16); |
$format->{'h2'} = $workbook->add_format(bold=>1, size=>16); |
$format->{'h3'} = $workbook->add_format(bold=>1, size=>14); |
$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->{'i'} = $workbook->add_format(italic=>1); |
$format->{'date'} = $workbook->add_format(num_format=> |
$format->{'date'} = $workbook->add_format(num_format=> |
'mm/dd/yyyy hh:mm:ss'); |
'mm/dd/yyyy hh:mm:ss'); |
Line 908 sub define_excel_formats {
|
Line 1005 sub define_excel_formats {
|
|
|
=pod |
=pod |
|
|
=item * change_content_javascript(): |
=item * create_workbook |
|
|
This and the next function allow you to create small sections of an |
Create an Excel worksheet. If it fails, output message on the |
otherwise static HTML page that you can update on the fly with |
request object and return undefs. |
Javascript, even in Netscape 4. |
|
|
|
The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag) |
Inputs: Apache request object |
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 |
Returns (undef) on failure, |
to contain room for the original contents. You need to "make space" |
Excel worksheet object, scalar with filename, and formats |
for whatever changes you wish to make, and be B<sure> to check your |
from &Apache::loncommon::define_excel_formats on success |
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 |
=cut |
|
|
sub change_content_javascript { |
############################################################### |
# If we're on Netscape 4, we need to use Layer-based code |
############################################################### |
if ($ENV{'browser.type'} eq 'netscape' && |
sub create_workbook { |
$ENV{'browser.version'} =~ /^4\./) { |
my ($r) = @_; |
return (<<NETSCAPE4); |
# |
function change(name, content) { |
# Create the excel spreadsheet |
doc = document.layers[name+"___escape"].layers[0].document; |
my $filename = '/prtspool/'. |
doc.open(); |
$env{'user.name'}.'_'.$env{'user.domain'}.'_'. |
doc.write(content); |
time.'_'.rand(1000000000).'.xls'; |
doc.close(); |
my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); |
} |
if (! defined($workbook)) { |
NETSCAPE4 |
$r->log_error("Error creating excel spreadsheet $filename: $!"); |
} else { |
$r->print('<p>'.&mt("Unable to create new Excel file. ". |
# Otherwise, we need to use semi-standards-compliant code |
"This error has been logged. ". |
# (technically, "innerHTML" isn't standard but the equivalent |
"Please alert your LON-CAPA administrator"). |
# is really scary, and every useful browser supports it |
'</p>'); |
return (<<DOMBASED); |
return (undef); |
function change(name, content) { |
|
element = document.getElementById(name); |
|
element.innerHTML = content; |
|
} |
|
DOMBASED |
|
} |
} |
|
# |
|
$workbook->set_tempdir('/home/httpd/perl/tmp'); |
|
# |
|
my $format = &Apache::loncommon::define_excel_formats($workbook); |
|
return ($workbook,$filename,$format); |
} |
} |
|
|
|
############################################################### |
|
############################################################### |
|
|
=pod |
=pod |
|
|
=item * changable_area($name, $origContent): |
=item * create_text_file |
|
|
This provides a "changable area" that can be modified on the fly via |
Create a file to write to and eventually make available to the usre. |
the Javascript code provided in C<change_content_javascript>. $name is |
If file creation fails, outputs an error message on the request object and |
the name you will use to reference the area later; do not repeat the |
return undefs. |
same name on a given HTML page more then once. $origContent is what |
|
the area will originally contain, which can be left blank. |
|
|
|
=cut |
Inputs: Apache request object, and file suffix |
|
|
sub changable_area { |
Returns (undef) on failure, |
my ($name, $origContent) = @_; |
Filehandle and filename on success. |
|
|
if ($ENV{'browser.type'} eq 'netscape' && |
=cut |
$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 { |
sub create_text_file { |
return "<span id='$name'>$origContent</span>"; |
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 |
=back |
|
|
Line 1809 if the user does not
|
Line 1905 if the user does not
|
sub nickname { |
sub nickname { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
my %names; |
my %names; |
if ($uname eq $ENV{'user.name'} && |
if ($uname eq $env{'user.name'} && |
$udom eq $ENV{'user.domain'}) { |
$udom eq $env{'user.domain'}) { |
%names=('nickname' => $ENV{'environment.nickname'} , |
%names=('nickname' => $env{'environment.nickname'} , |
'firstname' => $ENV{'environment.firstname'} , |
'firstname' => $env{'environment.firstname'} , |
'middlename' => $ENV{'environment.middlename'}, |
'middlename' => $env{'environment.middlename'}, |
'lastname' => $ENV{'environment.lastname'} , |
'lastname' => $env{'environment.lastname'} , |
'generation' => $ENV{'environment.generation'}); |
'generation' => $env{'environment.generation'}); |
} else { |
} else { |
%names=&Apache::lonnet::get('environment', |
%names=&Apache::lonnet::get('environment', |
['nickname','firstname','middlename', |
['nickname','firstname','middlename', |
Line 1846 Gets a users screenname and returns it a
|
Line 1942 Gets a users screenname and returns it a
|
|
|
sub screenname { |
sub screenname { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
if ($uname eq $ENV{'user.name'} && |
if ($uname eq $env{'user.name'} && |
$udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};} |
$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};} |
my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname); |
my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname); |
return $names{'screenname'}; |
return $names{'screenname'}; |
} |
} |
Line 2095 sub display_languages {
|
Line 2191 sub display_languages {
|
$languages{$_}=1; |
$languages{$_}=1; |
} |
} |
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); |
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); |
if ($ENV{'form.displaylanguage'}) { |
if ($env{'form.displaylanguage'}) { |
foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'form.displaylanguage'})) { |
foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { |
$languages{$_}=1; |
$languages{$_}=1; |
} |
} |
} |
} |
Line 2105 sub display_languages {
|
Line 2201 sub display_languages {
|
|
|
sub preferred_languages { |
sub preferred_languages { |
my @languages=(); |
my @languages=(); |
if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) { |
if ($env{'course.'.$env{'request.course.id'}.'.languages'}) { |
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/, |
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/, |
$ENV{'course.'.$ENV{'request.course.id'}.'.languages'})); |
$env{'course.'.$env{'request.course.id'}.'.languages'})); |
} |
} |
if ($ENV{'environment.languages'}) { |
if ($env{'environment.languages'}) { |
@languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'}); |
@languages=split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}); |
} |
} |
my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0]; |
my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0]; |
if ($browser) { |
if ($browser) { |
@languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$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, |
@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, |
@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{ |
if ($Apache::lonnet::domain_lang_def{ |
$Apache::lonnet::perlvar{'lonDefDomain'}}) { |
$Apache::lonnet::perlvar{'lonDefDomain'}}) { |
Line 2444 sub maketime {
|
Line 2540 sub maketime {
|
sub findallcourses { |
sub findallcourses { |
my %courses=(); |
my %courses=(); |
my $now=time; |
my $now=time; |
foreach (keys %ENV) { |
foreach (keys %env) { |
if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) { |
if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) { |
my ($starttime,$endtime)=$ENV{$_}; |
my ($starttime,$endtime)=$env{$_}; |
my $active=1; |
my $active=1; |
if ($starttime) { |
if ($starttime) { |
if ($now<$starttime) { $active=0; } |
if ($now<$starttime) { $active=0; } |
Line 2483 sub determinedomain {
|
Line 2579 sub determinedomain {
|
if (! $domain) { |
if (! $domain) { |
# Determine domain if we have not been given one |
# Determine domain if we have not been given one |
$domain = $Apache::lonnet::perlvar{'lonDefDomain'}; |
$domain = $Apache::lonnet::perlvar{'lonDefDomain'}; |
if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; } |
if ($env{'user.domain'}) { $domain=$env{'user.domain'}; } |
if ($ENV{'request.role.domain'}) { |
if ($env{'request.role.domain'}) { |
$domain=$ENV{'request.role.domain'}; |
$domain=$env{'request.role.domain'}; |
} |
} |
} |
} |
return $domain; |
return $domain; |
Line 2530 Returns: value of designparamter $which
|
Line 2626 Returns: value of designparamter $which
|
############################################## |
############################################## |
sub designparm { |
sub designparm { |
my ($which,$domain)=@_; |
my ($which,$domain)=@_; |
if ($ENV{'browser.blackwhite'} eq 'on') { |
if ($env{'browser.blackwhite'} eq 'on') { |
if ($which=~/\.(font|alink|vlink|link)$/) { |
if ($which=~/\.(font|alink|vlink|link)$/) { |
return '#000000'; |
return '#000000'; |
} |
} |
Line 2541 sub designparm {
|
Line 2637 sub designparm {
|
return '#CCCCCC'; |
return '#CCCCCC'; |
} |
} |
} |
} |
if ($ENV{'environment.color.'.$which}) { |
if ($env{'environment.color.'.$which}) { |
return $ENV{'environment.color.'.$which}; |
return $env{'environment.color.'.$which}; |
} |
} |
$domain=&determinedomain($domain); |
$domain=&determinedomain($domain); |
if ($designhash{$domain.'.'.$which}) { |
if ($designhash{$domain.'.'.$which}) { |
Line 2608 sub bodytag {
|
Line 2704 sub bodytag {
|
# Accessibility font enhance |
# Accessibility font enhance |
unless ($addentries) { $addentries=''; } |
unless ($addentries) { $addentries=''; } |
my $addstyle=''; |
my $addstyle=''; |
if ($ENV{'browser.fontenhance'} eq 'on') { |
if ($env{'browser.fontenhance'} eq 'on') { |
$addstyle=' font-size: x-large;'; |
$addstyle=' font-size: x-large;'; |
} |
} |
# role and realm |
# role and realm |
my ($role,$realm) |
my ($role,$realm) |
=&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]); |
=&Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]); |
# realm |
# realm |
if ($ENV{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
$realm= |
$realm= |
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}; |
$env{'course.'.$env{'request.course.id'}.'.description'}; |
} |
} |
unless ($realm) { $realm=' '; } |
unless ($realm) { $realm=' '; } |
# Set messages |
# Set messages |
Line 2634 a:focus { color: red; background: yellow
|
Line 2730 a:focus { color: red; background: yellow
|
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
style="margin-top: 0px;$addstyle" $addentries> |
style="margin-top: 0px;$addstyle" $addentries> |
END |
END |
if ($ENV{'environment.texengine'} eq 'jsMath') { |
if ($env{'environment.texengine'} eq 'jsMath') { |
$bodytag.='<script type="text/javascript"> |
$bodytag.='<script type="text/javascript"> |
function NoFontMessage () {} |
function NoFontMessage () {} |
</script>'."\n". |
</script>'."\n". |
Line 2645 END
|
Line 2741 END
|
$lonhttpdPort.$img.'" alt="'.$function.'" />'; |
$lonhttpdPort.$img.'" alt="'.$function.'" />'; |
if ($bodyonly) { |
if ($bodyonly) { |
return $bodytag; |
return $bodytag; |
} elsif ($ENV{'browser.interface'} eq 'textual') { |
} elsif ($env{'browser.interface'} eq 'textual') { |
# Accessibility |
# Accessibility |
|
|
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', |
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', |
$forcereg). |
$forcereg). |
'<h1>LON-CAPA: '.$title.'</h1>'; |
'<h1>LON-CAPA: '.$title.'</h1>'; |
} elsif ($ENV{'environment.remote'} eq 'off') { |
} elsif ($env{'environment.remote'} eq 'off') { |
# No Remote |
# No Remote |
my $roleinfo=(<<ENDROLE); |
my $roleinfo=(<<ENDROLE); |
<td bgcolor="$tabbg" align="right"> |
<td bgcolor="$tabbg" align="right"> |
<font size="2" face="Arial, Helvetica, sans-serif"> |
<font size="2" face="Arial, Helvetica, sans-serif"> |
$ENV{'environment.firstname'} |
$env{'environment.firstname'} |
$ENV{'environment.middlename'} |
$env{'environment.middlename'} |
$ENV{'environment.lastname'} |
$env{'environment.lastname'} |
$ENV{'environment.generation'} |
$env{'environment.generation'} |
</font> |
</font> |
<br /> |
<br /> |
<font size="2" face="Arial, Helvetica, sans-serif">$role</font> |
<font size="2" face="Arial, Helvetica, sans-serif">$role</font> |
Line 2673 ENDROLE
|
Line 2769 ENDROLE
|
$titleinfo = $customtitle; |
$titleinfo = $customtitle; |
} |
} |
|
|
if ($ENV{'request.state'} eq 'construct') { |
if ($env{'request.state'} eq 'construct') { |
my ($uname,$thisdisfn)= |
my ($uname,$thisdisfn)= |
($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); |
($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); |
my $formaction='/priv/'.$uname.'/'.$thisdisfn; |
my $formaction='/priv/'.$uname.'/'.$thisdisfn; |
$formaction=~s/\/+/\//g; |
$formaction=~s/\/+/\//g; |
unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm |
unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm |
Line 2703 ENDROLE
|
Line 2799 ENDROLE
|
'cellspacing="3" cellpadding="3">'. |
'cellspacing="3" cellpadding="3">'. |
'<tr><td rowspan="3" bgcolor="'.$tabbg.'">'. |
'<tr><td rowspan="3" bgcolor="'.$tabbg.'">'. |
$titleinfo.'</td>'.$roleinfo.'</tr></table>'; |
$titleinfo.'</td>'.$roleinfo.'</tr></table>'; |
if ($ENV{'request.state'} eq 'construct') { |
if ($env{'request.state'} eq 'construct') { |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable); |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable); |
} else { |
} else { |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg). |
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg). |
Line 2722 ENDROLE
|
Line 2818 ENDROLE
|
# |
# |
# Extra info if you are the DC |
# Extra info if you are the DC |
my $dc_info = ''; |
my $dc_info = ''; |
if ($ENV{'user.adv'} && exists($ENV{'user.role.dc./'. |
if ($env{'user.adv'} && exists($env{'user.role.dc./'. |
$ENV{'course.'.$ENV{'request.course.id'}. |
$env{'course.'.$env{'request.course.id'}. |
'.domain'}.'/'})) { |
'.domain'}.'/'})) { |
my $cid = $ENV{'request.course.id'}; |
my $cid = $env{'request.course.id'}; |
$dc_info.= $cid.' '.$ENV{'course.'.$cid.'.internal.coursecode'}; |
$dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; |
$dc_info = '('.$dc_info.')'; |
$dc_info = '('.$dc_info.')'; |
} |
} |
# |
# |
Line 2740 $upperleft</td>
|
Line 2836 $upperleft</td>
|
<tr> |
<tr> |
<td rowspan="3" bgcolor="$tabbg"> |
<td rowspan="3" bgcolor="$tabbg"> |
$titleinfo $dc_info |
$titleinfo $dc_info |
<td bgcolor="$tabbg" align="right"> |
</td><td bgcolor="$tabbg" align="right"> |
<font size="2" face="Arial, Helvetica, sans-serif"> |
<font size="2" face="Arial, Helvetica, sans-serif"> |
$ENV{'environment.firstname'} |
$env{'environment.firstname'} |
$ENV{'environment.middlename'} |
$env{'environment.middlename'} |
$ENV{'environment.lastname'} |
$env{'environment.lastname'} |
$ENV{'environment.generation'} |
$env{'environment.generation'} |
</font> |
</font> |
</td> |
</td> |
</tr> |
</tr> |
Line 2785 Returns: A uniform footer for LON-CAPA w
|
Line 2881 Returns: A uniform footer for LON-CAPA w
|
|
|
sub endbodytag { |
sub endbodytag { |
my $endbodytag='</body>'; |
my $endbodytag='</body>'; |
if ($ENV{'environment.texengine'} eq 'jsMath') { |
if ($env{'environment.texengine'} eq 'jsMath') { |
$endbodytag='<script type="text/javascript">jsMath.Process()</script>'. |
$endbodytag='<script type="text/javascript">jsMath.Process()</script>'. |
"\n".$endbodytag; |
"\n".$endbodytag; |
} |
} |
Line 2806 Returns either 'student','coordinator','
|
Line 2902 Returns either 'student','coordinator','
|
############################################### |
############################################### |
sub get_users_function { |
sub get_users_function { |
my $function = 'student'; |
my $function = 'student'; |
if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { |
if ($env{'request.role'}=~/^(cc|in|ta|ep)/) { |
$function='coordinator'; |
$function='coordinator'; |
} |
} |
if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) { |
if ($env{'request.role'}=~/^(su|dc|ad|li)/) { |
$function='admin'; |
$function='admin'; |
} |
} |
if (($ENV{'request.role'}=~/^(au|ca)/) || |
if (($env{'request.role'}=~/^(au|ca)/) || |
($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { |
($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { |
$function='author'; |
$function='author'; |
} |
} |
Line 2880 sub get_posted_cgi {
|
Line 2976 sub get_posted_cgi {
|
my $r=shift; |
my $r=shift; |
|
|
my $buffer; |
my $buffer; |
|
if ($r->header_in('Content-length')) { |
$r->read($buffer,$r->header_in('Content-length'),0); |
$r->read($buffer,$r->header_in('Content-length'),0); |
|
} |
unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) { |
unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) { |
my @pairs=split(/&/,$buffer); |
my @pairs=split(/&/,$buffer); |
my $pair; |
my $pair; |
Line 2906 sub get_posted_cgi {
|
Line 3003 sub get_posted_cgi {
|
if ($name) { |
if ($name) { |
chomp($value); |
chomp($value); |
if ($fname) { |
if ($fname) { |
$ENV{"form.$name.filename"}=$fname; |
$env{"form.$name.filename"}=$fname; |
$ENV{"form.$name.mimetype"}=$fmime; |
$env{"form.$name.mimetype"}=$fmime; |
} else { |
} else { |
$value=~s/\s+$//s; |
$value=~s/\s+$//s; |
} |
} |
Line 2939 sub get_posted_cgi {
|
Line 3036 sub get_posted_cgi {
|
} |
} |
} |
} |
} |
} |
$ENV{'request.method'}=$ENV{'REQUEST_METHOD'}; |
$env{'request.method'}=$ENV{'REQUEST_METHOD'}; |
$r->method_number(M_GET); |
$r->method_number(M_GET); |
$r->method('GET'); |
$r->method('GET'); |
$r->headers_in->unset('Content-length'); |
$r->headers_in->unset('Content-length'); |
Line 2949 sub get_posted_cgi {
|
Line 3046 sub get_posted_cgi {
|
|
|
=item * get_unprocessed_cgi($query,$possible_names) |
=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), |
$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. |
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: |
$possible_names is an ref to an array of form element names. As an example: |
get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']); |
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 |
=cut |
|
|
Line 2970 sub get_unprocessed_cgi {
|
Line 3067 sub get_unprocessed_cgi {
|
$value =~ tr/+/ /; |
$value =~ tr/+/ /; |
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
&Apache::lonxml::debug("Seting :$name: to :$value:"); |
&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) }; |
} |
} |
} |
} |
} |
} |
Line 2984 returns cache-controlling header code
|
Line 3081 returns cache-controlling header code
|
=cut |
=cut |
|
|
sub cacheheader { |
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 $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); |
my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" /> |
my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" /> |
<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" /> |
<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" /> |
Line 3003 specifies header code to not have cache
|
Line 3100 specifies header code to not have cache
|
sub no_cache { |
sub no_cache { |
my ($r) = @_; |
my ($r) = @_; |
if ($ENV{'REQUEST_METHOD'} ne 'GET' && |
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)); |
my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time)); |
$r->no_cache(1); |
$r->no_cache(1); |
$r->header_out("Expires" => $date); |
$r->header_out("Expires" => $date); |
Line 3012 sub no_cache {
|
Line 3109 sub no_cache {
|
|
|
sub content_type { |
sub content_type { |
my ($r,$type,$charset) = @_; |
my ($r,$type,$charset) = @_; |
if ($ENV{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } |
if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } |
unless ($charset) { |
unless ($charset) { |
$charset=&Apache::lonlocal::current_encoding; |
$charset=&Apache::lonlocal::current_encoding; |
} |
} |
Line 3028 sub content_type {
|
Line 3125 sub content_type {
|
|
|
=item * add_to_env($name,$value) |
=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 |
$value, if $name already exists, the entry is converted to an array |
reference and $value is added to the array. |
reference and $value is added to the array. |
|
|
Line 3036 reference and $value is added to the arr
|
Line 3133 reference and $value is added to the arr
|
|
|
sub add_to_env { |
sub add_to_env { |
my ($name,$value)=@_; |
my ($name,$value)=@_; |
if (defined($ENV{$name})) { |
if (defined($env{$name})) { |
if (ref($ENV{$name})) { |
if (ref($env{$name})) { |
#already have multiple values |
#already have multiple values |
push(@{ $ENV{$name} },$value); |
push(@{ $env{$name} },$value); |
} else { |
} else { |
#first time seeing multiple values, convert hash entry to an arrayref |
#first time seeing multiple values, convert hash entry to an arrayref |
my $first=$ENV{$name}; |
my $first=$env{$name}; |
undef($ENV{$name}); |
undef($env{$name}); |
push(@{ $ENV{$name} },$first,$value); |
push(@{ $env{$name} },$first,$value); |
} |
} |
} else { |
} else { |
$ENV{$name}=$value; |
$env{$name}=$value; |
} |
} |
} |
} |
|
|
Line 3055 sub add_to_env {
|
Line 3152 sub add_to_env {
|
|
|
=item * get_env_multiple($name) |
=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. |
values may be defined and end up as an array ref. |
|
|
returns an array of values |
returns an array of values |
Line 3065 returns an array of values
|
Line 3162 returns an array of values
|
sub get_env_multiple { |
sub get_env_multiple { |
my ($name) = @_; |
my ($name) = @_; |
my @values; |
my @values; |
if (defined($ENV{$name})) { |
if (defined($env{$name})) { |
# exists is it an array |
# exists is it an array |
if (ref($ENV{$name})) { |
if (ref($env{$name})) { |
@values=@{ $ENV{$name} }; |
@values=@{ $env{$name} }; |
} else { |
} else { |
$values[0]=$ENV{$name}; |
$values[0]=$env{$name}; |
} |
} |
} |
} |
return(@values); |
return(@values); |
Line 3088 sub get_env_multiple {
|
Line 3185 sub get_env_multiple {
|
=item * upfile_store($r) |
=item * upfile_store($r) |
|
|
Store uploaded file, $r should be the HTTP Request object, |
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 |
returns $datatoken to be put into hidden field |
|
|
=cut |
=cut |
|
|
sub upfile_store { |
sub upfile_store { |
my $r=shift; |
my $r=shift; |
$ENV{'form.upfile'}=~s/\r/\n/gs; |
$env{'form.upfile'}=~s/\r/\n/gs; |
$ENV{'form.upfile'}=~s/\f/\n/gs; |
$env{'form.upfile'}=~s/\f/\n/gs; |
$ENV{'form.upfile'}=~s/\n+/\n/gs; |
$env{'form.upfile'}=~s/\n+/\n/gs; |
$ENV{'form.upfile'}=~s/\n+$//gs; |
$env{'form.upfile'}=~s/\n+$//gs; |
|
|
my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}. |
my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. |
'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$; |
'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$; |
{ |
{ |
my $datafile = $r->dir_config('lonDaemons'). |
my $datafile = $r->dir_config('lonDaemons'). |
'/tmp/'.$datatoken.'.tmp'; |
'/tmp/'.$datatoken.'.tmp'; |
if ( open(my $fh,">$datafile") ) { |
if ( open(my $fh,">$datafile") ) { |
print $fh $ENV{'form.upfile'}; |
print $fh $env{'form.upfile'}; |
close($fh); |
close($fh); |
} |
} |
} |
} |
Line 3118 sub upfile_store {
|
Line 3215 sub upfile_store {
|
=item * load_tmp_file($r) |
=item * load_tmp_file($r) |
|
|
Load uploaded file from tmp, $r should be the HTTP Request object, |
Load uploaded file from tmp, $r should be the HTTP Request object, |
needs $ENV{'form.datatoken'}, |
needs $env{'form.datatoken'}, |
sets $ENV{'form.upfile'} to the contents of the file |
sets $env{'form.upfile'} to the contents of the file |
|
|
=cut |
=cut |
|
|
Line 3128 sub load_tmp_file {
|
Line 3225 sub load_tmp_file {
|
my @studentdata=(); |
my @studentdata=(); |
{ |
{ |
my $studentfile = $r->dir_config('lonDaemons'). |
my $studentfile = $r->dir_config('lonDaemons'). |
'/tmp/'.$ENV{'form.datatoken'}.'.tmp'; |
'/tmp/'.$env{'form.datatoken'}.'.tmp'; |
if ( open(my $fh,"<$studentfile") ) { |
if ( open(my $fh,"<$studentfile") ) { |
@studentdata=<$fh>; |
@studentdata=<$fh>; |
close($fh); |
close($fh); |
} |
} |
} |
} |
$ENV{'form.upfile'}=join('',@studentdata); |
$env{'form.upfile'}=join('',@studentdata); |
} |
} |
|
|
=pod |
=pod |
Line 3143 sub load_tmp_file {
|
Line 3240 sub load_tmp_file {
|
|
|
Separate uploaded file into records |
Separate uploaded file into records |
returns array of records, |
returns array of records, |
needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'} |
needs $env{'form.upfile'} and $env{'form.upfiletype'} |
|
|
=cut |
=cut |
|
|
sub upfile_record_sep { |
sub upfile_record_sep { |
if ($ENV{'form.upfiletype'} eq 'xml') { |
if ($env{'form.upfiletype'} eq 'xml') { |
} else { |
} else { |
my @records; |
my @records; |
foreach my $line (split(/\n/,$ENV{'form.upfile'})) { |
foreach my $line (split(/\n/,$env{'form.upfile'})) { |
if ($line=~/^\s*$/) { next; } |
if ($line=~/^\s*$/) { next; } |
push(@records,$line); |
push(@records,$line); |
} |
} |
Line 3163 sub upfile_record_sep {
|
Line 3260 sub upfile_record_sep {
|
|
|
=item * record_sep($record) |
=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 |
=cut |
|
|
sub record_sep { |
sub record_sep { |
my $record=shift; |
my $record=shift; |
my %components=(); |
my %components=(); |
if ($ENV{'form.upfiletype'} eq 'xml') { |
if ($env{'form.upfiletype'} eq 'xml') { |
} elsif ($ENV{'form.upfiletype'} eq 'space') { |
} elsif ($env{'form.upfiletype'} eq 'space') { |
my $i=0; |
my $i=0; |
foreach (split(/\s+/,$record)) { |
foreach (split(/\s+/,$record)) { |
my $field=$_; |
my $field=$_; |
Line 3180 sub record_sep {
|
Line 3277 sub record_sep {
|
$components{$i}=$field; |
$components{$i}=$field; |
$i++; |
$i++; |
} |
} |
} elsif ($ENV{'form.upfiletype'} eq 'tab') { |
} elsif ($env{'form.upfiletype'} eq 'tab') { |
my $i=0; |
my $i=0; |
foreach (split(/\t/,$record)) { |
foreach (split(/\t/,$record)) { |
my $field=$_; |
my $field=$_; |
Line 3871 Returns: both routines return nothing
|
Line 3968 Returns: both routines return nothing
|
sub store_course_settings { |
sub store_course_settings { |
# save to the environment |
# save to the environment |
# appenv the same items, just to be safe |
# appenv the same items, just to be safe |
my $courseid = $ENV{'request.course.id'}; |
my $courseid = $env{'request.course.id'}; |
my $coursedom = $ENV{'course.'.$courseid.'.domain'}; |
my $coursedom = $env{'course.'.$courseid.'.domain'}; |
my ($prefix,$Settings) = @_; |
my ($prefix,$Settings) = @_; |
my %SaveHash; |
my %SaveHash; |
my %AppHash; |
my %AppHash; |
while (my ($setting,$type) = each(%$Settings)) { |
while (my ($setting,$type) = each(%$Settings)) { |
my $basename = 'internal.'.$prefix.'.'.$setting; |
my $basename = 'internal.'.$prefix.'.'.$setting; |
my $envname = 'course.'.$courseid.'.'.$basename; |
my $envname = 'course.'.$courseid.'.'.$basename; |
if (exists($ENV{'form.'.$setting})) { |
if (exists($env{'form.'.$setting})) { |
# Save this value away |
# Save this value away |
if ($type eq 'scalar' && |
if ($type eq 'scalar' && |
(! exists($ENV{$envname}) || |
(! exists($env{$envname}) || |
$ENV{$envname} ne $ENV{'form.'.$setting})) { |
$env{$envname} ne $env{'form.'.$setting})) { |
$SaveHash{$basename} = $ENV{'form.'.$setting}; |
$SaveHash{$basename} = $env{'form.'.$setting}; |
$AppHash{$envname} = $ENV{'form.'.$setting}; |
$AppHash{$envname} = $env{'form.'.$setting}; |
} elsif ($type eq 'array') { |
} elsif ($type eq 'array') { |
my $stored_form; |
my $stored_form; |
if (ref($ENV{'form.'.$setting})) { |
if (ref($env{'form.'.$setting})) { |
$stored_form = join(',', |
$stored_form = join(',', |
map { |
map { |
&Apache::lonnet::escape($_); |
&Apache::lonnet::escape($_); |
} sort(@{$ENV{'form.'.$setting}})); |
} sort(@{$env{'form.'.$setting}})); |
} else { |
} else { |
$stored_form = |
$stored_form = |
&Apache::lonnet::escape($ENV{'form.'.$setting}); |
&Apache::lonnet::escape($env{'form.'.$setting}); |
} |
} |
# Determine if the array contents are the same. |
# Determine if the array contents are the same. |
if ($stored_form ne $ENV{$envname}) { |
if ($stored_form ne $env{$envname}) { |
$SaveHash{$basename} = $stored_form; |
$SaveHash{$basename} = $stored_form; |
$AppHash{$envname} = $stored_form; |
$AppHash{$envname} = $stored_form; |
} |
} |
Line 3907 sub store_course_settings {
|
Line 4004 sub store_course_settings {
|
} |
} |
my $put_result = &Apache::lonnet::put('environment',\%SaveHash, |
my $put_result = &Apache::lonnet::put('environment',\%SaveHash, |
$coursedom, |
$coursedom, |
$ENV{'course.'.$courseid.'.num'}); |
$env{'course.'.$courseid.'.num'}); |
if ($put_result !~ /^(ok|delayed)/) { |
if ($put_result !~ /^(ok|delayed)/) { |
&Apache::lonnet::logthis('unable to save form parameters, '. |
&Apache::lonnet::logthis('unable to save form parameters, '. |
'got error:'.$put_result); |
'got error:'.$put_result); |
Line 3918 sub store_course_settings {
|
Line 4015 sub store_course_settings {
|
} |
} |
|
|
sub restore_course_settings { |
sub restore_course_settings { |
my $courseid = $ENV{'request.course.id'}; |
my $courseid = $env{'request.course.id'}; |
my ($prefix,$Settings) = @_; |
my ($prefix,$Settings) = @_; |
while (my ($setting,$type) = each(%$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. |
my $envname = 'course.'.$courseid.'.internal.'.$prefix. |
'.'.$setting; |
'.'.$setting; |
if (exists($ENV{$envname})) { |
if (exists($env{$envname})) { |
if ($type eq 'scalar') { |
if ($type eq 'scalar') { |
$ENV{'form.'.$setting} = $ENV{$envname}; |
$env{'form.'.$setting} = $env{$envname}; |
} elsif ($type eq 'array') { |
} elsif ($type eq 'array') { |
$ENV{'form.'.$setting} = [ |
$env{'form.'.$setting} = [ |
map { |
map { |
&Apache::lonnet::unescape($_); |
&Apache::lonnet::unescape($_); |
} split(',',$ENV{$envname}) |
} split(',',$env{$envname}) |
]; |
]; |
} |
} |
} |
} |