X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FCmdAlias.pm;h=8e26135cf27007c9efbc49c58c257f04d9842829;hb=refs%2Fheads%2Fip_address;hp=1f418967c30cae00ca096045b25bc35462cbc089;hpb=ae8b40244a552256fd35720e40b4ef0e14df55f1;p=spider.git diff --git a/perl/CmdAlias.pm b/perl/CmdAlias.pm index 1f418967..8e26135c 100644 --- a/perl/CmdAlias.pm +++ b/perl/CmdAlias.pm @@ -14,20 +14,20 @@ # # Copyright (c) 1998 Dirk Koopman G1TLH # -# $Id$ +# # package CmdAlias; use DXVars; use DXDebug; -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 +35,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 +70,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 +96,27 @@ 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; } +1; +