From: djk Date: Sun, 27 Jun 1999 23:31:55 +0000 (+0000) Subject: made local aliases additive to the standard ones. Locals override standard X-Git-Tag: R_1_30~10 X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=c8040f10eceea03637274064458ffe976a98e285;p=spider.git made local aliases additive to the standard ones. Locals override standard --- diff --git a/Changes b/Changes index 1a214559..6dcfa6ed 100644 --- 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. diff --git a/perl/CmdAlias.pm b/perl/CmdAlias.pm index 1f418967..2a5e26cf 100644 --- a/perl/CmdAlias.pm +++ b/perl/CmdAlias.pm @@ -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; }