version 1.976.2.2, 2008/12/21 15:20:54
|
version 1.977, 2008/12/09 11:32:03
|
Line 73 package Apache::lonnet;
|
Line 73 package Apache::lonnet;
|
use strict; |
use strict; |
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use HTTP::Date; |
use HTTP::Date; |
|
use Image::Magick; |
|
|
# use Date::Parse; |
# use Date::Parse; |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol); |
$_64bit %env %protocol); |
Line 97 use LONCAPA::Configuration;
|
Line 99 use LONCAPA::Configuration;
|
my $readit; |
my $readit; |
my $max_connection_retries = 10; # Or some such value. |
my $max_connection_retries = 10; # Or some such value. |
|
|
|
my $upload_photo_form = 0; #Variable to check when user upload a photo 0=not 1=true |
|
|
require Exporter; |
require Exporter; |
|
|
our @ISA = qw (Exporter); |
our @ISA = qw (Exporter); |
Line 2011 sub clean_filename {
|
Line 2015 sub clean_filename {
|
return $fname; |
return $fname; |
} |
} |
|
|
|
#Wrapper function for userphotoupload |
|
sub userphotoupload |
|
{ |
|
my($formname,$subdir) = @_; |
|
$upload_photo_form = 1; |
|
return &userfileupload($formname,undef,$subdir); |
|
} |
|
|
# --------------- Take an uploaded file and put it into the userfiles directory |
# --------------- Take an uploaded file and put it into the userfiles directory |
# input: $formname - the contents of the file are in $env{"form.$formname"} |
# input: $formname - the contents of the file are in $env{"form.$formname"} |
# the desired filenam is in $env{"form.$formname.filename"} |
# the desired filenam is in $env{"form.$formname.filename"} |
Line 2137 sub finishuserfileupload {
|
Line 2149 sub finishuserfileupload {
|
return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
} |
} |
close(FH); |
close(FH); |
|
if($upload_photo_form==1) |
|
{ |
|
my $ima = Image::Magick->new; |
|
$ima->Read($filepath.'/'.$file); |
|
if($ima->Get('width') > 300) |
|
{ |
|
my $factor = $ima->Get('width')/300; |
|
$ima->Scale( width=>300, height=>$ima->Get('height')/$factor ); |
|
} |
|
if($ima->Get('height') > 400) |
|
{ |
|
my $factor = $ima->Get('height')/400; |
|
$ima->Scale( width=>$ima->Get('width')/$factor, height=>400); |
|
} |
|
|
|
|
|
$ima->Write($filepath.'/'.$file); |
|
$upload_photo_form = 0; |
|
} |
} |
} |
if ($parser eq 'parse') { |
if ($parser eq 'parse') { |
my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles, |
my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles, |
Line 4375 sub is_portfolio_file {
|
Line 4406 sub is_portfolio_file {
|
} |
} |
|
|
sub usertools_access { |
sub usertools_access { |
my ($uname,$udom,$tool,$action) = @_; |
my ($uname,$udom,$tool) = @_; |
my $access; |
my $access; |
my %tools = ( |
my %tools = ( |
aboutme => 1, |
aboutme => 1, |
Line 4389 sub usertools_access {
|
Line 4420 sub usertools_access {
|
$uname = $env{'user.name'}; |
$uname = $env{'user.name'}; |
} |
} |
|
|
if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { |
my $hashid=$uname.':'.$udom; |
if ($action ne 'reload') { |
my ($result,$cached) = &is_cached_new('usertools.'.$tool,$hashid); |
return $env{'environment.availabletools.'.$tool}; |
if (defined($cached)) { |
} |
return $result; |
} |
} |
|
|
my ($toolstatus,$inststatus); |
my ($toolstatus,$inststatus); |
Line 4412 sub usertools_access {
|
Line 4443 sub usertools_access {
|
} else { |
} else { |
$access = 0; |
$access = 0; |
} |
} |
|
&do_cache_new('usertools.'.$tool,$hashid,$access,600); |
return $access; |
return $access; |
} |
} |
|
|
Line 4425 sub usertools_access {
|
Line 4457 sub usertools_access {
|
} else { |
} else { |
$access = 0; |
$access = 0; |
} |
} |
|
&do_cache_new('usertools.'.$tool,$hashid,$access,600); |
return $access; |
return $access; |
} |
} |
} |
} |
Line 4445 sub usertools_access {
|
Line 4478 sub usertools_access {
|
} elsif ($hasnoaccess) { |
} elsif ($hasnoaccess) { |
$access = 0; |
$access = 0; |
} |
} |
|
&do_cache_new('usertools.'.$tool,$hashid,$access,600); |
return $access; |
return $access; |
} |
} |
} else { |
} else { |
Line 4454 sub usertools_access {
|
Line 4488 sub usertools_access {
|
} elsif ($domdef{$tool}{'default'} == 0) { |
} elsif ($domdef{$tool}{'default'} == 0) { |
$access = 0; |
$access = 0; |
} |
} |
|
&do_cache_new('usertools.'.$tool,$hashid,$access,600); |
return $access; |
return $access; |
} |
} |
} |
} |
} else { |
} else { |
$access = 1; |
$access = 1; |
|
&do_cache_new('usertools.'.$tool,$hashid,$access,600); |
return $access; |
return $access; |
} |
} |
} |
} |
Line 8617 sub get_dns {
|
Line 8653 sub get_dns {
|
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
foreach my $dns (<$config>) { |
foreach my $dns (<$config>) { |
next if ($dns !~ /^\^(\S*)/x); |
next if ($dns !~ /^\^(\S*)/x); |
my $line = $1; |
$alldns{$1} = 1; |
my ($host,$protocol) = split(/:/,$line); |
|
if ($protocol ne 'https') { |
|
$protocol = 'http'; |
|
} |
|
$alldns{$host} = $protocol; |
|
} |
} |
while (%alldns) { |
while (%alldns) { |
my ($dns) = keys(%alldns); |
my ($dns) = keys(%alldns); |
|
delete($alldns{$dns}); |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); |
my $request=new HTTP::Request('GET',"http://$dns$url"); |
my $response=$ua->request($request); |
my $response=$ua->request($request); |
delete($alldns{$dns}); |
|
next if ($response->is_error()); |
next if ($response->is_error()); |
my @content = split("\n",$response->content); |
my @content = split("\n",$response->content); |
&Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60); |
&Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60); |