From f3688be5d3f50cccf204d3d01dcaca1e9db7d4f7 Mon Sep 17 00:00:00 2001 From: djk Date: Sun, 23 May 1999 13:06:09 +0000 Subject: [PATCH] added shellregex made sh/c and sh/u sorted added shelregex to sh/dx and dir started making dir more useful --- Changes | 8 +++++- cmd/directory.pl | 54 ++++++++++++++++++++++----------------- cmd/show/configuration.pl | 8 +++--- cmd/show/dx.pl | 19 +++++--------- cmd/show/users.pl | 2 +- perl/DXChannel.pm | 9 ++++--- perl/DXUtil.pm | 17 +++++++++++- 7 files changed, 70 insertions(+), 47 deletions(-) diff --git a/Changes b/Changes index e6603aec..d5fa4718 100644 --- a/Changes +++ b/Changes @@ -1,11 +1,17 @@ 23May99======================================================================= 1. tried to change connection to raw mode for cluster connections +2. sh/c and sh/u are now sorted in alphabetical order +3. Limited the number of queued dx spots when composing messages to 20 (the +oldest one is lost for every one added above 20). +4. Added generalised shell globbing everywhere I think it is useful, including +sh/dx, dir +5. Made dir more friendly and give more info, you can do > < and a number now. 22May99======================================================================= 1. added check for -1 from Date::Parse and return undef for out of range dates 2. added show/files and type commands 21May99======================================================================= 1. made set/nodx work again. -2. made dx stuff queue nicely again. +2. made dx stuff queue nicely again when sending messages. 18May99======================================================================= 1. Added announce dup checking. 2. Added system announce filtering. diff --git a/cmd/directory.pl b/cmd/directory.pl index ab817985..e4bf57bc 100644 --- a/cmd/directory.pl +++ b/cmd/directory.pl @@ -11,34 +11,40 @@ my @f = split /\s+/, $line; my @ref; my $ref; my @out; +my $f; +my $n; -$f[0] = uc $f[0]; -if ($f[0] eq 'ALL') { - foreach $ref (DXMsg::get_all()) { - next if $self->priv < 5 && $ref->private && $ref->to ne $self->call && $ref->from ne $self->call; - push @ref, $ref; - } -} elsif ($f[0] =~ /^O/o) { # dir/own - foreach $ref (DXMsg::get_all()) { - push @ref, $ref if $ref->private && ($ref->to eq $self->call || $ref->from eq $self->call); - } -} elsif ($f[0] =~ /^N/o) { # dir/new - foreach $ref (DXMsg::get_all()) { - push @ref, $ref if $ref->private && !$ref->read && $ref->to eq $self->call; - } -} else { - my @all = (DXMsg::get_all()); - my ($i, $count); - for ($i = $#all; $i > 0; $i--) { - $ref = $all[$i]; - next if $self->priv < 5 && $ref->private && $ref->to ne $self->call && $ref->from ne $self->call; - unshift @ref, $ref; - last if ++$count > 10; - } +while (@f) { + $f = uc shift @f; + if ($f eq 'ALL') { + foreach $ref (DXMsg::get_all()) { + next if $self->priv < 5 && $ref->private && $ref->to ne $self->call && $ref->from ne $self->call; + push @ref, $ref; + } + } elsif ($f =~ /^O/o) { # dir/own + foreach $ref (DXMsg::get_all()) { + push @ref, $ref if $ref->private && ($ref->to eq $self->call || $ref->from eq $self->call); + } + } elsif ($f =~ /^N/o) { # dir/new + foreach $ref (DXMsg::get_all()) { + push @ref, $ref if $ref->private && !$ref->read && $ref->to eq $self->call; + } + } elsif ($f > 0) { # a number of items + $n = $f; + } else { + my @all = (DXMsg::get_all()); + my ($i, $count); + for ($i = $#all; $i > 0; $i--) { + $ref = $all[$i]; + next if $self->priv < 5 && $ref->private && $ref->to ne $self->call && $ref->from ne $self->call; + unshift @ref, $ref; + last if ++$count > $n; + } + } } foreach $ref (@ref) { - push @out, $ref->dir; + push @out, $ref->dir; } return (1, @out); diff --git a/cmd/show/configuration.pl b/cmd/show/configuration.pl index f2f296e5..6f2e1e93 100644 --- a/cmd/show/configuration.pl +++ b/cmd/show/configuration.pl @@ -9,18 +9,18 @@ my ($self, $line) = @_; my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes my @out; -my @nodes = (DXNode::get_all()); +my @nodes = sort {$a->call cmp $b->call} (DXNode::get_all()); my $node; my @l; my @val; push @out, "Node Callsigns"; if ($list[0] && $list[0] =~ /^NOD/) { - my @ch = DXProt::get_all_ak1a(); + my @ch = sort {$a->call cmp $b->call} DXProt::get_all_ak1a(); my $dxchan; foreach $dxchan (@ch) { - @val = grep { $_->dxchan == $dxchan } @nodes; + @val = sort {$a->call cmp $b->call} grep { $_->dxchan == $dxchan } @nodes; my $call = $dxchan->call; $call = "($call)" if $dxchan->here == 0; @l = (); @@ -50,7 +50,7 @@ if ($list[0] && $list[0] =~ /^NOD/) { @l = (); push @l, $call; my $nlist = $node->list; - @val = values %{$nlist}; + @val = sort {$a->call cmp $b->call} values %{$nlist}; my $i = 0; if (@val == 0 && $node->users) { diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index c9869996..d52826df 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -63,14 +63,9 @@ while ($f = shift @list) { # next field # first deal with the prefix if ($pre) { - $expr = "\$f1 =~ /"; - $pre =~ s|/|\\/|; # change the slashes to \/ - if ($pre =~ /^\*/o) { - $pre =~ s/^\*//;; - $expr .= "$pre\$/o"; - } else { - $expr .= "^$pre/o"; - } + $pre .= '*' unless $pre =~ /[\*\?\[]/o; + $pre = shellregex($pre); + $expr = "\$f1 =~ m{$pre}o"; } else { $expr = "1"; # match anything } @@ -90,15 +85,15 @@ if (@freq) { # any info if ($info) { $expr .= " && " if $expr; - $info =~ s|/|\\/|; - $expr .= "\$f3 =~ /$info/io"; + $info = shellregex($info); + $expr .= "\$f3 =~ m{$info}io"; } # any spotter if ($spotter) { $expr .= " && " if $expr; - $spotter =~ s|/|\\/|; - $expr .= "\$f4 =~ /$spotter/o"; + $spotter = shellregex($spotter); + $expr .= "\$f4 =~ m{$spotter}o"; } #print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n"; diff --git a/cmd/show/users.pl b/cmd/show/users.pl index 8cbe8577..55a34bec 100644 --- a/cmd/show/users.pl +++ b/cmd/show/users.pl @@ -16,7 +16,7 @@ my $call; my $i = 0; my @l; my $nlist = $node->list; -my @val = values %{$nlist}; +my @val = sort {$a->call cmp $b->call} values %{$nlist}; foreach $call (@val) { if (@list) { next if !grep $call->call eq $_, @list; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index e3878ecf..9bde6aa8 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -211,7 +211,7 @@ sub msg return DXM::msg($self->{lang}, @_); } -# stick a broadcast on the delayed queue +# stick a broadcast on the delayed queue (but only up to 20 items) sub delay { my $self = shift; @@ -219,6 +219,9 @@ sub delay $self->{delayed} = [] unless $self->{delayed}; push @{$self->{delayed}}, $s; + if (@{$self->{delayed}} >= 20) { + shift @{$self->{delayed}}; # lose oldest one + } } # change the state of the channel - lots of scope for debugging here :-) @@ -233,9 +236,7 @@ sub state # if there is any queued up broadcasts then splurge them out here if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'convers')) { - for (@{$self->{delayed}}) { - $self->send($_); - } + $self->send (@{$self->{delayed}}); delete $self->{delayed}; } } diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 868110ea..a1fb13ba 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -13,11 +13,18 @@ use Carp; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs +@EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf + parray parraypairs shellregex print_all_fields cltounix ); @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); +%patmap = ( + '*' => '.*', + '?' => '.', + '[' => '[', + ']' => ']' +); # a full time for logging and other purposes sub atime @@ -168,3 +175,11 @@ sub print_all_fields return @out; } +# generate a regex from a shell type expression +# see 'perl cookbook' 6.9 +sub shellregex +{ + my $in = shift; + $in =~ s{(.)} { $patmap{$1} || "\Q$1" }ge; + return '^' . $in . '$'; +} -- 2.43.0