--- loncom/lonnet/perl/lonnet.pm 2005/09/26 22:16:58 1.651.2.5 +++ loncom/lonnet/perl/lonnet.pm 2005/09/01 05:07:35 1.652 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.651.2.5 2005/09/26 22:16:58 albertel Exp $ +# $Id: lonnet.pm,v 1.652 2005/09/01 05:07:35 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -767,6 +767,13 @@ sub validate_access_key { } # ------------------------------------- Find the section of student in a course +sub devalidate_getsection_cache { + my ($udom,$unam,$courseid)=@_; + $courseid=~s/\_/\//g; + $courseid=~s/^(\w)/\/$1/; + my $hashid="$udom:$unam:$courseid"; + &devalidate_cache_new('getsection',$hashid); +} sub getsection { my ($udom,$unam,$courseid)=@_; @@ -1636,7 +1643,7 @@ sub courseacclog { my $fnsymb=shift; unless ($env{'request.course.id'}) { return ''; } my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'}; - if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) { + if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) { $what.=':POST'; # FIXME: Probably ought to escape things.... foreach (keys %env) { @@ -1709,11 +1716,7 @@ sub get_course_adv_roles { if ($username eq '' || $domain eq '') { next; } if ((&privileged($username,$domain)) && (!$nothide{$username.':'.$domain})) { next; } - if ($role eq 'cr') { next; } my $key=&plaintext($role); - if ($role =~ /^cr/) { - $key=(split('/',$role))[3]; - } if ($section) { $key.=' (Sec/Grp '.$section.')'; } if ($returnhash{$key}) { $returnhash{$key}.=','.$username.':'.$domain; @@ -2482,12 +2485,8 @@ sub rolesinit { my ($trole,$tend,$tstart); if ($role=~/^cr/) { - if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) { - ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|); - ($tend,$tstart)=split('_',$trest); - } else { - $trole=$role; - } + ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|); + ($tend,$tstart)=split('_',$trest); } else { ($trole,$tend,$tstart)=split(/_/,$role); } @@ -3775,6 +3774,8 @@ sub modify_student_enrollment { $cdom,$cnum); unless (($reply eq 'ok') || ($reply eq 'delayed')) { return 'error: '.$reply; + } else { + &devalidate_getsection_cache($udom,$uname,$cid); } # Add student role to user my $uurl='/'.$cid; @@ -4860,7 +4861,7 @@ sub metadata { $metaentry{':keys'}=join(',',keys %metathesekeys); &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); - &do_cache_new('meta',$uri,\%metaentry,600); + &do_cache_new('meta',$uri,\%metaentry,60*60*24); # this is the end of "was not already recently cached } return $metaentry{':'.$what}; @@ -5890,26 +5891,19 @@ BEGIN { } close($config); # FIXME: dev server don't want this, production servers _do_ want this - &get_iphost(); + #&get_iphost(); } sub get_iphost { if (%iphost) { return %iphost; } - my %name_to_ip; foreach my $id (keys(%hostname)) { my $name=$hostname{$id}; - my $ip; - if (!exists($name_to_ip{$name})) { - $ip = gethostbyname($name); - if (!$ip || length($ip) ne 4) { - &logthis("Skipping host $id name $name no IP found\n"); - next; - } - $ip=inet_ntoa($ip); - $name_to_ip{$name} = $ip; - } else { - $ip = $name_to_ip{$name}; + my $ip = gethostbyname($name); + if (!$ip || length($ip) ne 4) { + &logthis("Skipping host $id name $name no IP found\n"); + next; } + $ip=inet_ntoa($ip); push(@{$iphost{$ip}},$id); } return %iphost;