summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
a89e605)
allow locally connect clusters to appear in the node list even if they
don't issue PC19s (but do issue PC16s)
+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.
31Oct99=======================================================================
1. updated Minimuf.pm and show/muf.pl to the fixed versions sent to me by
Steve Franke K9AN.
dbg('eval', "stored func cmd = $c\n");
eval $c;
if ($@) {
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}", $@);
if ($package) {
dbg('command', "package: $package");
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");
}
} else {
dbg('command', "cmd: $cmd not found");
+ 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');
- }
- }
#Dress it up as a real package name
$string =~ s/\//_/og;
#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};
- }
- 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 {
#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) {
my $fh = new IO::File;
if (!open $fh, $filename) {
close $fh;
#wrap the code into a subroutine inside our unique package
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;
if (isdbg('eval')) {
my @list = split /\n/, $eval;
- {
- #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;
if ($pcno == 16) { # add a user
my $node = DXCluster->get_exact($field[1]);
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;
}
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;
}
if (($dxchan = DXChannel->get($field[1])) && $dxchan != $self) {
dbg('chan', "LOOP: $field[1] connected locally");
return;
}
my $i;
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;
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;
@inqueue = (); # the main input queue, an array of hashes
$systime = 0; # the time now (in seconds)
@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
$starttime = 0; # the starting time of the cluster
$lockfn = "cluster.lock"; # lock file name