--- loncom/lonnet/perl/lonnet.pm 2005/09/20 07:52:03 1.651.2.4 +++ loncom/lonnet/perl/lonnet.pm 2005/10/10 18:15:52 1.661 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.651.2.4 2005/09/20 07:52:03 albertel Exp $ +# $Id: lonnet.pm,v 1.661 2005/10/10 18:15:52 raeburn 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)=@_; @@ -1678,9 +1685,10 @@ sub linklog { sub userrolelog { my ($trole,$username,$domain,$area,$tstart,$tend)=@_; - if (($trole=~/^ca/) || ($trole=~/^in/) || - ($trole=~/^cc/) || ($trole=~/^ep/) || - ($trole=~/^cr/) || ($trole=~/^ta/)) { + if (($trole=~/^ca/) || ($trole=~/^aa/) || + ($trole=~/^in/) || ($trole=~/^cc/) || + ($trole=~/^ep/) || ($trole=~/^cr/) || + ($trole=~/^ta/)) { my (undef,$rudom,$runame,$rsec)=split(/\//,$area); $userrolehash {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} @@ -1804,7 +1812,27 @@ sub courseiddump { return %returnhash; } -# +# ---------------------------------------------------------- DC e-mail +sub dcmaildump { + my ($dom,$startdate,$enddate,$senders) = @_; + my %returnhash=(); + foreach my $tryserver (keys(%libserv)) { + if ($hostdom{$tryserver} eq $dom) { + %{$returnhash{$tryserver}}=(); + foreach ( + split(/\&/,&reply('dcmaildump:'.$dom.':'. + &escape($startdate).':'.&escape($enddate).':'. + &escape($senders), ,$tryserver))) { + my($key,$value) = split(/\=/,$_); + if (($key) && ($value)) { + $returnhash{$tryserver}{&unescape($key)} = &unescape($value); + } + } + } + } + return %returnhash; +} + # ----------------------------------------------------------- Check out an item sub get_first_access { @@ -3201,8 +3229,7 @@ sub allowed { # --------------------------------------------------- Is a resource on the map? sub is_on_map { - my $uri=&declutter(shift); - $uri=~s/\.\d+\.(\w+)$/\.$1/; + my $uri=&deversion(&declutter(shift)); my @uriparts=split(/\//,$uri); my $filename=$uriparts[$#uriparts]; my $pathname=$uri; @@ -3775,6 +3802,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; @@ -5890,7 +5919,7 @@ BEGIN { } close($config); # FIXME: dev server don't want this, production servers _do_ want this - &get_iphost(); + #&get_iphost(); } sub get_iphost {