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.
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);
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 = ();
@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) {
# 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
}
# 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";
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;
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;
$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 :-)
# 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};
}
}
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
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 . '$';
+}
projects / spider.git / commitdiff