--- loncom/lond 2004/06/29 15:31:32 1.204 +++ loncom/lond 2004/07/03 18:49:42 1.205 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.204 2004/06/29 15:31:32 albertel Exp $ +# $Id: lond,v 1.205 2004/07/03 18:49:42 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -56,7 +56,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.204 $'; #' stupid emacs +my $VERSION='$Revision: 1.205 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -3214,6 +3214,32 @@ sub make_new_child { } else { print $client "refused\n"; } +#--------------------- read and retrieve institutional code format (for support form). + } elsif ($userinput =~/^autoinstcodeformat:/) { + if (isClient) { + my $reply; + my($cmd,$cdom,$course) = split(/:/,$userinput); + my @pairs = split/\&/,$course; + my %instcodes = (); + my %codes = (); + my @codetitles = (); + my %cat_titles = (); + my %cat_order = (); + foreach (@pairs) { + my ($key,$value) = split/=/,$_; + $instcodes{&unescape($key)} = &unescape($value); + } + my $formatreply = &localenroll::instcode_format($cdom,\%instcodes,\%codes,\@codetitles,\%cat_titles,\%cat_order); + if ($formatreply eq 'ok') { + my $codes_str = &hash2str(%codes); + my $codetitles_str = &array2str(@codetitles); + my $cat_titles_str = &hash2str(%cat_titles); + my $cat_order_str = &hash2str(%cat_order); + print $client $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':'.$cat_order_str."\n"; + } + } else { + print $client "refused\n"; + } # ------------------------------------------------------------- unknown command } else { @@ -3621,6 +3647,73 @@ sub userload { return $userloadpercent; } +# Routines for serializing arrays and hashes (copies from lonnet) + +sub array2str { + my (@array) = @_; + my $result=&arrayref2str(\@array); + $result=~s/^__ARRAY_REF__//; + $result=~s/__END_ARRAY_REF__$//; + return $result; +} + +sub arrayref2str { + my ($arrayref) = @_; + my $result='__ARRAY_REF__'; + foreach my $elem (@$arrayref) { + if(ref($elem) eq 'ARRAY') { + $result.=&arrayref2str($elem).'&'; + } elsif(ref($elem) eq 'HASH') { + $result.=&hashref2str($elem).'&'; + } elsif(ref($elem)) { + #print("Got a ref of ".(ref($elem))." skipping."); + } else { + $result.=&escape($elem).'&'; + } + } + $result=~s/\&$//; + $result .= '__END_ARRAY_REF__'; + return $result; +} + +sub hash2str { + my (%hash) = @_; + my $result=&hashref2str(\%hash); + $result=~s/^__HASH_REF__//; + $result=~s/__END_HASH_REF__$//; + return $result; +} + +sub hashref2str { + my ($hashref)=@_; + my $result='__HASH_REF__'; + foreach (sort(keys(%$hashref))) { + if (ref($_) eq 'ARRAY') { + $result.=&arrayref2str($_).'='; + } elsif (ref($_) eq 'HASH') { + $result.=&hashref2str($_).'='; + } elsif (ref($_)) { + $result.='='; + #print("Got a ref of ".(ref($_))." skipping."); + } else { + if ($_) {$result.=&escape($_).'=';} else { last; } + } + + if(ref($hashref->{$_}) eq 'ARRAY') { + $result.=&arrayref2str($hashref->{$_}).'&'; + } elsif(ref($hashref->{$_}) eq 'HASH') { + $result.=&hashref2str($hashref->{$_}).'&'; + } elsif(ref($hashref->{$_})) { + $result.='&'; + #print("Got a ref of ".(ref($hashref->{$_}))." skipping."); + } else { + $result.=&escape($hashref->{$_}).'&'; + } + } + $result=~s/\&$//; + $result .= '__END_HASH_REF__'; + return $result; +} # ----------------------------------- POD (plain old documentation, CPAN style)