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

[raeburn]

raeburn		Thu Jun 11 19:19:58 2009 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Request course creation
    - &auto_possible_instcodes() added to lonnet.pm to retrieve acceptable values for institutional categories (e.g., Year, Semester, Department).
    - corresponding &get_possible_instcodes_handler() added to lond
      - requires customization of a &possible_instcodes() routine lin localenroll.pm
  
  
Index: loncom/lond
diff -u loncom/lond:1.415 loncom/lond:1.416
--- loncom/lond:1.415	Fri May  8 12:02:39 2009
+++ loncom/lond	Thu Jun 11 19:19:51 2009
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.415 2009/05/08 12:02:39 raeburn Exp $
+# $Id: lond,v 1.416 2009/06/11 19:19:51 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -59,7 +59,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.415 $'; #' stupid emacs
+my $VERSION='$Revision: 1.416 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -4928,6 +4928,37 @@
 &register_handler("autoinstcodedefaults",
                   \&get_institutional_defaults_handler,0,1,0);
 
+sub get_possible_instcodes_handler {
+    my ($cmd, $tail, $client)   = @_;
+    my $userinput               = "$cmd:$tail";
+
+    my $reply;
+    my $cdom = $tail;
+    my (@codetitles,%cat_titles,%cat_order);
+    my $formatreply = &localenroll::possible_instcodes($cdom,
+                                                       \@codetitles,
+                                                       \%cat_titles,
+                                                       \%cat_order);
+    if ($formatreply eq 'ok') {
+        my $result = join('&',map {&escape($_);} (@codetitles)).':';
+        foreach my $key (keys(%cat_titles)) {
+            $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_titles{$key}).'&';
+        }
+        $result =~ s/\&$//;
+        $result .= ':';
+        foreach my $key (keys(%cat_order)) {
+            $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_order{$key}).'&';
+        }
+        $result =~ s/\&$//;
+        &Reply($client,\$result,$userinput);
+    } else {
+        &Reply($client, "format_error\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("autopossibleinstcodes",
+                  \&get_possible_instcodes_handler,0,1,0);
+
 sub get_institutional_user_rules {
     my ($cmd, $tail, $client)   = @_;
     my $userinput               = "$cmd:$tail";
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1002 loncom/lonnet/perl/lonnet.pm:1.1003
--- loncom/lonnet/perl/lonnet.pm:1.1002	Thu Jun 11 19:02:32 2009
+++ loncom/lonnet/perl/lonnet.pm	Thu Jun 11 19:19:57 2009
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1002 2009/06/11 19:02:32 raeburn Exp $
+# $Id: lonnet.pm,v 1.1003 2009/06/11 19:19:57 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -5698,7 +5698,40 @@
     }
 
     return $response;
-} 
+}
+
+sub auto_possible_instcodes {
+    my ($domain,$codetitles,$cat_titles,$cat_order) = @_;
+    my (@homeservers,$uhome);
+    if (defined(&domain($domain,'primary'))) {
+        $uhome=&domain($domain,'primary');
+        push(@homeservers,&domain($domain,'primary'));
+    } else {
+        my %servers = &get_servers($domain,'library');
+        foreach my $tryserver (keys(%servers)) {
+            if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+                push(@homeservers,$tryserver);
+            }
+        }
+    }
+    my $response;
+    foreach my $server (@homeservers) {
+        $response=&reply('autopossibleinstcodes:'.$domain,$server);
+        next if ($response =~ /(con_lost|error|no_such_host|refused)/);
+        my ($codetitlestr,$cat_title,$cat_order) = split(':',$response);
+        @{$codetitles} = map { &unescape($_); } (split('&',$codetitlestr));  
+        foreach my $item (split('&',$cat_title)) {   
+            my ($name,$value)=split('&',$item);
+            $cat_titles->{&unescape($name)}=&unescape($value);
+        }
+        foreach my $item (split('&',$cat_order)) {
+            my ($name,$value)=split('&',$item);
+            $cat_order->{&unescape($name)}=&unescape($value);
+        }
+        return 'ok';
+    }
+    return $response;
+}
 
 sub auto_validate_class_sec {
     my ($cdom,$cnum,$owners,$inst_class) = @_;