X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FCmdAlias.pm;h=fc10ebe9a3b70fe5f1018a1215d166194dc8f49d;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=a424f8e861ebb5a00cb15f415293be47bb8db3fa;hpb=b4826d1f4125788e14fed3adbb99e66242904e74;p=spider.git

diff --git a/perl/CmdAlias.pm b/perl/CmdAlias.pm
index a424f8e8..fc10ebe9 100644
--- a/perl/CmdAlias.pm
+++ b/perl/CmdAlias.pm
@@ -1,32 +1,16 @@
 #
-# This package simply takes a string, looks it up in a
-# hash and returns the value.
+# This package impliments some of the ak1a aliases that can't
+# be done with interpolation from the file names.
 #
-# The hash is produced by reading the Alias file in both command directories
-# which contain entries for the %cmd hash. This file is in different forms in 
-# the two directories:-
+# Basically it takes the input and bashes down the list of aliases
+# for that starting letter until it either matches (in which a substitution
+# is done) or fails
 #
-# in the main cmd directory it has entries like:-
+# To roll your own Aliases, copy the /spider/cmd/Aliases file to 
+# /spider/local_cmd and alter it to your taste.
 #
-# package CmdAlias;
+# To make it active type 'load/aliases'
 #
-# %alias = (
-#   sp => 'send private',
-#   s/p => 'send private', 
-#   sb => 'send bulletin', 
-# );
-#
-# for the local cmd directory you should do it like this:-
-#
-# package CmdAlias;
-#
-# $alias{'s/p'} = 'send private';
-# $alias{'s/b'} = 'send bulletin';
-#
-# This will allow you to override as well as add to the basic set of commands 
-#
-# This system works in same way as the commands, if the modification times of
-# the two files have changed then they are re-read.
 #
 # Copyright (c) 1998 Dirk Koopman G1TLH
 #
@@ -37,13 +21,13 @@ 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";
@@ -51,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 ();
 }
 
@@ -73,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;
 }
 
 #
@@ -99,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;
+