--- loncom/lonnet/perl/lonnet.pm 2005/09/26 22:16:58 1.651.2.5 +++ loncom/lonnet/perl/lonnet.pm 2005/10/04 17:28:08 1.659 @@ -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.659 2005/10/04 17:28:08 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)=@_; @@ -1804,7 +1811,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}{$key} = $value; + } + } + } + } + return %returnhash; +} + # ----------------------------------------------------------- Check out an item sub get_first_access { @@ -3201,8 +3228,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 +3801,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 +4888,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,7 +5918,7 @@ BEGIN { } close($config); # FIXME: dev server don't want this, production servers _do_ want this - &get_iphost(); + #&get_iphost(); } sub get_iphost {