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 #
  18 #
  19
  20 package CmdAlias;
  21
  22 use DXVars;
  23 use DXDebug;
  24
  25 use strict;
  26
  27 use vars qw(%alias %newalias $fn $localfn);
  28
  29 %alias = ();
  30 %newalias = ();
  31
  32 $fn = "$main::cmd/Aliases";
  33 $localfn = "$main::localcmd/Aliases";
  34
  35 sub load
  36 {
  37         my $ref = shift;
  38
  39         do $fn;
  40         return ($@) if $@ && ref $ref;
  41         confess $@ if $@;
  42         if (-e $localfn) {
  43                 my %oldalias = %alias;
  44                 local %alias;    # define a local one
  45
  46                 do $localfn;
  47                 return ($@) if $@ && ref $ref;
  48                 confess $@ if $@;
  49                 my $let;
  50                 foreach $let (keys %alias) {
  51                         # stick any local definitions at the front
  52                         my @a;
  53                         push @a, (@{$alias{$let}});
  54                         push @a, (@{$oldalias{$let}}) if exists $oldalias{$let};
  55                         $oldalias{$let} = \@a;
  56                 }
  57                 %newalias = %oldalias;
  58         }
  59         %alias = %newalias if -e $localfn;
  60         return ();
  61 }
  62
  63 sub init
  64 {
  65         load();
  66 }
  67
  68 #
  69 # called as CmdAlias::get_cmd("string");
  70 #
  71 sub get_cmd
  72 {
  73         my $s = shift;
  74         my ($let) = unpack "A1", $s;
  75         my ($i, $n, $ref);
  76
  77         $let = lc $let;
  78
  79         $ref = $alias{$let};
  80         return undef if !$ref;
  81
  82         $n = @{$ref};
  83         for ($i = 0; $i < $n; $i += 3) {
  84                 if ($s =~ /$ref->[$i]/i) {
  85                         my $ri = qq{\$ro = "$ref->[$i+1]"};
  86                         my $ro;
  87                         eval $ri;
  88                         return $ro;
  89                 }
  90         }
  91         return undef;
  92 }
  93
  94 #
  95 # called as CmdAlias::get_hlp("string");
  96 #
  97 sub get_hlp
  98 {
  99         my $s = shift;
 100         my ($let) = unpack "A1", $s;
 101         my ($i, $n, $ref);
 102
 103         $let = lc $let;
 104
 105         $ref = $alias{$let};
 106         return undef if !$ref;
 107
 108         $n = @{$ref};
 109         for ($i = 0; $i < $n; $i += 3) {
 110                 if ($s =~ /$ref->[$i]/i) {
 111                         my $ri = qq{\$ro = "$ref->[$i+2]"};
 112                         my $ro;
 113                         eval $ri;
 114                         return $ro;
 115                 }
 116         }
 117         return undef;
 118 }
 119
 120 1;
 121
 122