--- loncom/lond 2004/06/29 14:56:32 1.202 +++ loncom/lond 2004/07/22 23:08:43 1.206 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.202 2004/06/29 14:56:32 raeburn Exp $ +# $Id: lond,v 1.206 2004/07/22 23:08:43 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -51,12 +51,12 @@ use LONCAPA::ConfigFileEdit; use LONCAPA::lonlocal; use LONCAPA::lonssl; -my $DEBUG = 11; # Non zero to enable debug log entries. +my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.202 $'; #' stupid emacs +my $VERSION='$Revision: 1.206 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -354,7 +354,6 @@ sub ReadManagerTable { while(my $host = ) { chomp($host); if ($host =~ "^#") { # Comment line. - logthis(' Skipping line: '. "$host\n"); next; } if (!defined $hostip{$host}) { # This is a non cluster member @@ -2233,11 +2232,14 @@ sub make_new_child { # ------------------------------------------------------------------------- put } elsif ($userinput =~ /^put/) { if(isClient) { - my ($cmd,$udom,$uname,$namespace,$what) + my ($cmd,$udom,$uname,$namespace,$what,@extras) =split(/:/,$userinput); $namespace=~s/\//\_/g; $namespace=~s/\W//g; if ($namespace ne 'roles') { + if (@extras) { + $what .= ':'.join(':',@extras); + } chomp($what); my $proname=propath($udom,$uname); my $now=time; @@ -3215,6 +3217,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 { @@ -3622,6 +3650,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)