From 6f9f47b53d1b6c2a52722b525695fa1c03ab1ed7 Mon Sep 17 00:00:00 2001 From: djk Date: Wed, 3 Nov 1999 21:13:11 +0000 Subject: [PATCH] changed the command mode subs thing to use anonymous subs allow locally connect clusters to appear in the node list even if they don't issue PC19s (but do issue PC16s) --- Changes | 5 +++ perl/DXCommandmode.pm | 72 ++++++++++--------------------------------- perl/DXProt.pm | 10 ++++-- perl/cluster.pl | 2 +- 4 files changed, 30 insertions(+), 59 deletions(-) diff --git a/Changes b/Changes index 6b84bee7..c53af39d 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +03Nov99======================================================================= +1. Simplified command caching so it uses anonymous subroutines, you should +also get error messages back on the console now when developing. +2. Allow locally connected AK1A clusters that for some obscure reason don't +issue PC19s to still appear as connected and allow them to acquire users. 31Oct99======================================================================= 1. updated Minimuf.pm and show/muf.pl to the fixed versions sent to me by Steve Franke K9AN. diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index f2ba3745..12c84c00 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -195,7 +195,7 @@ sub run_cmd dbg('eval', "stored func cmd = $c\n"); eval $c; if ($@) { - return (1, "Syserr: Eval err $errstr on stored func $self->{func}"); + return ("Syserr: Eval err $errstr on stored func $self->{func}", $@); } } else { @@ -232,31 +232,25 @@ sub run_cmd if ($package) { dbg('command', "package: $package"); - - my $c = qq{ \@ans = $package(\$self, \$args) }; - dbg('eval', "cluster cmd = $c\n"); - eval $c; - if ($@) { - @ans = (0, "Syserr: Eval err cached $package\n$@"); + my $c; + unless (exists $Cache{$package}->{sub}) { + $c = eval $Cache{$package}->{eval}; + if ($@) { + return ("Syserr: Syntax error in $package", $@); + } + $Cache{$package}->{sub} = $c; } + $c = $Cache{$package}->{sub}; + @ans = &{$c}($self, $args); } } else { dbg('command', "cmd: $cmd not found"); - @ans = (0); + return ($self->msg('e1')); } } } - if ($ans[0]) { - shift @ans; - } else { - shift @ans; - if (@ans > 0) { - unshift @ans, $self->msg('e2'); - } else { - @ans = $self->msg('e1'); - } - } + shift @ans; return (@ans); } @@ -443,22 +437,7 @@ sub valid_package_name { #Dress it up as a real package name $string =~ s/\//_/og; - return "Emb_" . $string; -} - -#borrowed from Safe.pm -sub delete_package { - my $pkg = shift; - my ($stem, $leaf); - - no strict 'refs'; - $pkg = "DXCommandmode::$pkg\::"; # expand to full symbol table name - ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; - - if ($stem && $leaf) { - my $stem_symtab = *{$stem}{HASH}; - delete $stem_symtab->{$leaf}; - } + return $string; } # find a cmd reference @@ -502,13 +481,12 @@ sub find_cmd_name { return undef; } - if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) { + if(defined $Cache{$package}->{mtime} &&$Cache{$package}->{mtime} <= $mtime) { #we have compiled this subroutine already, #it has not been updated on disk, nothing left to do #print STDERR "already compiled $package->handler\n"; ; } else { - delete_package($package) if defined $Cache{$package}{mtime}; my $fh = new IO::File; if (!open $fh, $filename) { @@ -520,7 +498,7 @@ sub find_cmd_name { close $fh; #wrap the code into a subroutine inside our unique package - my $eval = qq{ sub $package { $sub } }; + my $eval = qq( sub { $sub } ); if (isdbg('eval')) { my @list = split /\n/, $eval; @@ -530,25 +508,9 @@ sub find_cmd_name { } } - { - #hide our variables within this block - my($filename,$mtime,$package,$sub); - eval $eval; - } - - if ($@) { - print "\$\@ = $@"; - $errstr = $@; - delete_package($package); - } else { - #cache it unless we're cleaning out each time - $Cache{$package}{'mtime'} = $mtime; - } + $Cache{$package} = {mtime => $mtime, eval => $eval }; } - - #print Devel::Symdump->rnew($package)->as_string, $/; - $package = "DXCommandmode::$package" if $package; - $package = undef if $errstr; + return $package; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index ee8c4aa9..32d5e3b3 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -313,20 +313,24 @@ sub normal if ($pcno == 16) { # add a user my $node = DXCluster->get_exact($field[1]); + my $dxchan; + if (!$node && ($dxchan = DXChannel->get($field[1]))) { + # add it to the node table if it isn't present and it's + # connected locally + $node = DXNode->new($dxchan, $field[1], 0, 1, 5400); + } return unless $node; # ignore if havn't seen a PC19 for this one yet return unless $node->isa('DXNode'); if ($node->dxchan != $self) { dbg('chan', "LOOP: $field[1] came in on wrong channel"); return; } - my $dxchan; if (($dxchan = DXChannel->get($field[1])) && $dxchan != $self) { dbg('chan', "LOOP: $field[1] connected locally"); return; } my $i; - - + for ($i = 2; $i < $#field; $i++) { my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; next if !$call || length $call < 3 || length $call > 8; diff --git a/perl/cluster.pl b/perl/cluster.pl index ceb099ca..308b1d90 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -67,7 +67,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.33"; # the version no of the software +$version = "1.34"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name -- 2.43.0