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