--- loncom/interface/loncommon.pm 2004/12/08 00:56:00 1.242 +++ loncom/interface/loncommon.pm 2005/09/14 21:25:52 1.273 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.242 2004/12/08 00:56:00 albertel Exp $ +# $Id: loncommon.pm,v 1.273 2005/09/14 21:25:52 raeburn 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); @@ -152,19 +152,20 @@ BEGIN { my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; opendir(DIR,$designdir); while ($filename=readdir(DIR)) { + if ($filename!~/\.tab$/) { next; } my ($domain)=($filename=~/^(\w+)\./); - { - my $designfile = $designdir.'/'.$filename; - if ( open (my $fh,"<$designfile") ) { - while (<$fh>) { - next if /^\#/; - chomp; - my ($key,$val)=(split(/\=/,$_)); - if ($val) { $designhash{$domain.'.'.$key}=$val; } - } - close($fh); - } - } + { + my $designfile = $designdir.'/'.$filename; + if ( open (my $fh,"<$designfile") ) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\=/,$_)); + if ($val) { $designhash{$domain.'.'.$key}=$val; } + } + close($fh); + } + } } closedir(DIR); @@ -311,8 +312,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 +330,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'); (Help Menu) @@ -729,12 +768,12 @@ ENDTEMPLATE sub help_open_bug { my ($topic, $text, $stayOnPage, $width, $height) = @_; - unless ($ENV{'user.adv'}) { return ''; } + unless ($env{'user.adv'}) { return ''; } unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; } $text = "" if (not defined $text); $stayOnPage = 0 if (not defined $stayOnPage); - if ($ENV{'browser.interface'} eq 'textual' || - $ENV{'environment.remote'} eq 'off' ) { + if ($env{'browser.interface'} eq 'textual' || + $env{'environment.remote'} eq 'off' ) { $stayOnPage=1; } $width = 600 if (not defined $width); @@ -774,12 +813,12 @@ ENDTEMPLATE sub help_open_faq { my ($topic, $text, $stayOnPage, $width, $height) = @_; - unless ($ENV{'user.adv'}) { return ''; } + unless ($env{'user.adv'}) { return ''; } unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; } $text = "" if (not defined $text); $stayOnPage = 0 if (not defined $stayOnPage); - if ($ENV{'browser.interface'} eq 'textual' || - $ENV{'environment.remote'} eq 'off' ) { + if ($env{'browser.interface'} eq 'textual' || + $env{'environment.remote'} eq 'off' ) { $stayOnPage=1; } $width = 350 if (not defined $width); @@ -822,6 +861,98 @@ ENDTEMPLATE =pod +=item * change_content_javascript(): + +This and the next function allow you to create small sections of an +otherwise static HTML page that you can update on the fly with +Javascript, even in Netscape 4. + +The Javascript fragment returned by this function (no EscriptE tag) +must be written to the HTML page once. It will prove the Javascript +function "change(name, content)". Calling the change function with the +name of the section +you want to update, matching the name passed to C, and +the new content you want to put in there, will put the content into +that area. + +B: Netscape 4 only reserves enough space for the changable area +to contain room for the original contents. You need to "make space" +for whatever changes you wish to make, and be B to check your +code in Netscape 4. This feature in Netscape 4 is B powerful; +it's adequate for updating a one-line status display, but little more. +This script will set the space to 100% width, so you only need to +worry about height in Netscape 4. + +Modern browsers are much less limiting, and if you can commit to the +user not using Netscape 4, this feature may be used freely with +pretty much any HTML. + +=cut + +sub change_content_javascript { + # If we're on Netscape 4, we need to use Layer-based code + if ($env{'browser.type'} eq 'netscape' && + $env{'browser.version'} =~ /^4\./) { + return (<. $name is +the name you will use to reference the area later; do not repeat the +same name on a given HTML page more then once. $origContent is what +the area will originally contain, which can be left blank. + +=cut + +sub changable_area { + my ($name, $origContent) = @_; + + if ($env{'browser.type'} eq 'netscape' && + $env{'browser.version'} =~ /^4\./) { + # If this is netscape 4, we need to use the Layer tag + return "$origContent"; + } else { + return "$origContent"; + } +} + +=pod + +=back + +=head1 Excel and CSV file utility routines + +=over 4 + +=cut + +############################################################### +############################################################### + +=pod + =item * csv_translate($text) Translate $text to allow it to be output as a 'comma separated values' @@ -838,7 +969,6 @@ sub csv_translate { return $text; } - ############################################################### ############################################################### @@ -862,6 +992,10 @@ Currently supported formats: =item h3 +=item h4 + +=item i + =item date =back @@ -884,6 +1018,8 @@ sub define_excel_formats { $format->{'h1'} = $workbook->add_format(bold=>1, size=>18); $format->{'h2'} = $workbook->add_format(bold=>1, size=>16); $format->{'h3'} = $workbook->add_format(bold=>1, size=>14); + $format->{'h4'} = $workbook->add_format(bold=>1, size=>12); + $format->{'i'} = $workbook->add_format(italic=>1); $format->{'date'} = $workbook->add_format(num_format=> 'mm/dd/yyyy hh:mm:ss'); return $format; @@ -894,84 +1030,83 @@ sub define_excel_formats { =pod -=item * change_content_javascript(): +=item * create_workbook -This and the next function allow you to create small sections of an -otherwise static HTML page that you can update on the fly with -Javascript, even in Netscape 4. +Create an Excel worksheet. If it fails, output message on the +request object and return undefs. -The Javascript fragment returned by this function (no EscriptE tag) -must be written to the HTML page once. It will prove the Javascript -function "change(name, content)". Calling the change function with the -name of the section -you want to update, matching the name passed to C, and -the new content you want to put in there, will put the content into -that area. +Inputs: Apache request object -B: Netscape 4 only reserves enough space for the changable area -to contain room for the original contents. You need to "make space" -for whatever changes you wish to make, and be B to check your -code in Netscape 4. This feature in Netscape 4 is B powerful; -it's adequate for updating a one-line status display, but little more. -This script will set the space to 100% width, so you only need to -worry about height in Netscape 4. - -Modern browsers are much less limiting, and if you can commit to the -user not using Netscape 4, this feature may be used freely with -pretty much any HTML. +Returns (undef) on failure, + Excel worksheet object, scalar with filename, and formats + from &Apache::loncommon::define_excel_formats on success =cut -sub change_content_javascript { - # If we're on Netscape 4, we need to use Layer-based code - if ($ENV{'browser.type'} eq 'netscape' && - $ENV{'browser.version'} =~ /^4\./) { - return (<new('/home/httpd'.$filename); + if (! defined($workbook)) { + $r->log_error("Error creating excel spreadsheet $filename: $!"); + $r->print('

