--- loncom/interface/loncommon.pm 2008/07/14 10:16:11 1.671
+++ loncom/interface/loncommon.pm 2008/09/29 22:58:41 1.679.2.6
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.671 2008/07/14 10:16:11 raeburn Exp $
+# $Id: loncommon.pm,v 1.679.2.6 2008/09/29 22:58:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -904,6 +904,9 @@ sub helpLatexCheatsheet {
.'| '.
&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)
.' | ';
}
@@ -913,6 +916,8 @@ sub general_help {
$helptopic='Authoring_Intro';
} elsif ($env{'request.role'}=~/^cc/) {
$helptopic='Course_Coordination_Intro';
+ } elsif ($env{'request.role'}=~/^dc/) {
+ $helptopic='Domain_Coordination_Intro';
}
return $helptopic;
}
@@ -1502,9 +1507,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)
}
@@ -2982,14 +2987,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;
@@ -3343,16 +3353,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 {
@@ -3362,6 +3377,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));
@@ -3742,6 +3775,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
@@ -5355,6 +5442,10 @@ hr.LC_edit_problem_divide {
height: 3px;
border: 0px;
}
+img.stift{
+ border-width:0;
+ vertical-align:middle;
+}
END
}
@@ -6803,12 +6894,12 @@ sub instrule_disallow_msg {
$text{'action'} = 'IDs';
}
}
- $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",$domdesc).'
';
+ $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",''.$domdesc.'').'
';
if ($mode eq 'upload') {
if ($checkitem eq 'username') {
$response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
} elsif ($checkitem eq 'id') {
- $response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the ID/Student Number field.");
+ $response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the Student/Employee ID field.");
}
} elsif ($mode eq 'selfcreate') {
if ($checkitem eq 'id') {
@@ -8239,8 +8330,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;
@@ -8506,9 +8599,10 @@ sub assign_categories_table {
$checked = ' checked="checked" ';
}
}
- $output .= '| '
- .''.$parent.' | ';
+ $output .= '
| '.
+ ''.$parent.''.
+ ' | ';
my $depth = 1;
push(@path,$parent);
$output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
@@ -8574,7 +8668,9 @@ sub assign_category_rows {
}
$text .= '
| ';
+ $item.'"'.$checked.' />'.$name.''.
+ ''.
+ ' | ';
if (ref($path) eq 'ARRAY') {
push(@{$path},$name);
$text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
@@ -9257,7 +9353,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
@@ -9372,9 +9468,11 @@ sub init_user_environment {
sub _add_to_env {
my ($idf,$env_data,$prefix) = @_;
- while (my ($key,$value) = each(%$env_data)) {
- $idf->{$prefix.$key} = $value;
- $env{$prefix.$key} = $value;
+ if (ref($env_data) eq 'HASH') {
+ while (my ($key,$value) = each(%$env_data)) {
+ $idf->{$prefix.$key} = $value;
+ $env{$prefix.$key} = $value;
+ }
}
}
|