--- loncom/interface/loncommon.pm 2003/11/04 21:21:35 1.143 +++ loncom/interface/loncommon.pm 2003/11/17 15:14:48 1.155 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.143 2003/11/04 21:21:35 matthew Exp $ +# $Id: loncommon.pm,v 1.155 2003/11/17 15:14:48 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -91,50 +91,19 @@ my %category_extensions; my %designhash; # ---------------------------------------------- Thesaurus variables - -# FIXME: I don't think it's necessary to document these things; -# they're privately used - Jeremy - -=pod - -=over 4 - -=item * %Keywords - -A hash used by &keyword to determine if a word is considered a keyword. - -=item * $thesaurus_db_file - -Scalar containing the full path to the thesaurus database. - -=back - -=cut +# +# %Keywords: +# A hash used by &keyword to determine if a word is considered a keyword. +# $thesaurus_db_file +# Scalar containing the full path to the thesaurus database. my %Keywords; my $thesaurus_db_file; -# ----------------------------------------------------------------------- BEGIN - -# FIXME: I don't think this needs to be documented, it prepares -# private data structures - Jeremy -=pod - -=head1 General Subroutines - -=over 4 - -=item * BEGIN() - -Initialize values from language.tab, copyright.tab, filetypes.tab, -thesaurus.tab, and filecategories.tab. - -=back - -=cut - -# ----------------------------------------------------------------------- BEGIN - +# +# Initialize values from language.tab, copyright.tab, filetypes.tab, +# thesaurus.tab, and filecategories.tab. +# BEGIN { # Variable initialization $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db"; @@ -235,6 +204,10 @@ BEGIN { =pod +=head1 General Subroutines + +=over 4 + =head1 HTML and Javascript Functions =over 4 @@ -1088,10 +1061,10 @@ END sub authform_authorwarning{ my $result=''; - $result=<<"END"; -As a general rule, only authors or co-authors should be filesystem -authenticated (which allows access to the server filesystem). -END + $result=''. + &mt('As a general rule, only authors or co-authors should be '. + 'filesystem authenticated '. + '(which allows access to the server filesystem).')."\n"; return $result; } @@ -1101,12 +1074,10 @@ sub authform_nochange{ kerb_def_dom => 'MSU.EDU', @_, ); - my $result=''; - $result.=<<"END"; - -Do not change login data -END + my $result = &mt('[_1] Do not change login data', + ''); return $result; } @@ -1117,24 +1088,23 @@ sub authform_kerberos{ kerb_def_auth => 'krb4', @_, ); - my $result=''; - my $check4; - my $check5; + my ($check4,$check5); if ($in{'kerb_def_auth'} eq 'krb5') { $check5 = " checked=\"on\""; } else { $check4 = " checked=\"on\""; } - $result.=<<"END"; - -Kerberos authenticated with domain - -Version 4 -Version 5 -END + my $jscall = "javascript:changed_radio('krb',$in{'formname'});"; + my $result .= &mt + ('[_1] Kerberos authenticated with domain [_2] '. + '[_3] Version 4 [_4] Version 5', + '', + '', + '', + ''); return $result; } @@ -1144,15 +1114,13 @@ sub authform_internal{ kerb_def_dom => 'MSU.EDU', @_, ); - my $result=''; - $result.=<<"END"; - -Internally authenticated (with initial password -) -END + my $jscall = "javascript:changed_radio('int',$args{'formname'});"; + my $result.=&mt + ('[_1] Internally authenticated (with initial password [_2])', + '', + ''); return $result; } @@ -1162,15 +1130,12 @@ sub authform_local{ kerb_def_dom => 'MSU.EDU', @_, ); - my $result=''; - $result.=<<"END"; - -Local Authentication with argument - -END + my $jscall = "javascript:changed_radio('loc',$in{'formname'});"; + my $result.=&mt('[_1] Local Authentication with arguement [_2]', + '', + ''); return $result; } @@ -1180,15 +1145,13 @@ sub authform_filesystem{ kerb_def_dom => 'MSU.EDU', @_, ); - my $result=''; - $result.=<<"END"; - -Filesystem authenticated (with initial password -) -END + my $jscall = "javascript:changed_radio('fsys',$in{'formname'});"; + my $result.= &mt + ('[_1] Filesystem Authenticated (with initial password [_2])', + '', + ''); return $result; } @@ -1536,6 +1499,16 @@ sub languagedescription { ($supported_language{$code}?' ('.&mt('interface available').')':''); } +sub plainlanguagedescription { + my $code=shift; + return $language{$code}; +} + +sub supportedlanguagecode { + my $code=shift; + return $supported_language{$code}; +} + =pod =item * copyrightids() @@ -2034,7 +2007,7 @@ sub domainlogo { my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } return ''; + '/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />'; } elsif(exists($Apache::lonnet::domaindescription{$domain})) { return $Apache::lonnet::domaindescription{$domain}; } else { @@ -2145,8 +2118,9 @@ sub bodytag { my $sidebg=&designparm($function.'.sidebg',$domain); # Accessibility font enhance unless ($addentries) { $addentries=''; } + my $addstyle=''; if ($ENV{'browser.fontenhance'} eq 'on') { - $addentries.=' style="font-size: x-large"'; + $addstyle=' font-size: x-large;'; } # role and realm my ($role,$realm) @@ -2164,11 +2138,15 @@ sub bodytag { if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } # construct main body tag my $bodytag = < +h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif } +a:focus { color: red; background: yellow } + +style="margin-top: 0px;$addstyle" $addentries> END my $upperleft=''; + $lonhttpdPort.$img.'" alt="'.$function.'" />'; if ($bodyonly) { return $bodytag; } elsif ($ENV{'browser.interface'} eq 'textual') { @@ -2180,7 +2158,7 @@ END # No Remote return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', $forcereg). - ' - +
'.$title. + '
'.$title. '
'; } @@ -2196,9 +2174,9 @@ $upperleft
- $title - - + $title + + $ENV{'environment.firstname'} $ENV{'environment.middlename'} $ENV{'environment.lastname'} @@ -2207,10 +2185,10 @@ $upperleft
-$role  +$role 
$realm 
$realm 

