--- loncom/interface/loncommon.pm 2008/09/05 19:20:39 1.681
+++ loncom/interface/loncommon.pm 2008/10/02 14:05:45 1.689
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.681 2008/09/05 19:20:39 riegler Exp $
+# $Id: loncommon.pm,v 1.689 2008/10/02 14:05:45 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,6 +61,7 @@ use POSIX qw(strftime mktime);
use Apache::lonmenu();
use Apache::lonenc();
use Apache::lonlocal;
+use Apache::lonnet();
use HTML::Entities;
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
@@ -68,6 +69,7 @@ use Apache::lontexconvert();
use Apache::lonclonecourse();
use LONCAPA qw(:DEFAULT :match);
use DateTime::TimeZone;
+use DateTime::Locale::Catalog;
# ---------------------------------------------- Designs
use vars qw(%defaultdesign);
@@ -657,6 +659,57 @@ sub select_timezone {
return $output;
}
+sub select_datelocale {
+ my ($name,$selected,$onchange,$includeempty)=@_;
+ my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
+ if ($includeempty) {
+ $output .= '<option value=""';
+ if ($selected eq '') {
+ $output .= ' selected="selected" ';
+ }
+ $output .= '> </option>';
+ }
+ my (@possibles,%locale_names);
+ my @locales = DateTime::Locale::Catalog::Locales;
+ foreach my $locale (@locales) {
+ if (ref($locale) eq 'HASH') {
+ my $id = $locale->{'id'};
+ if ($id ne '') {
+ my $en_terr = $locale->{'en_territory'};
+ my $native_terr = $locale->{'native_territory'};
+ my @languages = &preferred_languages();
+ if (grep(/^en$/,@languages) || !@languages) {
+ if ($en_terr ne '') {
+ $locale_names{$id} = '('.$en_terr.')';
+ } elsif ($native_terr ne '') {
+ $locale_names{$id} = $native_terr;
+ }
+ } else {
+ if ($native_terr ne '') {
+ $locale_names{$id} = $native_terr.' ';
+ } elsif ($en_terr ne '') {
+ $locale_names{$id} = '('.$en_terr.')';
+ }
+ }
+ push (@possibles,$id);
+ }
+ }
+ }
+ foreach my $item (sort(@possibles)) {
+ $output.= '<option value="'.$item.'"';
+ if ($item eq $selected) {
+ $output.=' selected="selected"';
+ }
+ $output.=">$item";
+ if ($locale_names{$item} ne '') {
+ $output.=" $locale_names{$item}</option>\n";
+ }
+ $output.="</option>\n";
+ }
+ $output.="</select>";
+ return $output;
+}
+
=pod
=item * &linked_select_forms(...)
@@ -1507,9 +1560,9 @@ sub create_text_file {
$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.");
+ $r->print(&mt('Problems occurred in creating the output file. '
+ .'This error has been logged. '
+ .'Please alert your LON-CAPA administrator.'));
}
return ($fh,$filename)
}
@@ -2987,14 +3040,19 @@ sub preferred_languages {
}
}
}
+ 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]);
- }
+ unless ($lang=~/\w/) { next; }
+ push(@genlanguages,$lang);
+ if ($lang=~/(\-|\_)/) {
+ push(@genlanguages,(split(/(\-|\_)/,$lang))[0]);
+ }
}
#uniqueify the languages list
my %count;
@@ -3348,16 +3406,21 @@ sub pprmlink {
sub timehash {
- my @ltime=localtime(shift);
- return ( 'seconds' => $ltime[0],
- 'minutes' => $ltime[1],
- 'hours' => $ltime[2],
- 'day' => $ltime[3],
- 'month' => $ltime[4]+1,
- 'year' => $ltime[5]+1900,
- 'weekday' => $ltime[6],
- 'dayyear' => $ltime[7]+1,
- 'dlsav' => $ltime[8] );
+ my ($thistime) = @_;
+ my $timezone = &Apache::lonlocal::gettimezone();
+ my $dt = DateTime->from_epoch(epoch => $thistime)
+ ->set_time_zone($timezone);
+ my $wday = $dt->day_of_week();
+ if ($wday == 7) { $wday = 0; }
+ return ( 'second' => $dt->second(),
+ 'minute' => $dt->minute(),
+ 'hour' => $dt->hour(),
+ 'day' => $dt->day_of_month(),
+ 'month' => $dt->month(),
+ 'year' => $dt->year(),
+ 'weekday' => $wday,
+ 'dayyear' => $dt->day_of_year(),
+ 'dlsav' => $dt->is_dst() );
}
sub utc_string {
@@ -3367,6 +3430,24 @@ sub utc_string {
sub maketime {
my %th=@_;
+ my ($epoch_time,$timezone,$dt);
+ $timezone = &Apache::lonlocal::gettimezone();
+ eval {
+ $dt = DateTime->new( year => $th{'year'},
+ month => $th{'month'},
+ day => $th{'day'},
+ hour => $th{'hour'},
+ minute => $th{'minute'},
+ second => $th{'second'},
+ time_zone => $timezone,
+ );
+ };
+ if (!$@) {
+ $epoch_time = $dt->epoch;
+ if ($epoch_time) {
+ return $epoch_time;
+ }
+ }
return POSIX::mktime(
($th{'seconds'},$th{'minutes'},$th{'hours'},
$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
@@ -3747,6 +3828,60 @@ sub blocking_status {
###############################################
+sub check_ip_acc {
+ my ($acc)=@_;
+ &Apache::lonxml::debug("acc is $acc");
+ if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
+ return 1;
+ }
+ my $allowed=0;
+ my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
+
+ my $name;
+ foreach my $pattern (split(',',$acc)) {
+ $pattern =~ s/^\s*//;
+ $pattern =~ s/\s*$//;
+ if ($pattern =~ /\*$/) {
+ #35.8.*
+ $pattern=~s/\*//;
+ if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
+ } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
+ #35.8.3.[34-56]
+ my $low=$2;
+ my $high=$3;
+ $pattern=$1;
+ if ($ip =~ /^\Q$pattern\E/) {
+ my $last=(split(/\./,$ip))[3];
+ if ($last <=$high && $last >=$low) { $allowed=1; }
+ }
+ } elsif ($pattern =~ /^\*/) {
+ #*.msu.edu
+ $pattern=~s/\*//;
+ if (!defined($name)) {
+ use Socket;
+ my $netaddr=inet_aton($ip);
+ ($name)=gethostbyaddr($netaddr,AF_INET);
+ }
+ if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
+ } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
+ #127.0.0.1
+ if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
+ } else {
+ #some.name.com
+ if (!defined($name)) {
+ use Socket;
+ my $netaddr=inet_aton($ip);
+ ($name)=gethostbyaddr($netaddr,AF_INET);
+ }
+ if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
+ }
+ if ($allowed) { last; }
+ }
+ return $allowed;
+}
+
+###############################################
+
=pod
=head1 Domain Template Functions
@@ -7572,7 +7707,7 @@ sub csv_print_select_table {
&end_data_table_header_row()."\n");
foreach my $array_ref (@$d) {
my ($value,$display,$defaultcol)=@{ $array_ref };
- $r->print(&start_data_table_row().'<tr><td>'.$display.'</td>');
+ $r->print(&start_data_table_row().'<td>'.$display.'</td>');
$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');
@@ -8269,8 +8404,10 @@ sub build_recipient_list {
} elsif ($origmail ne '') {
push(@recipients,$origmail);
}
- if ($defmail ne '') {
- push(@recipients,$defmail);
+ if (defined($defmail)) {
+ if ($defmail ne '') {
+ push(@recipients,$defmail);
+ }
}
if ($otheremails) {
my @others;
@@ -9290,7 +9427,7 @@ sub init_user_environment {
}
# Give them a new cookie
my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
- : $now);
+ : $now.$$.int(rand(10000)));
$cookie="$username\_$id\_$domain\_$authhost";
# Initialize roles
@@ -9413,6 +9550,44 @@ 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 $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
+ if ($symb eq '') {
+ if (!$silent) {
+ $request->print("Unable to handle ambiguous references:$url:.");
+ return ();
+ }
+ }
+ &Apache::lonenc::check_decrypt(\$symb);
+ return ($symb);
+}
+
+# --------------------------------------------------------------Get annotation
+
+sub get_annotation {
+ my ($symb,$enc) = @_;
+
+ my $key = $symb;
+ if (!$enc) {
+ $key =
+ &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
+ }
+ my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
+ return $annotation{$key};
+}
+
+sub clean_symb {
+ my ($symb) = @_;
+
+ &Apache::lonenc::check_decrypt(\$symb);
+ my $enc = $env{'request.enc'};
+ delete($env{'request.enc'});
+
+ return ($symb,$enc);
+}
=pod