]> scm.dxcluster.org Git - spider.git/blob - perl/CmdAlias.pm
add delete/user command
[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 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;
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