--- loncom/lonnet/perl/lonnet.pm 2009/05/15 20:31:04 1.976.2.9 +++ loncom/lonnet/perl/lonnet.pm 2009/02/05 14:56:55 1.984 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.976.2.9 2009/05/15 20:31:04 raeburn Exp $ +# $Id: lonnet.pm,v 1.984 2009/02/05 14:56:55 neumanie 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); @@ -522,7 +526,7 @@ sub appenv { # ----------------------------------------------------- Delete from Environment sub delenv { - my ($delthis,$regexp) = @_; + my $delthis=shift; if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { &logthis("WARNING: ". "Attempt to delete from environment ".$delthis); @@ -535,17 +539,10 @@ sub delenv { tie(my %disk_env,'GDBM_File',$env{'user.environment'}, (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { foreach my $key (keys(%disk_env)) { - if ($regexp) { - if ($key=~/^$delthis/) { - delete($env{$key}); - delete($disk_env{$key}); - } - } else { - if ($key=~/^\Q$delthis\E/) { - delete($env{$key}); - delete($disk_env{$key}); - } - } + if ($key=~/^\Q$delthis\E/) { + delete($env{$key}); + delete($disk_env{$key}); + } } untie(%disk_env); } @@ -1262,7 +1259,7 @@ sub get_domain_defaults { $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'}; $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; - $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; + $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'} } else { $domdefaults{'lang_def'} = &domain($domain,'lang_def'); $domdefaults{'auth_def'} = &domain($domain,'auth_def'); @@ -2032,6 +2029,32 @@ 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 +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); +} # --------------- Take an uploaded file and put it into the userfiles directory # input: $formname - the contents of the file are in $env{"form.$formname"} @@ -2132,6 +2155,7 @@ sub finishuserfileupload { $thumbwidth,$thumbheight) = @_; my $path=$docudom.'/'.$docuname.'/'; my $filepath=$perlvar{'lonDocRoot'}; + my ($fnamepath,$file,$fetchthumb); $file=$fname; if ($fname=~m|/|) { @@ -2146,6 +2170,7 @@ sub finishuserfileupload { mkdir($filepath,0777); } } + # Save the file { if (!open(FH,'>'.$filepath.'/'.$file)) { @@ -2159,6 +2184,11 @@ sub finishuserfileupload { return '/adm/notfound.html'; } close(FH); + if($upload_photo_form==1) + { + resizeImage($filepath.'/'.$file); + $upload_photo_form = 0; + } } if ($parser eq 'parse') { my $parse_result = &extract_embedded_items($filepath.'/'.$file,$allfiles, @@ -2180,7 +2210,7 @@ sub finishuserfileupload { # Notify homeserver to grep it # - my $docuhome=&homeserver($docuname,$docudom); + my $docuhome=&homeserver($docuname,$docudom); my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome); if ($fetchresult eq 'ok') { if ($fetchthumb) { @@ -2312,21 +2342,21 @@ sub add_filetype { } sub removeuploadedurl { - my ($url)=@_; - my (undef,undef,$udom,$uname,$fname)=split('/',$url,5); + my ($url)=@_; + my (undef,undef,$udom,$uname,$fname)=split('/',$url,5); return &removeuserfile($uname,$udom,$fname); } sub removeuserfile { my ($docuname,$docudom,$fname)=@_; - my $home=&homeserver($docuname,$docudom); + my $home=&homeserver($docuname,$docudom); my $result = &reply("removeuserfile:$docudom/$docuname/$fname",$home); - if ($result eq 'ok') { + if ($result eq 'ok') { if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) { my $metafile = $fname.'.meta'; my $metaresult = &removeuserfile($docuname,$docudom,$metafile); my $url = "/uploaded/$docudom/$docuname/$fname"; - my ($file,$group) = (&parse_portfolio_url($url))[3,4]; + my ($file,$group) = (&parse_portfolio_url($url))[3,4]; my $sqlresult = &update_portfolio_table($docuname,$docudom,$file, 'portfolio_metadata',$group, @@ -2624,9 +2654,6 @@ sub courserolelog { $storehash{'section'} = $sec; } &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom); - if (($trole ne 'st') || ($sec ne '')) { - &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); - } } } return; @@ -2648,7 +2675,6 @@ sub get_course_adv_roles { my %dumphash= &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'}); my $now=time; - my %privileged; foreach my $entry (keys %dumphash) { my ($tend,$tstart)=split(/\:/,$dumphash{$entry}); if (($tstart) && ($tstart<0)) { next; } @@ -2656,21 +2682,8 @@ sub get_course_adv_roles { if (($tstart) && ($now<$tstart)) { next; } my ($role,$username,$domain,$section)=split(/\:/,$entry); if ($username eq '' || $domain eq '') { next; } - unless (ref($privileged{$domain}) eq 'HASH') { - my %dompersonnel = - &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now); - $privileged{$domain} = {}; - foreach my $server (keys(%dompersonnel)) { - if (ref($dompersonnel{$server}) eq 'HASH') { - foreach my $user (keys(%{$dompersonnel{$server}})) { - my ($trole,$uname,$udom) = split(/:/,$user); - $privileged{$udom}{$uname} = 1; - } - } - } - } - if ((exists($privileged{$domain}{$username})) && - (!$nothide{$username.':'.$domain})) { next; } + if ((&privileged($username,$domain)) && + (!$nothide{$username.':'.$domain})) { next; } if ($role eq 'cr') { next; } if ($codes) { if ($section) { $role .= ':'.$section; } @@ -2715,7 +2728,6 @@ sub get_my_roles { } my %returnhash=(); my $now=time; - my %privileged; foreach my $entry (keys(%dumphash)) { my ($role,$tend,$tstart); if ($context eq 'userroles') { @@ -2764,32 +2776,9 @@ sub get_my_roles { } } if ($hidepriv) { - if ($context eq 'userroles') { - if ((&privileged($username,$domain)) && - (!$nothide{$username.':'.$domain})) { - next; - } - } else { - unless (ref($privileged{$domain}) eq 'HASH') { - my %dompersonnel = - &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now); - $privileged{$domain} = {}; - if (keys(%dompersonnel)) { - foreach my $server (keys(%dompersonnel)) { - if (ref($dompersonnel{$server}) eq 'HASH') { - foreach my $user (keys(%{$dompersonnel{$server}})) { - my ($trole,$uname,$udom) = split(/:/,$user); - $privileged{$udom}{$uname} = $trole; - } - } - } - } - } - if (exists($privileged{$domain}{$username})) { - if (!$nothide{$username.':'.$domain}) { - next; - } - } + if ((&privileged($username,$domain)) && + (!$nothide{$username.':'.$domain})) { + next; } } if ($withsec) { @@ -3873,11 +3862,11 @@ sub del { foreach my $item (@$storearr) { $items.=&escape($item).'&'; } + $items=~s/\&$//; if (!$udomain) { $udomain=$env{'user.domain'}; } if (!$uname) { $uname=$env{'user.name'}; } my $uhome=&homeserver($uname,$udomain); - return &reply("del:$udomain:$uname:$namespace:$items",$uhome); } @@ -4455,7 +4444,7 @@ sub usertools_access { if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { if ($action ne 'reload') { return $env{'environment.availabletools.'.$tool}; - } + } } my ($toolstatus,$inststatus); @@ -9276,11 +9265,9 @@ in the user's environment.db and in %env =item * X -B: removes all items from the session -environment file that begin with $delthis. If the -optional second arg - $regexp - is true, $delthis is treated as a -regular expression, otherwise \Q$delthis\E is used. -The values are also deleted from the current processes %env. +B: removes all items from the session +environment file that matches the regular expression in $regexp. The +values are also delted from the current processes %env. =item * get_env_multiple($name)