--- loncom/lonnet/perl/lonnet.pm 2008/12/21 15:26:50 1.976.2.3 +++ loncom/lonnet/perl/lonnet.pm 2008/12/09 11:32:03 1.977 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.976.2.3 2008/12/21 15:26:50 raeburn Exp $ +# $Id: lonnet.pm,v 1.977 2008/12/09 11:32:03 amueller Exp $ # # Copyright Michigan State University Board of Trustees # @@ -73,6 +73,8 @@ package Apache::lonnet; use strict; use LWP::UserAgent(); use HTTP::Date; +use Image::Magick; + # use Date::Parse; use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $_64bit %env %protocol); @@ -97,6 +99,8 @@ use LONCAPA::Configuration; my $readit; 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; our @ISA = qw (Exporter); @@ -1787,7 +1791,7 @@ sub ssi_body { } my $output=''; my $response; - if ($filelink=~/^https?\:/) { + if ($filelink=~/^http\:/) { ($output,$response)=&externalssi($filelink); } else { ($output,$response)=&ssi($filelink,%form); @@ -2011,6 +2015,14 @@ sub clean_filename { 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 # input: $formname - the contents of the file are in $env{"form.$formname"} # the desired filenam is in $env{"form.$formname.filename"} @@ -2137,6 +2149,25 @@ sub finishuserfileupload { return '/adm/notfound.html'; } 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') { my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles, @@ -4375,7 +4406,7 @@ sub is_portfolio_file { } sub usertools_access { - my ($uname,$udom,$tool,$action) = @_; + my ($uname,$udom,$tool) = @_; my $access; my %tools = ( aboutme => 1, @@ -4389,10 +4420,10 @@ sub usertools_access { $uname = $env{'user.name'}; } - if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { - if ($action ne 'reload') { - return $env{'environment.availabletools.'.$tool}; - } + my $hashid=$uname.':'.$udom; + my ($result,$cached) = &is_cached_new('usertools.'.$tool,$hashid); + if (defined($cached)) { + return $result; } my ($toolstatus,$inststatus); @@ -4412,6 +4443,7 @@ sub usertools_access { } else { $access = 0; } + &do_cache_new('usertools.'.$tool,$hashid,$access,600); return $access; } @@ -4425,6 +4457,7 @@ sub usertools_access { } else { $access = 0; } + &do_cache_new('usertools.'.$tool,$hashid,$access,600); return $access; } } @@ -4445,6 +4478,7 @@ sub usertools_access { } elsif ($hasnoaccess) { $access = 0; } + &do_cache_new('usertools.'.$tool,$hashid,$access,600); return $access; } } else { @@ -4454,11 +4488,13 @@ sub usertools_access { } elsif ($domdef{$tool}{'default'} == 0) { $access = 0; } + &do_cache_new('usertools.'.$tool,$hashid,$access,600); return $access; } } } else { $access = 1; + &do_cache_new('usertools.'.$tool,$hashid,$access,600); return $access; } } @@ -8301,10 +8337,7 @@ sub repcopy_userfile { if (-e $transferfile) { return 'ok'; } my $request; $uri=~s/^\///; - my $homeserver = &homeserver($cnum,$cdom); - my $protocol = $protocol{$homeserver}; - $protocol = 'http' if ($protocol ne 'https'); - $request=new HTTP::Request('GET',$protocol.'://'.&hostname($homeserver).'/raw/'.$uri); + $request=new HTTP::Request('GET','http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri); my $response=$ua->request($request,$transferfile); # did it work? if ($response->is_error()) { @@ -8319,7 +8352,7 @@ sub repcopy_userfile { sub tokenwrapper { my $uri=shift; - $uri=~s|^https?\://([^/]+)||; + $uri=~s|^http\://([^/]+)||; $uri=~s|^/||; $env{'user.environment'}=~/\/([^\/]+)\.id/; my $token=$1; @@ -8327,10 +8360,7 @@ sub tokenwrapper { if ($udom && $uname && $file) { $file=~s|(\?\.*)*$||; &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}}); - my $homeserver = &homeserver($uname,$udom); - my $protocol = $protocol{$homeserver}; - $protocol = 'http' if ($protocol ne 'https'); - return $protocol.'://'.&hostname($homeserver).'/'.$uri. + return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri. (($uri=~/\?/)?'&':'?').'token='.$token. '&tokenissued='.$perlvar{'lonHostID'}; } else { @@ -8345,10 +8375,7 @@ sub tokenwrapper { sub getuploaded { my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_; $uri=~s/^\///; - my $homeserver = &homeserver($cnum,$cdom); - my $protocol = $protocol{$homeserver}; - $protocol = 'http' if ($protocol ne 'https'); - $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri; + $uri = 'http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri; my $ua=new LWP::UserAgent; my $request=new HTTP::Request($reqtype,$uri); my $response=$ua->request($request); @@ -8430,7 +8457,7 @@ sub filelocation { sub hreflocation { my ($dir,$file)=@_; - unless (($file=~m-^https?\://-i) || ($file=~m-^/-)) { + unless (($file=~m-^http://-i) || ($file=~m-^/-)) { $file=filelocation($dir,$file); } elsif ($file=~m-^/adm/-) { $file=~s-^/adm/wrapper/-/-; @@ -8626,19 +8653,14 @@ sub get_dns { open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); foreach my $dns (<$config>) { next if ($dns !~ /^\^(\S*)/x); - my $line = $1; - my ($host,$protocol) = split(/:/,$line); - if ($protocol ne 'https') { - $protocol = 'http'; - } - $alldns{$host} = $protocol; + $alldns{$1} = 1; } while (%alldns) { my ($dns) = keys(%alldns); + delete($alldns{$dns}); 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); - delete($alldns{$dns}); next if ($response->is_error()); my @content = split("\n",$response->content); &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);