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

[raeburn]

raeburn		Tue Jul  6 14:02:34 2004 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  sub auto_instcode_format() - used by lonsupportreq.pm to request institutional code translation from localenroll::instcode_format on homeserver of a course.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.520 loncom/lonnet/perl/lonnet.pm:1.521
--- loncom/lonnet/perl/lonnet.pm:1.520	Fri Jul  2 17:55:13 2004
+++ loncom/lonnet/perl/lonnet.pm	Tue Jul  6 14:02:33 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.520 2004/07/02 21:55:13 albertel Exp $
+# $Id: lonnet.pm,v 1.521 2004/07/06 18:02:33 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3203,6 +3203,32 @@
     return ($authparam,$create_passwd,$authchk);
 }
 
+sub auto_instcode_format {
+    my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_;
+    my $courses = '';
+    my $homeserver;
+    if ($caller eq 'global') {
+        $homeserver = $perlvar{'lonHostID'};
+    } else {
+        $homeserver = &homeserver($caller,$codedom);
+    }
+    my $host=$hostname{$homeserver};
+    foreach (keys %{$instcodes}) {
+        $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&';
+    }
+    chop($courses);
+    my $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$homeserver);
+    unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
+        my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = split/:/,$response;
+        %{$codes} = &str2hash($codes_str);
+        @{$codetitles} = &str2array($codetitles_str);
+        %{$cat_titles} = &str2hash($cat_titles_str);
+        %{$cat_order} = &str2hash($cat_order_str);
+        return 'ok';
+    }
+    return $response;
+}
+
 # ------------------------------------------------------------------ Plain Text
 
 sub plaintext {