From: djk <djk>
Date: Sun, 23 May 1999 13:06:09 +0000 (+0000)
Subject: added shellregex
X-Git-Tag: R_1_28~14
X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=f3688be5d3f50cccf204d3d01dcaca1e9db7d4f7

added shellregex
made sh/c and sh/u sorted
added shelregex to sh/dx and dir
started making dir more useful
---

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 . '$';
+}