ENDBODY } @@ -2387,6 +2365,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 @@ -2510,26 +2514,39 @@ sub record_sep { return %components; } +###################################################### +###################################################### + =pod =item * upfile_select_html() -return HTML code to select file and specify its type +Return HTML code to select a file from the users machine and specify +the file type. =cut +###################################################### +###################################################### sub upfile_select_html { - return (<<'ENDUPFORM'); - -
Type: -ENDUPFORM + my %Types = ( + csv => &mt('CSV (comma separated values, spreadsheet)'), + space => &mt('Space separated'), + tab => &mt('Tabulator separated'), +# xml => &mt('HTML/XML'), + ); + my $Str = ''. + '
Type: \n"; + return $Str; } +###################################################### +###################################################### + =pod =item * csv_print_samples($r,$records) @@ -2540,15 +2557,18 @@ Apache Request ref, $records is an array =cut +###################################################### +###################################################### sub csv_print_samples { my ($r,$records) = @_; my (%sone,%stwo,%sthree); %sone=&record_sep($$records[0]); if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} - - $r->print('Samples
'); - foreach (sort({$a <=> $b} keys(%sone))) { $r->print(''); } + # + $r->print(&mt('Samples').'
Column '.($_+1).'
'); + foreach (sort({$a <=> $b} keys(%sone))) { + $r->print(''); } $r->print(''); foreach my $hash (\%sone,\%stwo,\%sthree) { $r->print(''); @@ -2562,23 +2582,31 @@ sub csv_print_samples { $r->print('
'.&mt('Column [_1]',($_+1)).'

'."\n"); } +###################################################### +###################################################### + =pod =item * csv_print_select_table($r,$records,$d) Prints a table to create associations between values and table columns. + $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) =cut +###################################################### +###################################################### sub csv_print_select_table { my ($r,$records,$d) = @_; my $i=0;my %sone; %sone=&record_sep($$records[0]); - $r->print('Associate columns with student attributes.'."\n". - ''."\n"); + $r->print(&mt('Associate columns with student attributes.')."\n". + '
AttributeColumn
'. + ''. + ''."\n"); foreach (@$d) { my ($value,$display)=@{ $_ }; $r->print(''); @@ -2596,6 +2624,9 @@ sub csv_print_select_table { return $i; } +###################################################### +###################################################### + =pod =item * csv_samples_select_table($r,$records,$d) @@ -2608,22 +2639,25 @@ $d is an array of 2 element arrays (inte =cut +###################################################### +###################################################### sub csv_samples_select_table { my ($r,$records,$d) = @_; my %sone; my %stwo; my %sthree; my $i=0; - - $r->print('
'.&mt('Attribute').''.&mt('Column').'
'.$display.'
'); + # + $r->print('
FieldSamples
'); %sone=&record_sep($$records[0]); if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} - + # foreach (sort keys %sone) { - $r->print('
'. + &mt('Field').''.&mt('Samples').'
'); if (defined($sone{$_})) { $r->print($sone{$_}."
\n"); } @@ -2636,6 +2670,9 @@ sub csv_samples_select_table { return($i); } +###################################################### +###################################################### + =pod =item clean_excel_name($name) @@ -2644,6 +2681,8 @@ Returns a replacement for $name which do =cut +###################################################### +###################################################### sub clean_excel_name { my ($name) = @_; $name =~ s/[:\*\?\/\\]//g; @@ -2705,9 +2744,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); } ############################################################ @@ -3055,9 +3095,121 @@ sub chartlink { '">'.$linktext.''; } +####################################################### +####################################################### + +=pod + +=head1 Course Environment Routines + +=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 = 'env.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.'.env.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; +} + =pod =back