fix aliases file for delete nnn
[spider.git] / cmd / help.pl
1
2 # the help subsystem
3 #
4 # It is a very simple system in that you type in 'help <cmd>' and it
5 # looks for a file called command.hlp in either the local_cmd directory
6 # or the cmd directory (in that order). 
7 #
8 # Copyright (c) 1998 - Dirk Koopman G1TLH
9 #
10 # $Id$
11 #
12
13 my ($self, $line) = @_;
14 my @out;
15
16 # this is naff but it will work for now
17 my $lang = $self->lang;
18 $lang = 'en' if !$lang;
19
20 # each help file contains lines that looks like:-
21 #
22 # === 0^*^Description
23 # text
24 # text
25 #
26 # === 0^help^Description
27 # text
28 # text
29 # text 
30 #
31 # The fields are:- privilege level, full command name, short description
32 #
33
34 my $defh = new IO::File;
35 unless ($defh->open("$main::localcmd/Commands_en.hlp")) {
36         unless($defh->open("$main::cmd/Commands_en.hlp")) {
37                 return (1, $self->msg('helpe1'));
38         }
39 }
40
41 my $h;
42 unless ($lang ne 'en') {
43         $h = new IO::File;
44         unless ($h->open("$main::localcmd/Commands_$lang.hlp")) {
45                 unless($h->open("$main::cmd/Commands_$lang.hlp")) {
46                         undef $h;
47                 }
48         }
49 }
50
51 my $in;
52
53 #$line =~ s/[^\w\/]//g;
54 #$line =~ s/\//\.\*\//g;
55
56 $line =~ s{[^\w/]}{}g;
57 $line =~ s{/}{.*/}g;
58 $line =~ s/^\s+//g;
59 $line =~ s/\s+$//g;
60 $line = "help" if $line =~ /^\s*$/;
61
62 # sort out aliases
63 my $alias = CmdAlias::get_hlp($line);
64 $line = $alias if $alias;
65
66 # non english help (if available)
67 if ($h) {
68         my $state = 0;
69         foreach $in (<$h>) {
70                 next if $in =~ /^\#/;
71                 chomp $in;
72                 if ($in =~ /^===/) {
73                         last if $state == 2;           # come out on next command
74                         $in =~ s/=== //;
75                         my ($priv, $cmd, $desc) = split /\^/, $in;
76                         next if $priv > $self->priv;             # ignore subcommands that are of no concern
77                         next unless $cmd =~ /^$line/i;
78                         push @out, "$cmd $desc" unless $cmd =~ /-$/o;
79                         $state = 1;
80                         next;
81                 }
82                 if ($state > 0) {
83                         push @out, " $in";
84                         $state = 2;
85                 }
86         }
87         $h->close;
88
89         # return if some help was given, otherwise continue to english help
90         return (1, @out) if @out && $state == 2;
91 }
92
93 # standard 'english' help
94 my $state = 0;
95 foreach $in (<$defh>) {
96         next if $in =~ /^\#/;
97         chomp $in;
98         if ($in =~ /^===/) {
99                 last if $state == 2;           # come out on next command
100                 $in =~ s/=== //;
101                 my ($priv, $cmd, $desc) = split /\^/, $in;
102                 next if $priv > $self->priv;             # ignore subcommands that are of no concern
103                 next unless $cmd =~ /^$line/i;
104                 push @out, "$cmd $desc" unless $cmd =~ /-$/o;
105                 $state = 1;
106                 next;
107         }
108         if ($state > 0) {
109                 push @out, " $in";
110                 $state = 2;
111         }
112 }
113 $defh->close;
114
115 push @out, $self->msg('helpe2', $line) if @out == 0;
116 return (1, @out);
117