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