projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
make sure there is a route structure available for PC24 and 41
[spider.git]
/
perl
/
DXCommandmode.pm
diff --git
a/perl/DXCommandmode.pm
b/perl/DXCommandmode.pm
index 8c7b67fda32f11a5f64c8dd15e2a0975ea83cc36..32b1f86c4cade33ca79f84a633b43d2f5f2aec99 100644
(file)
--- a/
perl/DXCommandmode.pm
+++ b/
perl/DXCommandmode.pm
@@
-48,6
+48,13
@@
$maxerrors = 20; # the maximum number of concurrent errors allowed before dis
sub new
{
my $self = DXChannel::alloc(@_);
sub new
{
my $self = DXChannel::alloc(@_);
+
+ # routing, this must go out here to prevent race condx
+ my $pkg = shift;
+ my $call = shift;
+ my @rout = $main::routeroot->add_user($call, Route::here(1));
+ DXProt::route_pc16($DXProt::me, $main::routeroot, @rout) if @rout;
+
return $self;
}
return $self;
}
@@
-100,10
+107,6
@@
sub start
$DXProt::me->conn($self->conn) if $call eq $main::myalias; # send all output for mycall to myalias
$DXProt::me->conn($self->conn) if $call eq $main::myalias; # send all output for mycall to myalias
- # routing version
- my @rout = $main::routeroot->add_user($call, Route::here($self->{here}));
- dbg('route', "B/C PC16 on $main::mycall for: $call") if @rout;
- DXProt::route_pc16($DXProt::me, $main::routeroot, @rout) if @rout;
Log('DXCommand', "$call connected");
# send prompts and things
Log('DXCommand', "$call connected");
# send prompts and things
@@
-285,7
+288,7
@@
sub run_cmd
if ($self->{func}) {
my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) };
if ($self->{func}) {
my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) };
- dbg(
'eval', "stored func cmd = $c\n"
);
+ dbg(
"stored func cmd = $c\n") if isdbg('eval'
);
eval $c;
if ($@) {
return ("Syserr: Eval err $errstr on stored func $self->{func}", $@);
eval $c;
if ($@) {
return ("Syserr: Eval err $errstr on stored func $self->{func}", $@);
@@
-305,14
+308,14
@@
sub run_cmd
my ($path, $fcmd);
my ($path, $fcmd);
- dbg(
'command', "cmd: $cmd"
);
+ dbg(
"cmd: $cmd") if isdbg('command'
);
# alias it if possible
my $acmd = CmdAlias::get_cmd($cmd);
if ($acmd) {
($cmd, $args) = split /\s+/, "$acmd $args", 2;
$args = "" unless defined $args;
# alias it if possible
my $acmd = CmdAlias::get_cmd($cmd);
if ($acmd) {
($cmd, $args) = split /\s+/, "$acmd $args", 2;
$args = "" unless defined $args;
- dbg(
'command', "aliased cmd: $cmd $args"
);
+ dbg(
"aliased cmd: $cmd $args") if isdbg('command'
);
}
# first expand out the entry to a command
}
# first expand out the entry to a command
@@
-320,13
+323,13
@@
sub run_cmd
($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd;
if ($path && $cmd) {
($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd;
if ($path && $cmd) {
- dbg(
'command', "path: $cmd cmd: $fcmd"
);
+ dbg(
"path: $cmd cmd: $fcmd") if isdbg('command'
);
my $package = find_cmd_name($path, $fcmd);
@ans = (0) if !$package ;
if ($package) {
my $package = find_cmd_name($path, $fcmd);
@ans = (0) if !$package ;
if ($package) {
- dbg(
'command', "package: $package"
);
+ dbg(
"package: $package") if isdbg('command'
);
my $c;
unless (exists $Cache{$package}->{'sub'}) {
$c = eval $Cache{$package}->{'eval'};
my $c;
unless (exists $Cache{$package}->{'sub'}) {
$c = eval $Cache{$package}->{'eval'};
@@
-346,7
+349,7
@@
sub run_cmd
};
}
} else {
};
}
} else {
- dbg(
'command', "cmd: $cmd not found"
);
+ dbg(
"cmd: $cmd not found") if isdbg('command'
);
if (++$self->{errors} > $maxerrors) {
$self->send($self->msg('e26'));
$self->disconnect;
if (++$self->{errors} > $maxerrors) {
$self->send($self->msg('e26'));
$self->disconnect;
@@
-406,7
+409,7
@@
sub disconnect
}
my @rout = $main::routeroot->del_user($call);
}
my @rout = $main::routeroot->del_user($call);
- dbg(
'route', "B/C PC17 on $main::mycall for: $call"
);
+ dbg(
"B/C PC17 on $main::mycall for: $call") if isdbg('route'
);
# issue a pc17 to everybody interested
DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout;
# issue a pc17 to everybody interested
DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout;
@@
-481,7
+484,7
@@
sub search
# commands are lower case
$short_cmd = lc $short_cmd;
# commands are lower case
$short_cmd = lc $short_cmd;
- dbg(
'command', "command: $path $short_cmd\n"
);
+ dbg(
"command: $path $short_cmd\n") if isdbg('command'
);
# do some checking for funny characters
return () if $short_cmd =~ /\/$/;
# do some checking for funny characters
return () if $short_cmd =~ /\/$/;
@@
-489,7
+492,7
@@
sub search
# return immediately if we have it
($apath, $acmd) = split ',', $cmd_cache{$short_cmd} if $cmd_cache{$short_cmd};
if ($apath && $acmd) {
# return immediately if we have it
($apath, $acmd) = split ',', $cmd_cache{$short_cmd} if $cmd_cache{$short_cmd};
if ($apath && $acmd) {
- dbg(
'command', "cached $short_cmd = ($apath, $acmd)\n"
);
+ dbg(
"cached $short_cmd = ($apath, $acmd)\n") if isdbg('command'
);
return ($apath, $acmd);
}
return ($apath, $acmd);
}
@@
-511,7
+514,7
@@
sub search
next if $l =~ /^\./;
if ($i < $#parts) { # we are dealing with directories
if ((-d "$curdir/$l") && $p eq substr($l, 0, length $p)) {
next if $l =~ /^\./;
if ($i < $#parts) { # we are dealing with directories
if ((-d "$curdir/$l") && $p eq substr($l, 0, length $p)) {
- dbg(
'command', "got dir: $curdir/$l\n"
);
+ dbg(
"got dir: $curdir/$l\n") if isdbg('command'
);
$dirfn .= "$l/";
$curdir .= "/$l";
last;
$dirfn .= "$l/";
$curdir .= "/$l";
last;
@@
-525,7
+528,7
@@
sub search
# chop $dirfn; # remove trailing /
$dirfn = "" unless $dirfn;
$cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it
# chop $dirfn; # remove trailing /
$dirfn = "" unless $dirfn;
$cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it
- dbg(
'command', "got path: $path cmd: $dirfn$l\n"
);
+ dbg(
"got path: $path cmd: $dirfn$l\n") if isdbg('command'
);
return ($path, "$dirfn$l");
}
}
return ($path, "$dirfn$l");
}
}
@@
-624,7
+627,7
@@
sub find_cmd_name {
my @list = split /\n/, $eval;
my $line;
for (@list) {
my @list = split /\n/, $eval;
my $line;
for (@list) {
- dbg(
'eval', $_, "\n"
);
+ dbg(
$_ . "\n") if isdbg('eval'
);
}
}
}
}