--- loncom/lonnet/perl/lonnet.pm 2005/09/13 19:43:01 1.656 +++ 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.656 2005/09/13 19:43:01 albertel Exp $ +# $Id: lonnet.pm,v 1.661 2005/10/10 18:15:52 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1643,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|page)$/) { + if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) { $what.=':POST'; # FIXME: Probably ought to escape things.... foreach (keys %env) { @@ -1685,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} @@ -1811,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 { @@ -3208,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;