[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[raeburn]

raeburn		Thu Feb 15 20:04:20 2007 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  &get_my_roles() extended to accept three optional arguments -  types, roles, and roledoms which are references to arrays, of role statuses (active,
  future or previous), roles (e.g., cc,in, st etc.) and domains of the roles.  These arguments filter which roles appear in the hash returned to the caller.
  
  - Documentation updated.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.831 loncom/lonnet/perl/lonnet.pm:1.832
--- loncom/lonnet/perl/lonnet.pm:1.831	Mon Jan 29 16:16:55 2007
+++ loncom/lonnet/perl/lonnet.pm	Thu Feb 15 20:04:19 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.831 2007/01/29 21:16:55 albertel Exp $
+# $Id: lonnet.pm,v 1.832 2007/02/16 01:04:19 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2027,7 +2027,7 @@
 }
 
 sub get_my_roles {
-    my ($uname,$udom)=@_;
+    my ($uname,$udom,$types,$roles,$roledoms)=@_;
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my %dumphash=
@@ -2037,11 +2037,35 @@
     foreach my $entry (keys(%dumphash)) {
 	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }
-        if (($tend) && ($tend<$now)) { next; }
-        if (($tstart) && ($now<$tstart)) { next; }
+        my $status = 'active';
+        if (($tend) && ($tend<$now)) {
+            $status = 'previous';
+        } 
+        if (($tstart) && ($now<$tstart)) {
+            $status = 'future';
+        }
+        if (ref($types) eq 'ARRAY') {
+            if (!grep(/^\Q$status\E$/,@{$types})) {
+                next;
+            } 
+        } else {
+            if ($status ne 'active') {
+                next;
+            }
+        }
         my ($role,$username,$domain,$section)=split(/\:/,$entry);
+        if (ref($roledoms) eq 'ARRAY') {
+            if (!grep(/^\Q$domain\E$/,@{$roledoms})) {
+                next;
+            }
+        }
+        if (ref($roles) eq 'ARRAY') {
+            if (!grep(/^\Q$role\E$/,@{$roles})) {
+                next;
+            }
+        } 
 	$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
-     }
+    }
     return %returnhash;
 }
 
@@ -7947,6 +7971,9 @@
 plaintext($short) : return value in %prp hash (rolesplain.tab); plain text
 explanation of a user role term
 
+=item *
+
+get_my_roles($uname,$udom,$types,$roles,$roledoms) : All arguments are optional.  Returns a hash of a user's roles, with keys set to colon-sparated $uname,$udom,and $role, and value set to colon-separated start and end times for the role. If no username and domain are specified, will default to current user/domain. Types, roles, and roledoms are references to arrays, of role statuses (active, future or previous), roles (e.g., cc,in, st etc.) and domains of the roles which can be used to restrict the list if roles reported. If no array ref is provided for types, will default to return only active roles.  
 =back
 
 =head2 User Modification