--- loncom/lonnet/perl/lonnet.pm 2008/12/31 18:26:53 1.976.2.4 +++ loncom/lonnet/perl/lonnet.pm 2009/09/16 20:02:48 1.976.4.1 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.976.2.4 2008/12/31 18:26:53 raeburn Exp $ +# $Id: lonnet.pm,v 1.976.4.1 2009/09/16 20:02:48 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -177,6 +177,20 @@ sub create_connection { return 0; } +sub get_server_timezone { + my ($cnum,$cdom) = @_; + my $home=&homeserver($cnum,$cdom); + if ($home ne 'no_host') { + my $cachetime = 24*3600; + my ($timezone,$cached)=&is_cached_new('servertimezone',$home); + if (defined($cached)) { + return $timezone; + } else { + my $timezone = &reply('servertimezone',$home); + return &do_cache_new('servertimezone',$home,$timezone,$cachetime); + } + } +} # -------------------------------------------------- Non-critical communication sub subreply { @@ -508,7 +522,7 @@ sub appenv { # ----------------------------------------------------- Delete from Environment sub delenv { - my $delthis=shift; + my ($delthis,$regexp) = @_; if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { &logthis("WARNING: ". "Attempt to delete from environment ".$delthis); @@ -521,10 +535,17 @@ sub delenv { tie(my %disk_env,'GDBM_File',$env{'user.environment'}, (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { foreach my $key (keys(%disk_env)) { - if ($key=~/^\Q$delthis\E/) { - delete($env{$key}); - delete($disk_env{$key}); - } + 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}); + } + } } untie(%disk_env); } @@ -1227,7 +1248,6 @@ sub inst_userrules { sub get_domain_defaults { my ($domain) = @_; my $cachetime = 60*60*24; - my ($defauthtype,$defautharg,$deflang,%deftools); my ($result,$cached)=&is_cached_new('domdefaults',$domain); if (defined($cached)) { if (ref($result) eq 'HASH') { @@ -1241,6 +1261,8 @@ sub get_domain_defaults { $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; $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'}; } else { $domdefaults{'lang_def'} = &domain($domain,'lang_def'); $domdefaults{'auth_def'} = &domain($domain,'auth_def'); @@ -2602,6 +2624,9 @@ 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; @@ -2623,6 +2648,7 @@ 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; } @@ -2630,8 +2656,21 @@ sub get_course_adv_roles { if (($tstart) && ($now<$tstart)) { next; } my ($role,$username,$domain,$section)=split(/\:/,$entry); if ($username eq '' || $domain eq '') { next; } - if ((&privileged($username,$domain)) && - (!$nothide{$username.':'.$domain})) { 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 ($role eq 'cr') { next; } if ($codes) { if ($section) { $role .= ':'.$section; } @@ -2676,6 +2715,7 @@ sub get_my_roles { } my %returnhash=(); my $now=time; + my %privileged; foreach my $entry (keys(%dumphash)) { my ($role,$tend,$tstart); if ($context eq 'userroles') { @@ -2724,9 +2764,32 @@ sub get_my_roles { } } if ($hidepriv) { - if ((&privileged($username,$domain)) && - (!$nothide{$username.':'.$domain})) { - next; + 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 ($withsec) { @@ -9213,9 +9276,11 @@ in the user's environment.db and in %env =item * X -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. +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. =item * get_env_multiple($name)