--- loncom/lonnet/perl/lonnet.pm 2012/08/14 15:45:34 1.1183 +++ loncom/lonnet/perl/lonnet.pm 2012/08/17 22:43:58 1.1184 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1183 2012/08/14 15:45:34 raeburn Exp $ +# $Id: lonnet.pm,v 1.1184 2012/08/17 22:43:58 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -113,30 +113,33 @@ our @ISA = qw (Exporter); our @EXPORT = qw(%env); -# --------------------------------------------------------------------- Logging +# ---------------------------------------------------------------- Role Logging { my $logid; - sub instructor_log { - my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_; - if (($cnum eq '') || ($cdom eq '')) { - $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + sub write_rolelog { + my ($context,$hash_name,$storehash,$delflag,$udom,$uname,$cdom,$cnum)=@_; + if ($context eq 'course') { + if (($cnum eq '') || ($cdom eq '')) { + $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + } } - $logid++; + $logid ++; my $now = time(); my $id=$now.'00000'.$$.'00000'.$logid; - return &Apache::lonnet::put('nohist_'.$hash_name, - { $id => { - 'exe_uname' => $env{'user.name'}, - 'exe_udom' => $env{'user.domain'}, - 'exe_time' => $now, - 'exe_ip' => $ENV{'REMOTE_ADDR'}, - 'delflag' => $delflag, - 'logentry' => $storehash, - 'uname' => $uname, - 'udom' => $udom, - } - },$cdom,$cnum); + my $logentry = { + $id => { + 'exe_uname' => $env{'user.name'}, + 'exe_udom' => $env{'user.domain'}, + 'exe_time' => $now, + 'exe_ip' => $ENV{'REMOTE_ADDR'}, + 'delflag' => $delflag, + 'logentry' => $storehash, + 'uname' => $uname, + 'udom' => $udom, + } + }; + return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum); } } @@ -3534,38 +3537,70 @@ sub userrolelog { sub courserolelog { my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_; - if (($trole eq 'cc') || ($trole eq 'in') || - ($trole eq 'ep') || ($trole eq 'ad') || - ($trole eq 'ta') || ($trole eq 'st') || - ($trole=~/^cr/) || ($trole eq 'gr') || - ($trole eq 'co')) { - if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) { - my $cdom = $1; - my $cnum = $2; - my $sec = $3; - my $namespace = 'rolelog'; - my %storehash = ( - role => $trole, - start => $tstart, - end => $tend, - selfenroll => $selfenroll, - context => $context, - ); - if ($trole eq 'gr') { - $namespace = 'groupslog'; - $storehash{'group'} = $sec; - } else { - $storehash{'section'} = $sec; - } - &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom); - if (($trole ne 'st') || ($sec ne '')) { - &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); - } + if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) { + my $cdom = $1; + my $cnum = $2; + my $sec = $3; + my $namespace = 'rolelog'; + my %storehash = ( + role => $trole, + start => $tstart, + end => $tend, + selfenroll => $selfenroll, + context => $context, + ); + if ($trole eq 'gr') { + $namespace = 'groupslog'; + $storehash{'group'} = $sec; + } else { + $storehash{'section'} = $sec; + } + &write_rolelog('course',$namespace,\%storehash,$delflag,$domain, + $username,$cdom,$cnum); + if (($trole ne 'st') || ($sec ne '')) { + &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); } } return; } +sub domainrolelog { + my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_; + if ($area =~ m{^/($match_domain)/$}) { + my $cdom = $1; + my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom); + my $namespace = 'rolelog'; + my %storehash = ( + role => $trole, + start => $tstart, + end => $tend, + context => $context, + ); + &write_rolelog('domain',$namespace,\%storehash,$delflag,$domain, + $username,$cdom,$domconfiguser); + } + return; + +} + +sub coauthorrolelog { + my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_; + if ($area =~ m{^/($match_domain)/($match_username)$}) { + my $audom = $1; + my $auname = $2; + my $namespace = 'rolelog'; + my %storehash = ( + role => $trole, + start => $tstart, + end => $tend, + context => $context, + ); + &write_rolelog('author',$namespace,\%storehash,$delflag,$domain, + $username,$audom,$auname); + } + return; +} + sub get_course_adv_roles { my ($cid,$codes) = @_; $cid=$env{'request.course.id'} unless (defined($cid)); @@ -7604,11 +7639,25 @@ sub assignrole { if ($answer eq 'ok') { &userrolelog($role,$uname,$udom,$url,$start,$end); # for course roles, perform group memberships changes triggered by role change. - &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context); unless ($role =~ /^gr/) { &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend, $origstart,$selfenroll,$context); } + if (($role eq 'cc') || ($role eq 'in') || + ($role eq 'ep') || ($role eq 'ad') || + ($role eq 'ta') || ($role eq 'st') || + ($role=~/^cr/) || ($role eq 'gr') || + ($role eq 'co')) { + &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, + $selfenroll,$context); + } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') || + ($role eq 'au') || ($role eq 'dc')) { + &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, + $context); + } elsif (($role eq 'ca') || ($role eq 'aa')) { + &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, + $context); + } if ($role eq 'cc') { &autoupdate_coowners($url,$end,$start,$uname,$udom); }