--- loncom/lonnet/perl/lonnet.pm 2010/02/26 23:11:33 1.1048.2.3 +++ loncom/lonnet/perl/lonnet.pm 2010/02/21 06:21:57 1.1051 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1048.2.3 2010/02/26 23:11:33 raeburn Exp $ +# $Id: lonnet.pm,v 1.1051 2010/02/21 06:21:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -99,8 +99,6 @@ 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); @@ -2156,31 +2154,42 @@ sub clean_filename { $fname=~s/\.(\d+)(?=\.)/_$1/g; return $fname; } -#This Function check if a Image max 400px width and height 500px. If not then scale the image down +# This Function checks if an Image's dimensions exceed either $resizewidth (width) +# or $resizeheight (height) - both pixels. If so, the image is scaled to produce an +# image with the same aspect ratio as the original, but with dimensions which do +# not exceed $resizewidth and $resizeheight. + sub resizeImage { - my($img_url) = @_; - my $ima = Image::Magick->new; - $ima->Read($img_url); - if($ima->Get('width') > 400) - { - my $factor = $ima->Get('width')/400; - $ima->Scale( width=>400, height=>$ima->Get('height')/$factor ); - } - if($ima->Get('height') > 500) - { - my $factor = $ima->Get('height')/500; - $ima->Scale( width=>$ima->Get('width')/$factor, height=>500); - } - - $ima->Write($img_url); -} - -#Wrapper function for userphotoupload -sub userphotoupload -{ - my($formname,$subdir) = @_; - $upload_photo_form = 1; - return &userfileupload($formname,undef,$subdir); + my ($img_path,$resizewidth,$resizeheight) = @_; + my $ima = Image::Magick->new; + my $resized; + if (-e $img_path) { + $ima->Read($img_path); + if (($resizewidth =~ /^\d+$/) && ($resizeheight > 0)) { + my $width = $ima->Get('width'); + my $height = $ima->Get('height'); + if ($width > $resizewidth) { + my $factor = $width/$resizewidth; + my $newheight = $height/$factor; + $ima->Scale(width=>$resizewidth,height=>$newheight); + $resized = 1; + } + } + if (($resizeheight =~ /^\d+$/) && ($resizeheight > 0)) { + my $width = $ima->Get('width'); + my $height = $ima->Get('height'); + if ($height > $resizeheight) { + my $factor = $height/$resizeheight; + my $newwidth = $width/$factor; + $ima->Scale(width=>$newwidth,height=>$resizeheight); + $resized = 1; + } + } + if ($resized) { + $ima->Write($img_path); + } + } + return; } # --------------- Take an uploaded file and put it into the userfiles directory @@ -2196,14 +2205,15 @@ sub userphotoupload # $dsetudom - domain for permanaent storage of uploaded file # $thumbwidth - width (pixels) of thumbnail to make for uploaded image # $thumbheight - height (pixels) of thumbnail to make for uploaded image +# $resizewidth - width (pixels) to which to resize uploaded image +# $resizeheight - height (pixels) to which to resize uploaded image # # output: url of file in userspace, or error: # or /adm/notfound.html if failure to upload occurse - sub userfileupload { my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname, - $destudom,$thumbwidth,$thumbheight)=@_; + $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight)=@_; if (!defined($subdir)) { $subdir='unknown'; } my $fname=$env{'form.'.$formname.'.filename'}; $fname=&clean_filename($fname); @@ -2253,7 +2263,8 @@ sub userfileupload { if ($env{'form.folder'} =~ m/^(default|supplemental)/) { return &finishuserfileupload($docuname,$docudom, $formname,$fname,$parser,$allfiles, - $codebase,$thumbwidth,$thumbheight); + $codebase,$thumbwidth,$thumbheight, + $resizewidth,$resizeheight); } else { $fname=$env{'form.folder'}.'/'.$fname; return &process_coursefile('uploaddoc',$docuname,$docudom, @@ -2265,7 +2276,8 @@ sub userfileupload { my $docudom=$destudom; return &finishuserfileupload($docuname,$docudom,$formname,$fname, $parser,$allfiles,$codebase, - $thumbwidth,$thumbheight); + $thumbwidth,$thumbheight, + $resizewidth,$resizeheight); } else { my $docuname=$env{'user.name'}; @@ -2276,13 +2288,14 @@ sub userfileupload { } return &finishuserfileupload($docuname,$docudom,$formname,$fname, $parser,$allfiles,$codebase, - $thumbwidth,$thumbheight); + $thumbwidth,$thumbheight, + $resizewidth,$resizeheight); } } sub finishuserfileupload { my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase, - $thumbwidth,$thumbheight) = @_; + $thumbwidth,$thumbheight,$resizewidth,$resizeheight) = @_; my $path=$docudom.'/'.$docuname.'/'; my $filepath=$perlvar{'lonDocRoot'}; @@ -2314,10 +2327,12 @@ sub finishuserfileupload { return '/adm/notfound.html'; } close(FH); - if($upload_photo_form==1) - { - resizeImage($filepath.'/'.$file); - $upload_photo_form = 0; + if ($resizewidth && $resizeheight) { + my $mm = new File::MMagic; + my $mime_type = $mm->checktype_filename($filepath.'/'.$file); + if ($mime_type =~ m{^image/}) { + &resizeImage($filepath.'/'.$file,$resizewidth,$resizeheight); + } } } if ($parser eq 'parse') { @@ -4069,41 +4084,6 @@ sub role_status { } } -sub curr_role_status { - my ($start,$end,$refresh,$then) = @_; - if (($start) && ($start<0)) { return 'deleted' }; - my $status = 'active'; - if (($end) && ($end<=$then)) { - $status = 'previous'; - } - if (($start) && ($refresh<$start)) { - $status = 'future'; - } - return $status; -} - -sub gather_roleprivs { - my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend) = @_; - return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH')); - if (($area ne '') && ($role ne '')) { - my $spec = $role.'.'.$area; - my ($tdummy,$tdomain,$trest)=split(/\//,$area); - if ($role =~ /^cr\//) { - &custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area); - } elsif ($role eq 'gr') { - my %rolehash = &get('roles',[$area.'_'.$role],$env{'user.domain'}, - $env{'user.name'}); - my $trole = split('_',$rolehash{$area.'_'.$role},1); - (undef,my $group_privs) = split(/\//,$trole); - $group_privs = &unescape($group_privs); - &group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart); - } else { - &standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area); - } - } - return; -} - sub check_adhoc_privs { my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_; my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; @@ -6312,10 +6292,6 @@ sub assignrole { } } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { $refused = ''; - } elsif (($selfenroll == 1) && ($role eq 'st') && ($cdom eq 'gci') && ($cnum eq '1H96711d710194bfegcil1')) { - if ($env{'request.role'} eq 'cc./gci/9615072b469884921gcil1') { - $refused = ''; - } } elsif ($context eq 'requestcourses') { my @possroles = ('st','ta','ep','in','cc','co'); if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {