From db100bf2aacab3c8a6e09569b0f9a166dc4996c5 Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 23 Jun 2004 19:38:40 +0000 Subject: [PATCH] add set/believe code --- cmd/set/believe.pl | 38 ++++++++++++++++++++++++++++++++++++++ cmd/unset/believe.pl | 34 ++++++++++++++++++++++++++++++++++ perl/DXUser.pm | 19 +++++++++++++++++++ perl/Messages | 2 ++ 4 files changed, 93 insertions(+) create mode 100644 cmd/set/believe.pl create mode 100644 cmd/unset/believe.pl diff --git a/cmd/set/believe.pl b/cmd/set/believe.pl new file mode 100644 index 00000000..aa31b365 --- /dev/null +++ b/cmd/set/believe.pl @@ -0,0 +1,38 @@ +# +# Add a believable node - used to filter nodes as being believable +# +# Copyright (c) 2004 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, uc $line; +my $call; +my $node = shift @args; +my @out; +my @nodes; + +return (1, $self->msg('e5')) if $self->priv < 6; +return (1, $self->msg('e22', $node)) unless is_callsign($node); +my $user = DXUser->get_current($node); +return (1, $self->msg('e13', $node)) unless $user->is_node; + +foreach $call (@args) { + return (1, $self->msg('e22', $node)) unless is_callsign($call); + + my $u = DXUser->get_current($call); + if ($u->is_node) { + push @nodes, $call; + } else { + push @out, $self->msg('e13', $call); + } +} + +foreach $call (@nodes) { + $user->set_believe($call); + push @out, $self->msg('believes', $call, $node); +} +$user->put if @nodes; + +return (1, @out); diff --git a/cmd/unset/believe.pl b/cmd/unset/believe.pl new file mode 100644 index 00000000..4ee33f50 --- /dev/null +++ b/cmd/unset/believe.pl @@ -0,0 +1,34 @@ +# +# Add a believable node - used to filter nodes as being believable +# +# Copyright (c) 2004 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +my @args = split /\s+/, uc $line; +my $call; +my $node = shift @args; +my @out; +my @nodes; + +return (1, $self->msg('e5')) if $self->priv < 6; +return (1, $self->msg('e22', $node)) unless is_callsign($node); +my $user = DXUser->get_current($node); +return (1, $self->msg('e13', $node)) unless $user->is_node; + +foreach $call (@args) { + return (1, $self->msg('e22', $node)) unless is_callsign($call); + + my $u = DXUser->get_current($call); + push @nodes, $call; +} + +foreach $call (@nodes) { + $user->unset_believe($call); + push @out, $self->msg('believeu', $call, $node); +} +$user->put if @nodes; + +return (1, @out); diff --git a/perl/DXUser.pm b/perl/DXUser.pm index b254ae5a..f371161b 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -92,6 +92,7 @@ $v3 = 0; prompt => '0,Required Prompt', version => '1,Version', build => '1,Build', + believe => '1,Believable nodes,parray', ); #no strict; @@ -777,6 +778,24 @@ sub unset_passphrase my $self = shift; delete $self->{passphrase}; } + +sub set_believe +{ + my $self = shift; + my $call = uc shift; + $self->{believe} ||= []; + push @{$self->{believe}}, $call; +} + +sub unset_believe +{ + my $self = shift; + my $call = uc shift; + if (exists $self->{believe}) { + $self->{believe} = [grep {$_ ne $call} @{$self->{believe}}]; + delete $self->{believe} unless @{$self->{believe}}; + } +} 1; __END__ diff --git a/perl/Messages b/perl/Messages index 6233bfe1..e7356ba2 100644 --- a/perl/Messages +++ b/perl/Messages @@ -24,6 +24,8 @@ package DXM; bbs => 'Your BBS Address is now \"$_[0]\"', beepoff => 'Beeps are now off', beepon => 'Beeps are now on', + believes => 'Believe node $_[0] via $_[1]', + believeu => 'Don\'t believe node $_[0] via $_[1]', call1 => 'Callsign lookup via $_[0]:', conother => 'Sorry $_[0] you are connected to me on another port', concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster (on $_[1])', -- 2.34.1