]> scm.dxcluster.org Git - spider.git/blob - perl/CmdAlias.pm
remove shadow $i
[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
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