]> dxcluster.org Git - spider.git/commitdiff
added shellregex
authordjk <djk>
Sun, 23 May 1999 13:06:09 +0000 (13:06 +0000)
committerdjk <djk>
Sun, 23 May 1999 13:06:09 +0000 (13:06 +0000)
made sh/c and sh/u sorted
added shelregex to sh/dx and dir
started making dir more useful

Changes
cmd/directory.pl
cmd/show/configuration.pl
cmd/show/dx.pl
cmd/show/users.pl
perl/DXChannel.pm
perl/DXUtil.pm

diff --git a/Changes b/Changes
index e6603aec57a6ff2694aae887cca3cbb3fc370f71..d5fa4718dc31037674edde1dc44e40a36328a865 100644 (file)
--- 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.
index ab81798585a9008158abf54982f199ec1dad8e42..e4bf57bc5bb61714a61dba4460f98524d2aab100 100644 (file)
@@ -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);
index f2f296e585ec7288685df9c94e958ddcccfca4cb..6f2e1e935a8014f06c5373138675fc0de94d7307 100644 (file)
@@ -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) {
index c98699969ad095cc4518eab077ee5bf936009821..d52826dff67ed4b3dc4e16ebdb6d17f8767fcdfa 100644 (file)
@@ -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";
index 8cbe85770967388f43a8895c590f629f2930345b..55a34bec954be8beab2c6c76eaf6920d8b0f961f 100644 (file)
@@ -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;
index e3878ecf719f6fe2c8181a2d11c8323821d59c0f..9bde6aa8fe4a30829b5dfed54895ec92250fd0b7 100644 (file)
@@ -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};
                }
        }
index 868110ea36d6e7de266d4c7e28a704181787b276..a1fb13ba2d34771044598ca3753f8a4238754830 100644 (file)
@@ -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 . '$';
+}