--- loncom/lonnet/perl/lonnet.pm 2006/10/13 04:23:15 1.791 +++ loncom/lonnet/perl/lonnet.pm 2006/10/16 19:39:57 1.793 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.791 2006/10/13 04:23:15 raeburn Exp $ +# $Id: lonnet.pm,v 1.793 2006/10/16 19:39:57 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4217,13 +4217,14 @@ sub auto_photoupdate { } sub auto_instcode_format { - my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_; + my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles, + $cat_order) = @_; my $courses = ''; my @homeservers; if ($caller eq 'global') { - foreach my $tryserver (keys %libserv) { + foreach my $tryserver (keys(%libserv)) { if ($hostdom{$tryserver} eq $codedom) { - if (!grep/^\Q$tryserver\E$/,@homeservers) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { push(@homeservers,$tryserver); } } @@ -4231,8 +4232,8 @@ sub auto_instcode_format { } else { push(@homeservers,&homeserver($caller,$codedom)); } - foreach (keys %{$instcodes}) { - $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&'; + foreach my $code (keys(%{$instcodes})) { + $courses .= &escape($code).'='.&escape($$instcodes{$code}).'&'; } chop($courses); my $ok_response = 0; @@ -4242,7 +4243,7 @@ sub auto_instcode_format { $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server); if ($response !~ /(con_lost|error|no_such_host|refused)/) { my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = - split/:/,$response; + split/:/,$response; %{$codes} = (%{$codes},&str2hash($codes_str)); push(@{$codetitles},&str2array($codetitles_str)); %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str)); @@ -4257,6 +4258,40 @@ sub auto_instcode_format { } } +sub auto_instcode_defaults { + my ($domain,$returnhash,$code_order) = @_; + my @homeservers; + foreach my $tryserver (keys(%libserv)) { + if ($hostdom{$tryserver} eq $domain) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { + push(@homeservers,$tryserver); + } + } + } + my $ok_response = 0; + my $response; + while (@homeservers > 0 && $ok_response == 0) { + my $server = shift(@homeservers); + $response=&reply('autoinstcodedefaults:'.$domain,$server); + if ($response !~ /(con_lost|error|no_such_host|refused)/) { + foreach my $pair (split(/\&/,$response)) { + my ($name,$value)=split(/\=/,$pair); + if ($name eq 'code_order') { + $code_order = [split(/\&/,&unescape($value))]; + } else { + $$returnhash{&unescape($name)}=&unescape($value); + } + } + } + $ok_response = 1; + } + if ($ok_response) { + return 'ok'; + } else { + return $response; + } +} + sub auto_validate_class_sec { my ($cdom,$cnum,$owner,$inst_class) = @_; my $homeserver = &homeserver($cnum,$cdom);