'.&mt("Unable to create new Excel file. ". + "This error has been logged. ". + "Please alert your LON-CAPA administrator"). + '

'); + return (undef); } + # + $workbook->set_tempdir('/home/httpd/perl/tmp'); + # + my $format = &Apache::loncommon::define_excel_formats($workbook); + return ($workbook,$filename,$format); } +############################################################### +############################################################### + =pod -=item * changable_area($name, $origContent): +=item * create_text_file -This provides a "changable area" that can be modified on the fly via -the Javascript code provided in C. $name is -the name you will use to reference the area later; do not repeat the -same name on a given HTML page more then once. $origContent is what -the area will originally contain, which can be left blank. +Create a file to write to and eventually make available to the usre. +If file creation fails, outputs an error message on the request object and +return undefs. -=cut +Inputs: Apache request object, and file suffix -sub changable_area { - my ($name, $origContent) = @_; +Returns (undef) on failure, + Filehandle and filename on success. - if ($ENV{'browser.type'} eq 'netscape' && - $ENV{'browser.version'} =~ /^4\./) { - # If this is netscape 4, we need to use the Layer tag - return "$origContent"; - } else { - return "$origContent"; +=cut + +############################################################### +############################################################### +sub create_text_file { + my ($r,$suffix) = @_; + if (! defined($suffix)) { $suffix = 'txt'; }; + my $fh; + my $filename = '/prtspool/'. + $env{'user.name'}.'_'.$env{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.'.$suffix; + $fh = Apache::File->new('>/home/httpd'.$filename); + if (! defined($fh)) { + $r->log_error("Couldn't open $filename for output $!"); + $r->print("Problems occured in creating the output file. ". + "This error has been logged. ". + "Please alert your LON-CAPA administrator."); } + return ($fh,$filename) } -=pod + +=pod =back @@ -1033,7 +1168,7 @@ sub multiple_select_form { $output.="\n\n"; @@ -1064,7 +1199,7 @@ sub select_form { } foreach (@keys) { $selectform.="\n"; } $selectform.=""; @@ -1101,7 +1236,7 @@ sub select_level_form { my $selectform = ""; @@ -1131,7 +1266,7 @@ sub select_dom_form { my $selectdomain = ""; @@ -1230,9 +1365,11 @@ Outputs: ############################################################### ############################################################### sub decode_user_agent { + my ($r)=@_; my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"}); my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"}); my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; + if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); } my $clientbrowser='unknown'; my $clientversion='0'; my $clientmathml=''; @@ -1793,13 +1930,13 @@ if the user does not sub nickname { my ($uname,$udom)=@_; my %names; - if ($uname eq $ENV{'user.name'} && - $udom eq $ENV{'user.domain'}) { - %names=('nickname' => $ENV{'environment.nickname'} , - 'firstname' => $ENV{'environment.firstname'} , - 'middlename' => $ENV{'environment.middlename'}, - 'lastname' => $ENV{'environment.lastname'} , - 'generation' => $ENV{'environment.generation'}); + if ($uname eq $env{'user.name'} && + $udom eq $env{'user.domain'}) { + %names=('nickname' => $env{'environment.nickname'} , + 'firstname' => $env{'environment.firstname'} , + 'middlename' => $env{'environment.middlename'}, + 'lastname' => $env{'environment.lastname'} , + 'generation' => $env{'environment.generation'}); } else { %names=&Apache::lonnet::get('environment', ['nickname','firstname','middlename', @@ -1830,8 +1967,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'}; } @@ -1873,24 +2010,23 @@ sub syllabuswrapper { } sub track_student_link { - my ($linktext,$sname,$sdom,$target) = @_; - my $link ="/adm/trackstudent"; + my ($linktext,$sname,$sdom,$target,$start) = @_; + my $link ="/adm/trackstudent?"; my $title = 'View recent activity'; if (defined($sname) && $sname !~ /^\s*$/ && defined($sdom) && $sdom !~ /^\s*$/) { - $link .= "?selected_student=$sname:$sdom"; + $link .= "selected_student=$sname:$sdom"; $title .= ' of this student'; - } + } if (defined($target) && $target !~ /^\s*$/) { $target = qq{target="$target"}; } else { $target = ''; } + if ($start) { $link.='&start='.$start; } return qq{$linktext}; } - - =pod =back @@ -2079,8 +2215,8 @@ sub display_languages { $languages{$_}=1; } &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); - if ($ENV{'form.displaylanguage'}) { - foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'form.displaylanguage'})) { + if ($env{'form.displaylanguage'}) { + foreach (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) { $languages{$_}=1; } } @@ -2089,24 +2225,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'}}) { @@ -2339,7 +2475,7 @@ sub submlink { &Apache::lonxml::whichuser($symb); if (!$symb) { $symb=$cursymb; } } - if (!$symb) { $symb=&symbread(); } + if (!$symb) { $symb=&Apache::lonnet::symbread(); } $symb=&Apache::lonnet::escape($symb); if ($target) { $target="target=\"$target\""; } return ' END + &Apache::lontexconvert::jsMath_reset(); + if ($env{'environment.texengine'} eq 'jsMath') { + $bodytag.=&Apache::lontexconvert::jsMath_header(); + } + my $upperleft=''.$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). '

LON-CAPA: '.$title.'

'; - } elsif ($ENV{'environment.remote'} eq 'off') { + } elsif ($env{'environment.remote'} eq 'off') { # No Remote my $roleinfo=(< - $ENV{'environment.firstname'} - $ENV{'environment.middlename'} - $ENV{'environment.lastname'} - $ENV{'environment.generation'} + $env{'environment.firstname'} + $env{'environment.middlename'} + $env{'environment.lastname'} + $env{'environment.generation'}  
$role  @@ -2650,9 +2791,9 @@ ENDROLE $titleinfo = $customtitle; } - if ($ENV{'request.state'} eq 'construct') { + if ($env{'request.state'} eq 'construct') { my ($uname,$thisdisfn)= - ($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); + ($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|); my $formaction='/priv/'.$uname.'/'.$thisdisfn; $formaction=~s/\/+/\//g; unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm @@ -2678,13 +2819,21 @@ ENDROLE } my $titletable = ''. - ''.$roleinfo.'
'. + '
'. $titleinfo.'
'; - if ($ENV{'request.state'} eq 'construct') { - $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable); + if ($env{'request.state'} eq 'construct') { + if ($notopbar) { + $bodytag .= $titletable; + } else { + $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable); + } } else { - $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg). + if ($notopbar) { + $bodytag .= $titletable; + } else { + $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg). $titletable; + } } return $bodytag; } @@ -2696,6 +2845,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(< @@ -2705,13 +2865,13 @@ $upperleft -$titleinfo - +$titleinfo $dc_info + - $ENV{'environment.firstname'} - $ENV{'environment.middlename'} - $ENV{'environment.lastname'} - $ENV{'environment.generation'} + $env{'environment.firstname'} + $env{'environment.middlename'} + $env{'environment.lastname'} + $env{'environment.generation'}   @@ -2725,6 +2885,37 @@ 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=''; + $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag; + return $endbodytag; +} + +############################################### =pod @@ -2738,13 +2929,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'; } @@ -2812,8 +3003,9 @@ 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; @@ -2838,8 +3030,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; } @@ -2871,7 +3063,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'); @@ -2881,14 +3073,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 @@ -2901,8 +3093,7 @@ sub get_unprocessed_cgi { if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { $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) }; } } } @@ -2916,7 +3107,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 .=' @@ -2935,7 +3126,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); @@ -2944,6 +3135,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; } @@ -2959,7 +3151,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. @@ -2967,18 +3159,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; } } @@ -2986,7 +3178,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 @@ -2996,12 +3188,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); @@ -3019,25 +3211,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); } } @@ -3049,8 +3241,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 @@ -3059,13 +3251,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 @@ -3074,14 +3266,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; } } @@ -3089,30 +3286,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 { @@ -3130,7 +3332,7 @@ sub record_sep { $field=~s/^\s*$delimiter//; $field=~s/$delimiter\s*$//; } - $components{$i}=$field; + $components{&takeleft($i)}=$field; $i++; } } @@ -3239,7 +3441,7 @@ sub csv_print_select_table { $r->print(''); foreach (sort({$a <=> $b} keys(%sone))) { $r->print(''); } $r->print(''."\n"); @@ -3283,13 +3485,13 @@ sub csv_samples_select_table { foreach (@$d) { my ($value,$display,$defaultcol)=@{ $_ }; $r->print(''); } $r->print(''); - if (defined($sone{$_})) { $r->print($sone{$_}."
\n"); } - if (defined($stwo{$_})) { $r->print($stwo{$_}."
\n"); } - if (defined($sthree{$_})) { $r->print($sthree{$_}."
\n"); } + if (defined($sone{$_})) { $r->print($sone{$_}."
\n"); } + if (defined($stwo{$_})) { $r->print($stwo{$_}."
\n"); } + if (defined($sthree{$_})) { $r->print($sthree{$_}."
\n"); } $r->print(''); $i++; } @@ -3797,34 +3999,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; } @@ -3833,7 +4035,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); @@ -3844,20 +4046,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}) ]; } } @@ -3890,7 +4092,7 @@ sub icon { $curfext.".gif"; } } - return $iconname; + return &lonhttpdurl($iconname); } sub lonhttpdurl {