perl/CmdAlias.pm

   1 #
   2 # This package simply takes a string, looks it up in a
   3 # hash and returns the value.
   4 #
   5 # The hash is produced by reading the Alias file in both command directories
   6 # which contain entries for the %cmd hash. This file is in different forms in
   7 # the two directories:-
   8 #
   9 # in the main cmd directory it has entries like:-
  10 #
  11 # package CmdAlias;
  12 #
  13 # %alias = (
  14 #   sp => 'send private',
  15 #   s/p => 'send private',
  16 #   sb => 'send bulletin',
  17 # );
  18 #
  19 # for the local cmd directory you should do it like this:-
  20 #
  21 # package CmdAlias;
  22 #
  23 # $alias{'s/p'} = 'send private';
  24 # $alias{'s/b'} = 'send bulletin';
  25 #
  26 # This will allow you to override as well as add to the basic set of commands
  27 #
  28 # This system works in same way as the commands, if the modification times of
  29 # the two files have changed then they are re-read.
  30 #
  31 # Copyright (c) 1998 Dirk Koopman G1TLH
  32 #
  33 # $Id$
  34 #
  35
  36 package CmdAlias;
  37
  38 use DXVars;
  39 use DXDebug;
  40 use Carp;
  41
  42 use strict;
  43
  44 use vars qw(%alias $cmd_mtime $localcmd_mtime $fn $localfn);
  45
  46 %alias = ();
  47
  48 $cmd_mtime = 1;
  49 $localcmd_mtime = 1;
  50
  51 $fn = "$main::cmd/Aliases";
  52 $localfn = "$main::localcmd/Aliases";
  53
  54 sub checkfiles
  55 {
  56   my $m = -M $fn;
  57 #  print "m: $m oldmtime: $cmd_mtime\n";
  58   if ($m < $cmd_mtime) {
  59     do $fn;
  60         confess $@ if $@;
  61         $cmd_mtime = $m;
  62         $localcmd_mtime = 0;
  63   }
  64   if (-e $localfn) {
  65     $m = -M $localfn;
  66         if ($m < $localcmd_mtime) {
  67       do $localfn;
  68           confess $@ if $@;
  69           $localcmd_mtime = $m;
  70     }
  71   }
  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   checkfiles();
  86
  87   $ref = $alias{$let};
  88   return undef if !$ref;
  89
  90   $n = @{$ref};
  91   for ($i = 0; $i < $n; $i += 3) {
  92     if ($s =~ /$ref->[$i]/i) {
  93           my $ri = qq{\$ro = "$ref->[$i+1]"};
  94           my $ro;
  95           eval $ri;
  96           return $ro;
  97         }
  98   }
  99   return undef;
 100 }
 101
 102 #
 103 # called as CmdAlias::get_hlp("string");
 104 #
 105 sub get_hlp
 106 {
 107   my $s = shift;
 108   my ($let) = unpack "A1", $s;
 109   my ($i, $n, $ref);
 110
 111   $let = lc $let;
 112
 113   checkfiles();
 114
 115   $ref = $alias{$let};
 116   return undef if !$ref;
 117
 118   $n = @{$ref};
 119   for ($i = 0; $i < $n; $i += 3) {
 120     if ($s =~ /$ref->[$i]/i) {
 121           my $ri = qq{$ref->[$i+2]};
 122           return $ri;
 123         }
 124   }
 125   return undef;
 126 }
 127
 128