X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=d88d879ee9678d7209a89c546bb3375cd6e85858;hb=654c9b77424b948f88816e0ef28bf4a27331afdb;hp=13286cc5f706f0501be05f6f84c09c7fc33df648;hpb=9e2fbafcfdab1ee45e581524311f1a97ac41f6ad;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 13286cc5..d88d879e 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -24,9 +24,11 @@ use DXLogPrint; use DXBearing; use CmdAlias; use Filter; -use Carp; use Minimuf; use DXDb; +use AnnTalk; +use WCY; +use Sun; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase); @@ -44,7 +46,6 @@ $scriptbase = "$main::root/scripts"; # the place where all users start scripts g sub new { my $self = DXChannel::alloc(@_); - $self->{'sort'} = 'U'; # in absence of how to find out what sort of an object I am return $self; } @@ -65,19 +66,35 @@ sub start $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv; $self->{lang} = $user->lang; - $self->{pagelth} = 20; + $self->{pagelth} = $user->pagelth || 20; $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later $self->{consort} = $line; # save the connection type # set some necessary flags on the user if they are connecting - $self->{beep} = $self->{wwv} = $self->{wx} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1; - # $self->prompt() if $self->{state} =~ /^prompt/o; - + $self->{beep} = $user->wantbeep; + $self->{ann} = $user->wantann; + $self->{wwv} = $user->wantwwv; + $self->{wcy} = $user->wantwcy; + $self->{talk} = $user->wanttalk; + $self->{wx} = $user->wantwx; + $self->{dx} = $user->wantdx; + $self->{logininfo} = $user->wantlogininfo; + $self->{here} = 1; + + # clean up qra locators + my $qra = $user->qra; + $qra = undef if ($qra && !DXBearing::is_qra($qra)); + unless ($qra) { + my $lat = $user->lat; + my $long = $user->long; + $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long); + } + # add yourself to the database my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database"; my $cuser = DXNodeuser->new($self, $node, $call, 0, 1); $node->dxchan($self) if $call eq $main::myalias; # send all output for mycall to myalias - + # issue a pc16 to everybody interested my $nchan = DXChannel->get($main::mycall); my @pc16 = DXProt::pc16($nchan, $cuser); @@ -85,7 +102,7 @@ sub start DXProt::broadcast_all_ak1a($_); } Log('DXCommand', "$call connected"); - + # send prompts and things my $info = DXCluster::cluster(); $self->send("Cluster:$info"); @@ -94,9 +111,16 @@ sub start $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; $self->send($self->msg('m9')) if DXMsg::for_me($call); + $self->send($self->msg('pr', $call)); + # decide on echo + if (!$user->wantecho) { + $self->send_now('E', "0"); + $self->send($self->msg('echow')); + } + + $self->tell_login('loginu'); - $self->send($self->msg('pr', $call)); } # @@ -168,8 +192,7 @@ sub normal $self->send($self->msg('page', scalar @ans)); } else { for (@ans) { - s/\s+$//o; # why ????????? - $self->send($_); + $self->send($_) if $_; } } } @@ -206,7 +229,8 @@ sub run_cmd $cmdline =~ s|//|/|og; # split the command line up into parts, the first part is the command - my ($cmd, $args) = $cmdline =~ /^([\S\/]+)\s*(.*)/o; + my ($cmd, $args) = split /\s+/, $cmdline, 2; + $args = "" unless $args; if ($cmd) { @@ -217,7 +241,8 @@ sub run_cmd # alias it if possible my $acmd = CmdAlias::get_cmd($cmd); if ($acmd) { - ($cmd, $args) = "$acmd $args" =~ /^([\w\/]+)\s*(.*)/o; + ($cmd, $args) = split /\s+/, "$acmd $args", 2; + $args = "" unless $args; dbg('command', "aliased cmd: $cmd $args"); } @@ -234,19 +259,22 @@ sub run_cmd if ($package) { dbg('command', "package: $package"); my $c; - unless (exists $Cache{$package}->{sub}) { - $c = eval $Cache{$package}->{eval}; + unless (exists $Cache{$package}->{'sub'}) { + $c = eval $Cache{$package}->{'eval'}; if ($@) { - return ("Syserr: Syntax error in $package", $@); + return DXDebug::shortmess($@); } - $Cache{$package}->{sub} = $c; + $Cache{$package}->{'sub'} = $c; } - $c = $Cache{$package}->{sub}; + $c = $Cache{$package}->{'sub'}; eval { @ans = &{$c}($self, $args); }; - return ($@) if $@; + if ($@) { + cluck($@); + return (DXDebug::shortmess($@)); + }; } } else { dbg('command', "cmd: $cmd not found"); @@ -286,10 +314,14 @@ sub process sub finish { my $self = shift; + my $conn = shift; my $call = $self->call; + # I was the last node visited + $self->user->node($main::mycall); + # log out text - if (-e "$main::data/logout") { + if ($conn && -e "$main::data/logout") { open(I, "$main::data/logout") or confess; my @in = ; close(I); @@ -301,14 +333,17 @@ sub finish my $node = DXNode->get($main::mycall); $node->{dxchan} = 0; } - my $ref = DXCluster->get_exact($call); # issue a pc17 to everybody interested my $nchan = DXChannel->get($main::mycall); my $pc17 = $nchan->pc17($self); DXProt::broadcast_all_ak1a($pc17); - + + # send info to all logged in thingies + $self->tell_login('logoutu'); + Log('DXCommand', "$call disconnected"); + my $ref = DXCluster->get_exact($call); $ref->del() if $ref; } @@ -518,7 +553,7 @@ sub find_cmd_name { } } - $Cache{$package} = {mtime => $mtime, eval => $eval }; + $Cache{$package} = {mtime => $mtime, 'eval' => $eval }; } return $package;