--- loncom/lond 2004/06/29 15:19:56 1.203 +++ loncom/lond 2004/08/02 21:02:20 1.205.2.1 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.203 2004/06/29 15:19:56 albertel Exp $ +# $Id: lond,v 1.205.2.1 2004/08/02 21:02:20 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -50,13 +50,14 @@ use File::Copy; use LONCAPA::ConfigFileEdit; use LONCAPA::lonlocal; use LONCAPA::lonssl; +use Fcntl qw(:flock); -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.203 $'; #' stupid emacs +my $VERSION='$Revision: 1.205.2.1 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -1145,10 +1146,11 @@ sub checkchildren { &logthis('Going to check on the children'); my $docdir=$perlvar{'lonDocRoot'}; foreach (sort keys %children) { - sleep 1; + #sleep 1; unless (kill 'USR1' => $_) { &logthis ('Child '.$_.' is dead'); &logstatus($$.' is dead'); + delete($children{$_}); } } sleep 5; @@ -1166,6 +1168,7 @@ sub checkchildren { #my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`; #$execdir=$perlvar{'lonDaemons'}; #$result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`; + delete($children{$_}); alarm(0); } } @@ -1173,6 +1176,7 @@ sub checkchildren { $SIG{ALRM} = 'DEFAULT'; $SIG{__DIE__} = \&catchexception; &status("Finished checking children"); + &logthis('Finished Checking children'); } # --------------------------------------------------------------------- Logging @@ -1217,17 +1221,19 @@ sub logstatus { &status("Doing logging"); my $docdir=$perlvar{'lonDocRoot'}; { - my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); - print $fh $$."\t".$clientname."\t".$currenthostid."\t" - .$status."\t".$lastlog."\t $keymode\n"; - $fh->close(); - } - &status("Finished londstatus.txt"); - { my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt"); print $fh $status."\n".$lastlog."\n".time."\n$keymode"; $fh->close(); } + &status("Finished $$.txt"); + { + open(LOG,">>$docdir/lon-status/londstatus.txt"); + flock(LOG,LOCK_EX); + print LOG $$."\t".$clientname."\t".$currenthostid."\t" + .$status."\t".$lastlog."\t $keymode\n"; + flock(DB,LOCK_UN); + close(LOG); + } &status("Finished logging"); } @@ -3214,6 +3220,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 +3653,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)