]> scm.dxcluster.org Git - spider.git/blob - perl/CmdAlias.pm
done more work on directory now really quite ak1a compatible
[spider.git] / 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 $fn $localfn);
45
46 %alias = ();
47
48 $fn = "$main::cmd/Aliases";
49 $localfn = "$main::localcmd/Aliases";
50
51 sub load
52 {
53         my $ref = shift;
54         if (-e $localfn) {
55                 do $localfn;
56                 return ($@) if $@ && ref $ref;
57                 confess $@ if $@;
58                 return ();
59         }
60         do $fn;
61         return ($@) if $@ && ref $ref;
62         confess $@ if $@;
63         return ();
64 }
65
66 sub init
67 {
68         load();
69 }
70
71 #
72 # called as CmdAlias::get_cmd("string");
73 #
74 sub get_cmd
75 {
76   my $s = shift;
77   my ($let) = unpack "A1", $s;
78   my ($i, $n, $ref);
79
80   $let = lc $let;
81   
82   $ref = $alias{$let};
83   return undef if !$ref;
84   
85   $n = @{$ref};
86   for ($i = 0; $i < $n; $i += 3) {
87     if ($s =~ /$ref->[$i]/i) {
88           my $ri = qq{\$ro = "$ref->[$i+1]"};
89           my $ro;
90           eval $ri;
91           return $ro;
92         }
93   }
94   return undef;
95 }
96
97 #
98 # called as CmdAlias::get_hlp("string");
99 #
100 sub get_hlp
101 {
102   my $s = shift;
103   my ($let) = unpack "A1", $s;
104   my ($i, $n, $ref);
105
106   $let = lc $let;
107   
108   $ref = $alias{$let};
109   return undef if !$ref;
110   
111   $n = @{$ref};
112   for ($i = 0; $i < $n; $i += 3) {
113     if ($s =~ /$ref->[$i]/i) {
114           my $ri = qq{\$ro = "$ref->[$i+2]"};
115           my $ro;
116           eval $ri;
117           return $ro;
118         }
119   }
120   return undef;
121 }
122
123