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

[matthew]

matthew		Wed Oct 16 10:48:20 2002 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Added &getsection which returns the section of a user even if their role
  in the class has expired.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.297 loncom/lonnet/perl/lonnet.pm:1.298
--- loncom/lonnet/perl/lonnet.pm:1.297	Mon Oct 14 11:33:26 2002
+++ loncom/lonnet/perl/lonnet.pm	Wed Oct 16 10:48:20 2002
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.297 2002/10/14 15:33:26 matthew Exp $
+# $Id: lonnet.pm,v 1.298 2002/10/16 14:48:20 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -592,6 +592,59 @@
 }
 
 # ------------------------------------- Find the section of student in a course
+
+sub getsection {
+    my ($udom,$unam,$courseid)=@_;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    my %Pending; 
+    my %Expired;
+    #
+    # Each role can either have not started yet (pending), be active, 
+    #    or have expired.
+    #
+    # If there is an active role, we are done.
+    #
+    # If there is more than one role which has not started yet, 
+    #     choose the one which will start sooner
+    # If there is one role which has not started yet, return it.
+    #
+    # If there is more than one expired role, choose the one which ended last.
+    # If there is a role which has expired, return it.
+    #
+    foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+                        &homeserver($unam,$udom)))) {
+        my ($key,$value)=split(/\=/,$_);
+        $key=&unescape($key);
+        next if ($key !~/^$courseid(?:\/)*(\w+)*\_st$/);
+        my $section=$1;
+        if ($key eq $courseid.'_st') { $section=''; }
+        my ($dummy,$end,$start)=split(/\_/,&unescape($value));
+        my $now=time;
+        if (defined($end) && ($now > $end)) {
+            $Expired{$end}=$section;
+            next;
+        }
+        if (defined($start) && ($now < $start)) {
+            $Pending{$start}=$section;
+            next;
+        }
+        return $section;
+    }
+    #
+    # Presumedly there will be few matching roles from the above
+    # loop and the sorting time will be negligible.
+    if (scalar(keys(%Pending))) {
+        my ($time) = sort {$a <=> $b} keys(%Pending);
+        return $Pending{$time};
+    } 
+    if (scalar(keys(%Expired))) {
+        my @sorted = sort {$a <=> $b} keys(%Expired);
+        my $time = pop(@sorted);
+        return $Expired{$time};
+    }
+    return '-1';
+}
 
 sub usection {
     my ($udom,$unam,$courseid)=@_;