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 $fn $localfn);
  29
  30 %alias = ();
  31
  32 $fn = "$main::cmd/Aliases";
  33 $localfn = "$main::localcmd/Aliases";
  34
  35 sub load
  36 {
  37         my $ref = shift;
  38         if (-e $localfn) {
  39                 do $localfn;
  40                 return ($@) if $@ && ref $ref;
  41                 confess $@ if $@;
  42                 return ();
  43         }
  44         do $fn;
  45         return ($@) if $@ && ref $ref;
  46         confess $@ if $@;
  47         return ();
  48 }
  49
  50 sub init
  51 {
  52         load();
  53 }
  54
  55 #
  56 # called as CmdAlias::get_cmd("string");
  57 #
  58 sub get_cmd
  59 {
  60   my $s = shift;
  61   my ($let) = unpack "A1", $s;
  62   my ($i, $n, $ref);
  63
  64   $let = lc $let;
  65
  66   $ref = $alias{$let};
  67   return undef if !$ref;
  68
  69   $n = @{$ref};
  70   for ($i = 0; $i < $n; $i += 3) {
  71     if ($s =~ /$ref->[$i]/i) {
  72           my $ri = qq{\$ro = "$ref->[$i+1]"};
  73           my $ro;
  74           eval $ri;
  75           return $ro;
  76         }
  77   }
  78   return undef;
  79 }
  80
  81 #
  82 # called as CmdAlias::get_hlp("string");
  83 #
  84 sub get_hlp
  85 {
  86   my $s = shift;
  87   my ($let) = unpack "A1", $s;
  88   my ($i, $n, $ref);
  89
  90   $let = lc $let;
  91
  92   $ref = $alias{$let};
  93   return undef if !$ref;
  94
  95   $n = @{$ref};
  96   for ($i = 0; $i < $n; $i += 3) {
  97     if ($s =~ /$ref->[$i]/i) {
  98           my $ri = qq{\$ro = "$ref->[$i+2]"};
  99           my $ro;
 100           eval $ri;
 101           return $ro;
 102         }
 103   }
 104   return undef;
 105 }
 106
 107