perl/CmdAlias.pm

   1 #
   2 # This package impliments some of the ak1a aliases that can't
   3 # be done with interpolation from the file names.
   4 #
   5 # Basically it takes the input and bashes down the list of aliases
   6 # for that starting letter until it either matches (in which a substitution
   7 # is done) or fails
   8 #
   9 # To roll your own Aliases, copy the /spider/cmd/Aliases file to
  10 # /spider/local_cmd and alter it to your taste.
  11 #
  12 # To make it active type 'load/aliases'
  13 #
  14 #
  15 # Copyright (c) 1998 Dirk Koopman G1TLH
  16 #
  17 # $Id$
  18 #
  19
  20 package CmdAlias;
  21
  22 use DXVars;
  23 use DXDebug;
  24 use Carp;
  25
  26 use strict;
  27
  28 use vars qw(%alias %newalias $fn $localfn);
  29
  30 %alias = ();
  31 %newalias = ();
  32
  33 $fn = "$main::cmd/Aliases";
  34 $localfn = "$main::localcmd/Aliases";
  35
  36 sub load
  37 {
  38         my $ref = shift;
  39
  40         do $fn;
  41         return ($@) if $@ && ref $ref;
  42         confess $@ if $@;
  43         if (-e $localfn) {
  44                 my %oldalias = %alias;
  45                 local %alias;    # define a local one
  46
  47                 do $localfn;
  48                 return ($@) if $@ && ref $ref;
  49                 confess $@ if $@;
  50                 my $let;
  51                 foreach $let (keys %alias) {
  52                         # stick any local definitions at the front
  53                         my @a;
  54                         push @a, (@{$alias{$let}});
  55                         push @a, (@{$oldalias{$let}}) if exists $oldalias{$let};
  56                         $oldalias{$let} = \@a;
  57                 }
  58                 %newalias = %oldalias;
  59         }
  60         %alias = %newalias if -e $localfn;
  61         return ();
  62 }
  63
  64 sub init
  65 {
  66         load();
  67 }
  68
  69 #
  70 # called as CmdAlias::get_cmd("string");
  71 #
  72 sub get_cmd
  73 {
  74         my $s = shift;
  75         my ($let) = unpack "A1", $s;
  76         my ($i, $n, $ref);
  77
  78         $let = lc $let;
  79
  80         $ref = $alias{$let};
  81         return undef if !$ref;
  82
  83         $n = @{$ref};
  84         for ($i = 0; $i < $n; $i += 3) {
  85                 if ($s =~ /$ref->[$i]/i) {
  86                         my $ri = qq{\$ro = "$ref->[$i+1]"};
  87                         my $ro;
  88                         eval $ri;
  89                         return $ro;
  90                 }
  91         }
  92         return undef;
  93 }
  94
  95 #
  96 # called as CmdAlias::get_hlp("string");
  97 #
  98 sub get_hlp
  99 {
 100         my $s = shift;
 101         my ($let) = unpack "A1", $s;
 102         my ($i, $n, $ref);
 103
 104         $let = lc $let;
 105
 106         $ref = $alias{$let};
 107         return undef if !$ref;
 108
 109         $n = @{$ref};
 110         for ($i = 0; $i < $n; $i += 3) {
 111                 if ($s =~ /$ref->[$i]/i) {
 112                         my $ri = qq{\$ro = "$ref->[$i+2]"};
 113                         my $ro;
 114                         eval $ri;
 115                         return $ro;
 116                 }
 117         }
 118         return undef;
 119 }
 120
 121