--- loncom/interface/loncommon.pm 2008/10/02 14:05:45 1.689
+++ loncom/interface/loncommon.pm 2009/10/28 17:24:32 1.692.2.13
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.689 2008/10/02 14:05:45 bisitz Exp $
+# $Id: loncommon.pm,v 1.692.2.13 2009/10/28 17:24:32 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -677,7 +677,7 @@ sub select_datelocale {
if ($id ne '') {
my $en_terr = $locale->{'en_territory'};
my $native_terr = $locale->{'native_territory'};
- my @languages = &preferred_languages();
+ my @languages = &Apache::lonlocal::preferred_languages();
if (grep(/^en$/,@languages) || !@languages) {
if ($en_terr ne '') {
$locale_names{$id} = '('.$en_terr.')';
@@ -926,7 +926,7 @@ sub help_open_topic {
if ($text ne "") {
$template .=
"".
- "$text $text
' };
+ if ($text ne '') { $template.='' };
return $template;
}
@@ -943,24 +943,30 @@ ENDTEMPLATE
# This is a quicky function for Latex cheatsheet editing, since it
# appears in at least four places
sub helpLatexCheatsheet {
- my $other = shift;
+ my ($topic,$text,$not_author) = @_;
+ my $out;
my $addOther = '';
- if ($other) {
- $addOther = Apache::loncommon::help_open_topic($other, shift,
- undef, undef, 600) .
- '';
- }
- return ''.
- $addOther .
- &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
- undef,undef,600)
- .' '.
- &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
- undef,undef,600)
- .' '.
- &Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
- undef,undef,600)
- .'
';
+ if ($topic) {
+ $addOther = Apache::loncommon::help_open_topic($topic,$text,
+ undef, undef, 600).
+ ' ';
+ }
+ $out = ''.
+ $addOther.
+ &Apache::loncommon::help_open_topic("Greek_Symbols",&mt('Greek Symbols'),
+ undef,undef,600).
+ ' '.
+ &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'),
+ undef,undef,600).
+ ' ';
+ unless ($not_author) {
+ $out .= ''.
+ &Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'),
+ undef,undef,600).
+ ' ';
+ }
+ $out .= '
';
+ return $out;
}
sub general_help {
@@ -1740,7 +1746,7 @@ sub select_level_form {
=pod
-=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc)
+=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$change)
Returns a string containing a form to
allow a user to select the domain to preform an operation in.
@@ -1749,16 +1755,21 @@ See loncreateuser.pm for an example invo
If the $includeempty flag is set, it also includes an empty choice ("no domain
selected");
-If the $showdomdesc flag is set, the domain name is followed by the domain description.
+If the $showdomdesc flag is set, the domain name is followed by the domain description.
+
+The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
=cut
#-------------------------------------------
sub select_dom_form {
- my ($defdom,$name,$includeempty,$showdomdesc) = @_;
+ my ($defdom,$name,$includeempty,$showdomdesc,$onchange) = @_;
+ if ($onchange) {
+ $onchange = ' onchange="'.$onchange.'"';
+ }
my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
if ($includeempty) { @domains=('',@domains); }
- my $selectdomain = "\n";
+ my $selectdomain = "\n";
foreach my $dom (@domains) {
$selectdomain.="'.$dom;
@@ -2717,6 +2728,42 @@ sub flush_email_cache {
&Apache::lonnet::devalidate_cache_new('emailscache',$id);
}
+# -------------------------------------------------------------------- getlangs
+
+=pod
+
+=item * &getlangs($uname,$udom)
+
+Gets a user's language preference and returns it as a hash with key:
+language.
+
+=cut
+
+sub getlangs {
+ my ($uname,$udom) = @_;
+ if (!$udom) { $udom =$env{'user.domain'}; }
+ if (!$uname) { $uname=$env{'user.name'}; }
+ my $id=$uname.':'.$udom;
+ my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
+ if ($cached) {
+ return %{$langs};
+ } else {
+ my %loadlangs=&Apache::lonnet::get('environment',['languages'],
+ $udom,$uname);
+ &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
+ return %loadlangs;
+ }
+}
+
+sub flush_langs_cache {
+ my ($uname,$udom)=@_;
+ if (!$udom) { $udom =$env{'user.domain'}; }
+ if (!$uname) { $uname=$env{'user.name'}; }
+ return if ($udom eq 'public' && $uname eq 'public');
+ my $id=$uname.':'.$udom;
+ &Apache::lonnet::devalidate_cache_new('userlangs',$id);
+}
+
# ------------------------------------------------------------------ Screenname
=pod
@@ -2998,7 +3045,7 @@ sub fileextensions {
sub display_languages {
my %languages=();
- foreach my $lang (&preferred_languages()) {
+ foreach my $lang (&Apache::lonlocal::preferred_languages()) {
$languages{$lang}=1;
}
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
@@ -3010,59 +3057,9 @@ sub display_languages {
return %languages;
}
-sub preferred_languages {
- my @languages=();
- if (($env{'request.role.adv'}) && ($env{'form.languages'})) {
- @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$env{'form.languages'}));
- }
- if ($env{'course.'.$env{'request.course.id'}.'.languages'}) {
- @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
- $env{'course.'.$env{'request.course.id'}.'.languages'}));
- }
-
- if ($env{'environment.languages'}) {
- @languages=(@languages,
- split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'}));
- }
- my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'};
- if ($browser) {
- my @browser =
- map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser));
- push(@languages,@browser);
- }
-
- foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'},
- $Apache::lonnet::perlvar{'lonDefDomain'}) {
- if ($domtype ne '') {
- my %domdefs = &Apache::lonnet::get_domain_defaults($domtype);
- if ($domdefs{'lang_def'} ne '') {
- push(@languages,$domdefs{'lang_def'});
- }
- }
- }
- return &get_genlanguages(@languages);
-}
-
-sub get_genlanguages {
- my (@languages) = @_;
-# turn "en-ca" into "en-ca,en"
- my @genlanguages;
- foreach my $lang (@languages) {
- unless ($lang=~/\w/) { next; }
- push(@genlanguages,$lang);
- if ($lang=~/(\-|\_)/) {
- push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
- }
- }
- #uniqueify the languages list
- my %count;
- @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages;
- return @genlanguages;
-}
-
sub languages {
my ($possible_langs) = @_;
- my @preferred_langs = &preferred_languages();
+ my @preferred_langs = &Apache::lonlocal::preferred_languages();
if (!ref($possible_langs)) {
if( wantarray ) {
return @preferred_langs;
@@ -3221,7 +3218,7 @@ sub relative_to_absolute {
}
$thisdir=~s-/[^/]*$--;
foreach my $link (@rlinks) {
- unless (($link=~/^http:\/\//i) ||
+ unless (($link=~/^https?\:\/\//i) ||
($link=~/^\//) ||
($link=~/^javascript:/i) ||
($link=~/^mailto:/i) ||
@@ -3930,7 +3927,14 @@ sub get_domainconf {
if (ref($domconfig{'login'}) eq 'HASH') {
if (keys(%{$domconfig{'login'}})) {
foreach my $key (keys(%{$domconfig{'login'}})) {
- $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
+ if (ref($domconfig{'login'}{$key}) eq 'HASH') {
+ foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
+ $designhash{$udom.'.login.'.$key.'_'.$img} =
+ $domconfig{'login'}{$key}{$img};
+ }
+ } else {
+ $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
+ }
}
} else {
$legacy{'login'} = 1;
@@ -4641,7 +4645,7 @@ table#LC_mainmenu td.LC_mainmenu_column
.LC_menubuttons_link {
text-decoration: none;
}
-#2008--9-5: new menu style sheet.Changed category
+/*2008--9-5: new menu style sheet.Changed category*/
.LC_menubuttons_category {
color: $font;
background: $pgbg;
@@ -4712,6 +4716,10 @@ td.LC_menubuttons_img {
font-size: smaller;
}
+.LC_mail_functions {
+ font-weight: bold;
+}
+
table.LC_aboutme_port {
border: 0px;
border-collapse: collapse;
@@ -4744,6 +4752,11 @@ table.LC_prior_tries tr th {
background-color: $data_table_head;
font-size: smaller;
}
+table.LC_data_table tr.LC_info_row > td {
+ background-color: #CCC;
+ font-weight: bold;
+ text-align: left;
+}
table.LC_data_table tr.LC_odd_row > td,
table.LC_aboutme_port tr td {
background-color: $data_table_light;
@@ -5520,6 +5533,11 @@ fieldset#LC_mainmenu_fieldset {
margin:0px 10px 10px 0px;
}
+
+div.LC_createcourse {
+ margin: 10px 10px 10px 10px;
+}
+
END
}
@@ -6550,19 +6568,35 @@ sub default_quota {
if ($inststatus ne '') {
my @statuses = split(/:/,$inststatus);
foreach my $item (@statuses) {
- if ($quotahash{'quotas'}{$item} ne '') {
- if ($defquota eq '') {
- $defquota = $quotahash{'quotas'}{$item};
- $settingstatus = $item;
- } elsif ($quotahash{'quotas'}{$item} > $defquota) {
- $defquota = $quotahash{'quotas'}{$item};
- $settingstatus = $item;
+ if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
+ if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
+ if ($defquota eq '') {
+ $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
+ $settingstatus = $item;
+ } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
+ $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
+ $settingstatus = $item;
+ }
+ }
+ } else {
+ if ($quotahash{'quotas'}{$item} ne '') {
+ if ($defquota eq '') {
+ $defquota = $quotahash{'quotas'}{$item};
+ $settingstatus = $item;
+ } elsif ($quotahash{'quotas'}{$item} > $defquota) {
+ $defquota = $quotahash{'quotas'}{$item};
+ $settingstatus = $item;
+ }
}
}
}
}
if ($defquota eq '') {
- $defquota = $quotahash{'quotas'}{'default'};
+ if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
+ $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
+ } else {
+ $defquota = $quotahash{'quotas'}{'default'};
+ }
$settingstatus = 'default';
}
} else {
@@ -9043,7 +9077,9 @@ sub construct_course {
'policy.email',
'comment.email',
'pch.users.denied',
- 'plc.users.denied'],
+ 'plc.users.denied',
+ 'hidefromcat',
+ 'categories'],
$$crsudom,$$crsunum);
}
@@ -9271,10 +9307,10 @@ sub construct_course {
$outcome .= ($fatal?$errtext:'read ok').' - ';
my $title; my $url;
if ($args->{'firstres'} eq 'syl') {
- $title='Syllabus';
+ $title=&mt('Syllabus');
$url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
} else {
- $title='Navigate Contents';
+ $title=&mt('Navigate Contents');
$url='/adm/navmaps';
}
@@ -9328,28 +9364,14 @@ sub icon {
return &lonhttpdurl($iconname);
}
-sub lonhttpd_port {
- my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
- if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
- # IE doesn't like a secure page getting images from a non-secure
- # port (when logging we haven't parsed the browser type so default
- # back to secure
- if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer')
- && $ENV{'SERVER_PORT'} == 443) {
- return 443;
- }
- return $lonhttpd_port;
-
-}
-
sub lonhttpdurl {
+#
+# Had been used for "small fry" static images on separate port 8080.
+# Modify here if lightweight http functionality desired again.
+# Currently eliminated due to increasing firewall issues.
+#
my ($url)=@_;
-
- my $lonhttpd_port = &lonhttpd_port();
- if ($lonhttpd_port == 443) {
- return 'https://'.$ENV{'SERVER_NAME'}.$url;
- }
- return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
+ return $url;
}
sub connection_aborted {
@@ -9515,6 +9537,11 @@ sub init_user_environment {
}
}
+ foreach my $tool ('aboutme','blog','portfolio') {
+ $userenv{'availabletools.'.$tool} =
+ &Apache::lonnet::usertools_access($username,$domain,$tool,'reload');
+ }
+
$env{'user.environment'} = "$lonids/$cookie.id";
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
@@ -9553,7 +9580,7 @@ sub _add_to_env {
# --- Get the symbolic name of a problem and the url
sub get_symb {
my ($request,$silent) = @_;
- (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
+ (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
if ($symb eq '') {
if (!$silent) {
@@ -9580,11 +9607,13 @@ sub get_annotation {
}
sub clean_symb {
- my ($symb) = @_;
+ my ($symb,$delete_enc) = @_;
&Apache::lonenc::check_decrypt(\$symb);
my $enc = $env{'request.enc'};
- delete($env{'request.enc'});
+ if ($delete_enc) {
+ delete($env{'request.enc'});
+ }
return ($symb,$enc);
}