]> dxcluster.org Git - spider.git/commitdiff
made local aliases additive to the standard ones. Locals override standard
authordjk <djk>
Sun, 27 Jun 1999 23:31:55 +0000 (23:31 +0000)
committerdjk <djk>
Sun, 27 Jun 1999 23:31:55 +0000 (23:31 +0000)
Changes
perl/CmdAlias.pm

diff --git a/Changes b/Changes
index 1a214559d4c78ed3127f6b197a085f96b48073b8..6dcfa6ed56d7d9db42c8ea0e42e2d58883f507e9 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,6 +9,9 @@ This means that when you start forwarding to a node, it doesn't get all the
 messages queued up that are probably old.
 5. added 'uncatchup' which does the opposite of the above.
 6. fixed kill full and PC49 handling so that it actually works.
+7. Fixed local aliases so they add to the front of the standard ones. This
+means you only need to add your specials or override the system ones you need
+to.
 21Jun99=======================================================================
 1. changed regex for cluster->client msgs so that strings like |---| are no
 longer ignored.
index 1f418967c30cae00ca096045b25bc35462cbc089..2a5e26cffcee2f333af96187da1d93af32e94416 100644 (file)
@@ -25,9 +25,10 @@ use Carp;
 
 use strict;
 
-use vars qw(%alias $fn $localfn);
+use vars qw(%alias %newalias $fn $localfn);
 
 %alias = ();
+%newalias = ();
 
 $fn = "$main::cmd/Aliases";
 $localfn = "$main::localcmd/Aliases";
@@ -35,15 +36,28 @@ $localfn = "$main::localcmd/Aliases";
 sub load
 {
        my $ref = shift;
+       
+       do $fn;
+       return ($@) if $@ && ref $ref;
+       confess $@ if $@;
        if (-e $localfn) {
+               my %oldalias = %alias;
+               local %alias;    # define a local one
+               
                do $localfn;
                return ($@) if $@ && ref $ref;
                confess $@ if $@;
-               return ();
+               my $let;
+               foreach $let (keys %alias) {
+                       # stick any local definitions at the front
+                       my @a;
+                       push @a, (@{$alias{$let}});
+                       push @a, (@{$oldalias{$let}}) if exists $oldalias{$let};
+                       $oldalias{$let} = \@a; 
+               }
+               %newalias = %oldalias;
        }
-       do $fn;
-       return ($@) if $@ && ref $ref;
-       confess $@ if $@;
+       %alias = %newalias if -e $localfn;
        return ();
 }
 
@@ -57,25 +71,25 @@ sub init
 #
 sub get_cmd
 {
-  my $s = shift;
-  my ($let) = unpack "A1", $s;
-  my ($i, $n, $ref);
-
-  $let = lc $let;
-  
-  $ref = $alias{$let};
-  return undef if !$ref;
-  
-  $n = @{$ref};
-  for ($i = 0; $i < $n; $i += 3) {
-    if ($s =~ /$ref->[$i]/i) {
-         my $ri = qq{\$ro = "$ref->[$i+1]"};
-         my $ro;
-         eval $ri;
-         return $ro;
+       my $s = shift;
+       my ($let) = unpack "A1", $s;
+       my ($i, $n, $ref);
+       
+       $let = lc $let;
+       
+       $ref = $alias{$let};
+       return undef if !$ref;
+       
+       $n = @{$ref};
+       for ($i = 0; $i < $n; $i += 3) {
+               if ($s =~ /$ref->[$i]/i) {
+                       my $ri = qq{\$ro = "$ref->[$i+1]"};
+                       my $ro;
+                       eval $ri;
+                       return $ro;
+               }
        }
-  }
-  return undef;
+       return undef;
 }
 
 #
@@ -83,25 +97,25 @@ sub get_cmd
 #
 sub get_hlp
 {
-  my $s = shift;
-  my ($let) = unpack "A1", $s;
-  my ($i, $n, $ref);
-
-  $let = lc $let;
-  
-  $ref = $alias{$let};
-  return undef if !$ref;
-  
-  $n = @{$ref};
-  for ($i = 0; $i < $n; $i += 3) {
-    if ($s =~ /$ref->[$i]/i) {
-         my $ri = qq{\$ro = "$ref->[$i+2]"};
-         my $ro;
-         eval $ri;
-         return $ro;
+       my $s = shift;
+       my ($let) = unpack "A1", $s;
+       my ($i, $n, $ref);
+       
+       $let = lc $let;
+       
+       $ref = $alias{$let};
+       return undef if !$ref;
+       
+       $n = @{$ref};
+       for ($i = 0; $i < $n; $i += 3) {
+               if ($s =~ /$ref->[$i]/i) {
+                       my $ri = qq{\$ro = "$ref->[$i+2]"};
+                       my $ro;
+                       eval $ri;
+                       return $ro;
+               }
        }
-  }
-  return undef;
+       return undef;
 }