--- loncom/interface/loncommon.pm 2003/11/10 01:59:55 1.147
+++ loncom/interface/loncommon.pm 2005/03/10 00:21:48 1.255
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.147 2003/11/10 01:59:55 www Exp $
+# $Id: loncommon.pm,v 1.255 2005/03/10 00:21:48 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,13 +25,6 @@
#
# http://www.lon-capa.org/
#
-# YEAR=2001
-# 2/13-12/7 Guy Albertelli
-# 12/21 Gerd Kortemeyer
-# 12/25,12/28 Gerd Kortemeyer
-# YEAR=2002
-# 1/4 Gerd Kortemeyer
-# 6/24,7/2 H. K. Ng
# Makes a table out of the previous attempts
# Inputs result_from_symbread, user, domain, course_id
@@ -66,23 +59,21 @@ use Apache::lonnet();
use GDBM_File;
use POSIX qw(strftime mktime);
use Apache::Constants qw(:common :http :methods);
-use Apache::lonmsg();
use Apache::lonmenu();
use Apache::lonlocal;
use HTML::Entities;
my $readit;
-=pod
-
-=head1 Global Variables
-
-=cut
+##
+## Global Variables
+##
# ----------------------------------------------- Filetypes/Languages/Copyright
my %language;
my %supported_language;
my %cprtag;
+my %scprtag;
my %fe; my %fd;
my %category_extensions;
@@ -111,32 +102,48 @@ BEGIN {
unless ($readit) {
# ------------------------------------------------------------------- languages
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/language.tab');
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
- $language{$key}=$val.' - '.$enc;
- if ($sup) {
- $supported_language{$key}=$sup;
- }
- }
- }
+ my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/language.tab';
+ if ( open(my $fh,"<$langtabfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
+ $language{$key}=$val.' - '.$enc;
+ if ($sup) {
+ $supported_language{$key}=$sup;
+ }
+ }
+ close($fh);
+ }
}
# ------------------------------------------------------------------ copyrights
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
- '/copyright.tab');
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$val)=(split(/\s+/,$_,2));
- $cprtag{$key}=$val;
- }
- }
+ my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
+ '/copyright.tab';
+ if ( open (my $fh,"<$copyrightfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\s+/,$_,2));
+ $cprtag{$key}=$val;
+ }
+ close($fh);
+ }
+ }
+# ------------------------------------------------------------------ source copyrights
+ {
+ my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
+ '/source_copyright.tab';
+ if ( open (my $fh,"<$sourcecopyrightfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\s+/,$_,2));
+ $scprtag{$key}=$val;
+ }
+ close($fh);
+ }
}
# -------------------------------------------------------------- domain designs
@@ -147,15 +154,16 @@ BEGIN {
while ($filename=readdir(DIR)) {
my ($domain)=($filename=~/^(\w+)\./);
{
- my $fh=Apache::File->new($designdir.'/'.$filename);
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($key,$val)=(split(/\=/,$_));
- if ($val) { $designhash{$domain.'.'.$key}=$val; }
- }
- }
+ my $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);
+ }
}
}
@@ -164,32 +172,35 @@ BEGIN {
# ------------------------------------------------------------- file categories
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/filecategories.tab');
- if ($fh) {
- while (<$fh>) {
- next if /^\#/;
- chomp;
- my ($extension,$category)=(split(/\s+/,$_,2));
- push @{$category_extensions{lc($category)}},$extension;
- }
- }
+ my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filecategories.tab';
+ if ( open (my $fh,"<$categoryfile") ) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($extension,$category)=(split(/\s+/,$_,2));
+ push @{$category_extensions{lc($category)}},$extension;
+ }
+ close($fh);
+ }
+
}
# ------------------------------------------------------------------ file types
{
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
- '/filetypes.tab');
- if ($fh) {
+ my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
+ '/filetypes.tab';
+ if ( open (my $fh,"<$typesfile") ) {
while (<$fh>) {
- next if (/^\#/);
- chomp;
- my ($ending,$emb,$descr)=split(/\s+/,$_,3);
- if ($descr ne '') {
- $fe{$ending}=lc($emb);
- $fd{$ending}=$descr;
- }
- }
- }
+ next if (/^\#/);
+ chomp;
+ my ($ending,$emb,$descr)=split(/\s+/,$_,3);
+ if ($descr ne '') {
+ $fe{$ending}=lc($emb);
+ $fd{$ending}=$descr;
+ }
+ }
+ close($fh);
+ }
}
&Apache::lonnet::logthis(
"INFO: Read file types");
@@ -204,10 +215,6 @@ BEGIN {
=pod
-=head1 General Subroutines
-
-=over 4
-
=head1 HTML and Javascript Functions
=over 4
@@ -219,8 +226,6 @@ containing javascript with two functions
C. Returned string does not contain EscriptE
tags.
-=over 4
-
=item * openbrowser(formname,elementname,only,omit) [javascript]
inputs: formname, elementname, only, omit
@@ -229,10 +234,10 @@ formname and elementname indicate the na
the element that the results of the browsing selection are to be placed in.
Specifying 'only' will restrict the browser to displaying only files
-with the given extension. Can be a comma seperated list.
+with the given extension. Can be a comma separated list.
Specifying 'omit' will restrict the browser to NOT displaying files
-with the given extension. Can be a comma seperated list.
+with the given extension. Can be a comma separated list.
=item * opensearcher(formname, elementname) [javascript]
@@ -241,33 +246,41 @@ Inputs: formname, elementname
formname and elementname specify the name of the html form and the name
of the element the selection from the search results will be placed in.
-=back
-
=cut
sub browser_and_searcher_javascript {
+ my ($mode)=@_;
+ if (!defined($mode)) { $mode='edit'; }
+ my $resurl=&lastresurl();
return <
END
}
+sub lastresurl {
+ if ($ENV{'environment.lastresurl'}) {
+ return $ENV{'environment.lastresurl'}
+ } else {
+ return '/res';
+ }
+}
+
+sub storeresurl {
+ my $resurl=&Apache::lonnet::clutter(shift);
+ unless ($resurl=~/^\/res/) { return 0; }
+ $resurl=~s/\/$//;
+ &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
+ &Apache::lonnet::appenv('environment.lastresurl' => $resurl);
+ return 1;
+}
+
sub studentbrowser_javascript {
unless (
(($ENV{'request.course.id'}) &&
@@ -346,7 +379,7 @@ sub coursebrowser_javascript {
return (<
var stdeditbrowser;
- function opencrsbrowser(formname,uname,udom) {
+ function opencrsbrowser(formname,uname,udom,desc,extra_element) {
var url = '/adm/pickcourse?';
var filter;
if (filter != null) {
@@ -361,7 +394,14 @@ sub coursebrowser_javascript {
}
}
url += 'form=' + formname + '&cnumelement='+uname+
- '&cdomelement='+udom;
+ '&cdomelement='+udom+
+ '&cnameelement='+desc;
+ 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';
options += ',width=700,height=600';
@@ -373,9 +413,9 @@ ENDSTDBRW
}
sub selectcourse_link {
- my ($form,$unameele,$udomele)=@_;
+ my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
return "".&mt('Select Course')."";
+ '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."";
}
=pod
@@ -458,7 +498,7 @@ sub linked_select_forms {
my $first = "document.$formname.$firstselectname";
# output the javascript to do the changing
my $result = '';
- $result.="
+
+ENDTEMPLATE
+ if ($component_help) {
+ if (!$text) {
+ $template=&help_open_topic($component_help,undef,$stayOnPage,
+ $width,$height).' '.$template;
+ } else {
+ my $help_text;
+ $help_text=&Apache::lonnet::unescape($topic);
+ $template='
+
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='';
+ if ($ENV{'environment.texengine'} eq 'jsMath') {
+ $endbodytag=''.
+ "\n".$endbodytag;
+ }
+ return $endbodytag;
+}
+
+###############################################
+
+=pod
+
+=item get_users_function
+
+Used by &bodytag to determine the current users primary role.
+Returns either 'student','coordinator','admin', or 'author'.
+
+=cut
+
+###############################################
+sub get_users_function {
+ my $function = 'student';
+ if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
+ $function='coordinator';
+ }
+ if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
+ $function='admin';
+ }
+ if (($ENV{'request.role'}=~/^(au|ca)/) ||
+ ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
+ $function='author';
+ }
+ return $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;
@@ -2304,12 +3028,12 @@ returns cache-controlling header code
=cut
sub cacheheader {
- unless ($ENV{'request.method'} eq 'GET') { return ''; }
- my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
- my $output .='
+ unless ($ENV{'request.method'} eq 'GET') { return ''; }
+ my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
+ my $output .='
';
- return $output;
+ return $output;
}
=pod
@@ -2321,20 +3045,27 @@ specifies header code to not have cache
=cut
sub no_cache {
- my ($r) = @_;
- unless ($ENV{'request.method'} eq 'GET') { return ''; }
- #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
- $r->no_cache(1);
- $r->header_out("Pragma" => "no-cache");
- #$r->header_out("Expires" => $date);
+ my ($r) = @_;
+ if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
+ $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);
+ $r->header_out("Pragma" => "no-cache");
}
sub content_type {
- my ($r,$type,$charset) = @_;
- unless ($charset) {
- $charset=&Apache::lonlocal::current_encoding;
- }
- $r->content_type($type.($charset?'; charset='.$charset:''));
+ my ($r,$type,$charset) = @_;
+ if ($ENV{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
+ unless ($charset) {
+ $charset=&Apache::lonlocal::current_encoding;
+ }
+ if ($charset) { $type.='; charset='.$charset; }
+ if ($r) {
+ $r->content_type($type);
+ } else {
+ print("Content-type: $type\n\n");
+ }
}
=pod
@@ -2366,6 +3097,32 @@ sub add_to_env {
=pod
+=item * get_env_multiple($name)
+
+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
+
+=cut
+
+sub get_env_multiple {
+ my ($name) = @_;
+ my @values;
+ if (defined($ENV{$name})) {
+ # exists is it an array
+ if (ref($ENV{$name})) {
+ @values=@{ $ENV{$name} };
+ } else {
+ $values[0]=$ENV{$name};
+ }
+ }
+ return(@values);
+}
+
+
+=pod
+
=back
=head1 CSV Upload/Handling functions
@@ -2390,9 +3147,12 @@ sub upfile_store {
my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
'_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
{
- my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
- '/tmp/'.$datatoken.'.tmp');
- print $fh $ENV{'form.upfile'};
+ my $datafile = $r->dir_config('lonDaemons').
+ '/tmp/'.$datatoken.'.tmp';
+ if ( open(my $fh,">$datafile") ) {
+ print $fh $ENV{'form.upfile'};
+ close($fh);
+ }
}
return $datatoken;
}
@@ -2411,11 +3171,12 @@ sub load_tmp_file {
my $r=shift;
my @studentdata=();
{
- my $fh;
- if ($fh=Apache::File->new($r->dir_config('lonDaemons').
- '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
- @studentdata=<$fh>;
- }
+ my $studentfile = $r->dir_config('lonDaemons').
+ '/tmp/'.$ENV{'form.datatoken'}.'.tmp';
+ if ( open(my $fh,"<$studentfile") ) {
+ @studentdata=<$fh>;
+ close($fh);
+ }
}
$ENV{'form.upfile'}=join('',@studentdata);
}
@@ -2433,7 +3194,12 @@ needs $ENV{'form.upfile'} and $ENV{'form
sub upfile_record_sep {
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;
}
}
@@ -2460,7 +3226,7 @@ sub record_sep {
}
} elsif ($ENV{'form.upfiletype'} eq 'tab') {
my $i=0;
- foreach (split(/\t+/,$record)) {
+ foreach (split(/\t/,$record)) {
my $field=$_;
$field=~s/^(\"|\')//;
$field=~s/(\"|\')$//;
@@ -2568,7 +3334,7 @@ Prints a table to create associations be
$r is an Apache Request ref,
$records is an arrayref from &Apache::loncommon::upfile_record_sep,
-$d is an array of 2 element arrays (internal name, displayed name)
+$d is an array of 2 element arrays (internal name, displayed name,defaultcol)
=cut
@@ -2583,14 +3349,16 @@ sub csv_print_select_table {
'
'.&mt('Attribute').'
'.
'
'.&mt('Column').'
'."\n");
foreach (@$d) {
- my ($value,$display)=@{ $_ };
+ my ($value,$display,$defaultcol)=@{ $_ };
$r->print('
'.$display.'
');
$r->print('
'."\n");
$i++;
@@ -2631,8 +3399,10 @@ sub csv_samples_select_table {
$r->print('
');
if (defined($sone{$_})) { $r->print($sone{$_}."\n"); }
@@ -2704,8 +3474,12 @@ sub check_if_partid_hidden {
=pod
+=back
+
=head1 cgi-bin script and graphing routines
+=over 4
+
=item get_cgi_id
Inputs: none
@@ -2719,9 +3493,10 @@ the routine &Apache::lonnet::transfer_pr
############################################################
############################################################
-
+my $uniq=0;
sub get_cgi_id {
- return (time.'_'.int(rand(1000)));
+ $uniq=($uniq+1)%100000;
+ return (time.'_'.$uniq);
}
############################################################
@@ -2752,9 +3527,14 @@ If $Max is < any data point, the graph w
=item $colors: array ref holding the colors to be used for the data sets when
they are plotted. If undefined, default values will be used.
+=item $labels: array ref holding the labels to use on the x-axis for the bars.
+
=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:
@@ -2767,7 +3547,7 @@ information for the plot.
############################################################
############################################################
sub DrawBarGraph {
- my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_;
+ my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
#
if (! defined($colors)) {
$colors = ['#33ff00',
@@ -2775,13 +3555,28 @@ sub DrawBarGraph {
'#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
];
}
+ my $extra_settings = {};
+ if (ref($Values[-1]) eq 'HASH') {
+ $extra_settings = pop(@Values);
+ }
#
my $identifier = &get_cgi_id();
my $id = 'cgi.'.$identifier;
if (! @Values || ref($Values[0]) ne 'ARRAY') {
return '';
}
+ #
+ my @Labels;
+ if (defined($labels)) {
+ @Labels = @$labels;
+ } else {
+ for (my $i=0;$i<@{$Values[0]};$i++) {
+ push (@Labels,$i+1);
+ }
+ }
+ #
my $NumBars = scalar(@{$Values[0]});
+ if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
my %ValuesHash;
my $NumSets=1;
foreach my $array (@Values) {
@@ -2791,7 +3586,15 @@ sub DrawBarGraph {
}
#
my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
- if ($NumBars < 10) {
+ if ($NumBars < 3) {
+ $width = 120+$NumBars*32;
+ $xskip = 1;
+ $bar_width = 30;
+ } elsif ($NumBars < 5) {
+ $width = 120+$NumBars*20;
+ $xskip = 1;
+ $bar_width = 20;
+ } elsif ($NumBars < 10) {
$width = 120+$NumBars*15;
$xskip = 1;
$bar_width = 15;
@@ -2809,11 +3612,6 @@ sub DrawBarGraph {
$bar_width = 4;
}
#
- my @Labels;
- for (my $i=0;$i<@{$Values[0]};$i++) {
- push (@Labels,$i+1);
- }
- #
$Max = 1 if ($Max < 1);
if ( int($Max) < $Max ) {
$Max++;
@@ -2836,6 +3634,11 @@ sub DrawBarGraph {
$ValuesHash{$id.'.bar_width'} = $bar_width;
$ValuesHash{$id.'.labels'} = join(',',@Labels);
#
+ # Deal with other parameters
+ while (my ($key,$value) = each(%$extra_settings)) {
+ $ValuesHash{$id.'.'.$key} = $value;
+ }
+ #
&Apache::lonnet::appenv(%ValuesHash);
return '';
}
@@ -2870,7 +3673,7 @@ plotted in. If undefined, default value
=item $Xlabels: Array ref containing the labels to be used for the X-axis.
=item $Ydata: Array ref containing Array refs.
-Each of the contained arrays will be plotted as a seperate curve.
+Each of the contained arrays will be plotted as a separate curve.
=item %Values: hash indicating or overriding any default values which are
passed to graph.png.
@@ -3037,10 +3840,14 @@ sub DrawXYYGraph {
=pod
+=back
+
=head1 Statistics helper routines?
Bad place for them but what the hell.
+=over 4
+
=item &chartlink
Returns a link to the chart for a specific student.
@@ -3057,6 +3864,8 @@ Inputs:
=back
+=back
+
=cut
############################################################
@@ -3064,14 +3873,183 @@ Inputs:
sub chartlink {
my ($linktext, $sname, $sdomain) = @_;
my $link = ''.$linktext.'';
}
+#######################################################
+#######################################################
+
+=pod
+
+=head1 Course Environment Routines
+
+=over 4
+
+=item &restore_course_settings
+
+=item &store_course_settings
+
+Restores/Store indicated form parameters from the course environment.
+Will not overwrite existing values of the form parameters.
+
+Inputs:
+a scalar describing the data (e.g. 'chart', 'problem_analysis')
+
+a hash ref describing the data to be stored. For example:
+
+%Save_Parameters = ('Status' => 'scalar',
+ 'chartoutputmode' => 'scalar',
+ 'chartoutputdata' => 'scalar',
+ 'Section' => 'array',
+ 'StudentData' => 'array',
+ 'Maps' => 'array');
+
+Returns: both routines return nothing
+
+=cut
+
+#######################################################
+#######################################################
+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 ($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})) {
+ # 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};
+ } elsif ($type eq 'array') {
+ my $stored_form;
+ if (ref($ENV{'form.'.$setting})) {
+ $stored_form = join(',',
+ map {
+ &Apache::lonnet::escape($_);
+ } sort(@{$ENV{'form.'.$setting}}));
+ } else {
+ $stored_form =
+ &Apache::lonnet::escape($ENV{'form.'.$setting});
+ }
+ # Determine if the array contents are the same.
+ if ($stored_form ne $ENV{$envname}) {
+ $SaveHash{$basename} = $stored_form;
+ $AppHash{$envname} = $stored_form;
+ }
+ }
+ }
+ }
+ my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
+ $coursedom,
+ $ENV{'course.'.$courseid.'.num'});
+ if ($put_result !~ /^(ok|delayed)/) {
+ &Apache::lonnet::logthis('unable to save form parameters, '.
+ 'got error:'.$put_result);
+ }
+ # Make sure these settings stick around in this session, too
+ &Apache::lonnet::appenv(%AppHash);
+ return;
+}
+
+sub restore_course_settings {
+ my $courseid = $ENV{'request.course.id'};
+ my ($prefix,$Settings) = @_;
+ while (my ($setting,$type) = each(%$Settings)) {
+ next if (exists($ENV{'form.'.$setting}));
+ my $envname = 'course.'.$courseid.'.internal.'.$prefix.
+ '.'.$setting;
+ if (exists($ENV{$envname})) {
+ if ($type eq 'scalar') {
+ $ENV{'form.'.$setting} = $ENV{$envname};
+ } elsif ($type eq 'array') {
+ $ENV{'form.'.$setting} = [
+ map {
+ &Apache::lonnet::unescape($_);
+ } split(',',$ENV{$envname})
+ ];
+ }
+ }
+ }
+}
+
############################################################
############################################################
+sub propath {
+ my ($udom,$uname)=@_;
+ $udom=~s/\W//g;
+ $uname=~s/\W//g;
+ my $subdir=$uname.'__';
+ $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+ my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
+ return $proname;
+}
+
+sub icon {
+ my ($file)=@_;
+ my $curfext = (split(/\./,$file))[-1];
+ my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
+ my $embstyle = &Apache::loncommon::fileembstyle($curfext);
+ if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
+ if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
+ $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
+ $curfext.".gif") {
+ $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
+ $curfext.".gif";
+ }
+ }
+ return &lonhttpdurl($iconname);
+}
+
+sub lonhttpdurl {
+ my ($url)=@_;
+ my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
+ if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
+ return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
+}
+
+sub connection_aborted {
+ my ($r)=@_;
+ $r->print(" ");$r->rflush();
+ my $c = $r->connection;
+ return $c->aborted();
+}
+
+# Escapes strings that may have embedded 's that will be put into
+# strings as 'strings'.
+sub escape_single {
+ my ($input) = @_;
+ $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
+ $input =~ s/\'/\\\'/g; # Esacpe the 's....
+ return $input;
+}
+
+# Same as escape_single, but escape's "'s This
+# can be used for "strings"
+sub escape_double {
+ my ($input) = @_;
+ $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
+ $input =~ s/\"/\\\"/g; # Esacpe the "s....
+ return $input;
+}
+
+# Escapes the last element of a full URL.
+sub escape_url {
+ my ($url) = @_;
+ my @urlslices = split(/\//, $url,-1);
+ my $lastitem = &Apache::lonnet::escape(pop(@urlslices));
+ return join('/',@urlslices).'/'.$lastitem;
+}
=pod
=back