--- loncom/lonnet/perl/lonnet.pm 2012/08/19 00:18:41 1.1185 +++ loncom/lonnet/perl/lonnet.pm 2012/09/02 16:18:24 1.1189 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1185 2012/08/19 00:18:41 raeburn Exp $ +# $Id: lonnet.pm,v 1.1189 2012/09/02 16:18:24 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -113,11 +113,11 @@ our @ISA = qw (Exporter); our @EXPORT = qw(%env); -# ---------------------------------------------------------------- Role Logging +# ------------------------------------ Logging (parameters, docs, slots, roles) { my $logid; - sub write_rolelog { - my ($context,$hash_name,$storehash,$delflag,$udom,$uname,$cdom,$cnum)=@_; + sub write_log { + my ($context,$hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_; if ($context eq 'course') { if (($cnum eq '') || ($cdom eq '')) { $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; @@ -2406,7 +2406,7 @@ sub chatsend { sub getversion { my $fname=&clutter(shift); - unless ($fname=~/^\/res\//) { return -1; } + unless ($fname=~m{^(/adm/wrapper|)/res/}) { return -1; } return ¤tversion(&filelocation('',$fname)); } @@ -3555,8 +3555,8 @@ sub courserolelog { } else { $storehash{'section'} = $sec; } - &write_rolelog('course',$namespace,\%storehash,$delflag,$domain, - $username,$cdom,$cnum); + &write_log('course',$namespace,\%storehash,$delflag,$username, + $domain,$cnum,$cdom); if (($trole ne 'st') || ($sec ne '')) { &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); } @@ -3576,8 +3576,8 @@ sub domainrolelog { end => $tend, context => $context, ); - &write_rolelog('domain',$namespace,\%storehash,$delflag,$domain, - $username,$cdom,$domconfiguser); + &write_log('domain',$namespace,\%storehash,$delflag,$username, + $domain,$domconfiguser,$cdom); } return; @@ -3595,8 +3595,8 @@ sub coauthorrolelog { end => $tend, context => $context, ); - &write_rolelog('author',$namespace,\%storehash,$delflag,$domain, - $username,$audom,$auname); + &write_log('author',$namespace,\%storehash,$delflag,$username, + $domain,$auname,$audom); } return; } @@ -3713,7 +3713,7 @@ sub get_my_roles { } my ($rolecode,$username,$domain,$section,$area); if ($context eq 'userroles') { - ($area,$rolecode) = split(/_/,$entry); + ($area,$rolecode) = ($entry =~ /^(.+)_([^_]+)$/); (undef,$domain,$username,$section) = split(/\//,$area); } else { ($role,$username,$domain,$section) = split(/\:/,$entry);