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

[raeburn]

raeburn		Thu Mar  1 12:51:57 2007 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Routines to retrieve institutional status types (e.g., faculty, staff, student, affiliate) from localenroll.pm on a domain's primary library server.
  
  
Index: loncom/lond
diff -u loncom/lond:1.360 loncom/lond:1.361
--- loncom/lond:1.360	Sun Jan 28 14:23:25 2007
+++ loncom/lond	Thu Mar  1 12:51:44 2007
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.360 2007/01/28 19:23:25 raeburn Exp $
+# $Id: lond,v 1.361 2007/03/01 17:51:44 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -59,7 +59,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.360 $'; #' stupid emacs
+my $VERSION='$Revision: 1.361 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -4630,6 +4630,31 @@
 }
 &register_handler("studentphoto", \&student_photo_handler, 0, 1, 0);
 
+sub inst_usertypes_handler {
+    my ($cmd, $domain, $client) = @_;
+    my $res;
+    my $userinput = $cmd.":".$domain; # For logging purposes.
+    my (%typeshash,@order);  
+    if (&localenroll::inst_usertypes($domain,\%typeshash,\@order) eq 'ok') {
+        if (keys(%typeshash) > 0) {
+            foreach my $key (keys(%typeshash)) {
+                $res.=&escape($key).'='.&escape($typeshash{$key}).'&';
+            }
+        }
+        $res=~s/\&$//;
+        $res .= ':';
+        if (@order > 0) {
+            foreach my $item (@order) {
+                $res .= &escape($item).'&';
+            }
+        }
+        $res=~s/\&$//;
+    }
+    &Reply($client, "$res\n", $userinput);
+    return 1;
+}
+&register_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);
+
 # mkpath makes all directories for a file, expects an absolute path with a
 # file or a trailing / if just a dir is passed
 # returns 1 on success 0 on failure
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.836 loncom/lonnet/perl/lonnet.pm:1.837
--- loncom/lonnet/perl/lonnet.pm:1.836	Fri Feb 23 10:49:23 2007
+++ loncom/lonnet/perl/lonnet.pm	Thu Mar  1 12:51:56 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.836 2007/02/23 15:49:23 www Exp $
+# $Id: lonnet.pm,v 1.837 2007/03/01 17:51:56 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -766,6 +766,30 @@
     }
 }
 
+sub retrieve_inst_usertypes {
+    my ($udom) = @_;
+    my (%returnhash,@order);
+    if (exists($domain_primary{$udom})) {
+        my $uhome=$domain_primary{$udom};
+        my $rep=&reply("inst_usertypes:$udom",$uhome);
+        my ($hashitems,$orderitems) = split(/:/,$rep); 
+        my @pairs=split(/\&/,$hashitems);
+        foreach my $item (@pairs) {
+            my ($key,$value)=split(/=/,$item,2);
+            $key = &unescape($key);
+            next if ($key =~ /^error: 2 /);
+            $returnhash{$key}=&thaw_unescape($value);
+        }
+        my @esc_order = split(/\&/,$orderitems);
+        foreach my $item (@esc_order) {
+            push(@order,&unescape($item));
+        }
+    } else {
+        &logthis("get_dom failed - no primary domain server for $udom");
+    }
+    return (\%returnhash,\@order);
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {