--- loncom/lonnet/perl/lonnet.pm 2003/04/18 13:47:55 1.363 +++ loncom/lonnet/perl/lonnet.pm 2003/04/22 21:00:42 1.364 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.363 2003/04/18 13:47:55 www Exp $ +# $Id: lonnet.pm,v 1.364 2003/04/22 21:00:42 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -591,7 +591,11 @@ sub idput { # --------------------------------------------------- Assign a key to a student sub assign_access_key { - my ($ckey,$cdom,$cnum,$udom,$uname)=@_; +# +# a valid key looks like uname:udom#comments +# comments are being appended +# + my ($ckey,$cdom,$cnum,$udom,$uname,$logentry)=@_; $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom)); $cnum= @@ -599,13 +603,16 @@ sub assign_access_key { $udom=$ENV{'user.name'} unless (defined($udom)); $uname=$ENV{'user.domain'} unless (defined($uname)); my %existing=&get('accesskeys',[$ckey],$cdom,$cnum); - if (($existing{$ckey}=~/^\d+$/) || # has time - new key - ($existing{$ckey} eq $uname.':'.$udom)) { # this should not happen, + if (($existing{$ckey}=~/^\#(.*)$/) || # - new key + ($existing{$ckey}=~/^$uname\:$udom\#(.*)$/)) { + # assigned to this person + # - this should not happen, # unless something went wrong # the first time around # ready to assign - } elsif (!$existing{$ckey}) { - if (&put('accesskey',{$ckey=>$uname.':'.$udom},$cdom,$cnum) eq 'ok') { + $logentry=$1.'; '.$logentry; + if (&put('accesskey',{$ckey=>$uname.':'.$udom.'#'.$logentry}, + $cdom,$cnum) eq 'ok') { # key now belongs to user my $envkey='key.'.$cdom.'_'.$cnum; if (&put('environment',{$envkey => $ckey}) eq 'ok') { @@ -618,6 +625,7 @@ sub assign_access_key { } else { return 'error: Could not assign key, try again later.'; } + } elsif (!$existing{$ckey}) { # the key does not exist return 'error: The key does not exist'; } else { @@ -626,10 +634,39 @@ sub assign_access_key { } } +# ------------------------------------------ put an additional comment on a key + +sub comment_access_key { +# +# a valid key looks like uname:udom#comments +# comments are being appended +# + my ($ckey,$cdom,$cnum,$logentry)=@_; + $cdom= + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom)); + $cnum= + $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum)); + my %existing=&get('accesskeys',[$ckey],$cdom,$cnum); + if ($existing{$ckey}) { + $existing{$ckey}.='; '.$logentry; +# ready to assign + $logentry=$1.'; '.$logentry; + if (&put('accesskey',{$ckey=>$existing{$ckey}}, + $cdom,$cnum) eq 'ok') { + return 'ok'; + } else { + return 'error: Count not store comment.'; + } + } else { +# the key does not exist + return 'error: The key does not exist'; + } +} + # ------------------------------------------------------ Generate a set of keys sub generate_access_keys { - my ($number,$cdom,$cnum)=@_; + my ($number,$cdom,$cnum,$logentry)=@_; $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom)); $cnum= @@ -650,7 +687,11 @@ sub generate_access_keys { if ($existing{$newkey}) { $i--; } else { - if (&put('accesskeys',{ $newkey => time() },$cdom,$cnum) eq 'ok') { + if (&put('accesskeys', + { $newkey => '# generated '.localtime(). + ' by '.$ENV{'user.name'}.'@'.$ENV{'user.domain'}. + '; '.$logentry }, + $cdom,$cnum) eq 'ok') { $total++; } } @@ -671,7 +712,7 @@ sub validate_access_key { $udom=$ENV{'user.name'} unless (defined($udom)); $uname=$ENV{'user.domain'} unless (defined($uname)); my %existing=&get('accesskeys',[$ckey],$cdom,$cnum); - return ($existing{$ckey} eq $uname.':'.$udom); + return ($existing{$ckey}=~/^$uname\:$udom\#/); } # ------------------------------------- Find the section of student in a course