]> gb7djk.dxcluster.net Git - spider.git/blob - cmd/help.pl
fix it for 5.005 without warnings
[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 #$DB::single = 1;
35
36
37 my $defh = new IO::File;
38 unless ($defh->open("$main::localcmd/Commands_en.hlp")) {
39         unless($defh->open("$main::cmd/Commands_en.hlp")) {
40                 return (1, $self->msg('helpe1'));
41         }
42 }
43
44 my $h;
45 if ($lang ne 'en') {
46         $h = new IO::File;
47         unless ($h->open("$main::localcmd/Commands_$lang.hlp")) {
48                 unless($h->open("$main::cmd/Commands_$lang.hlp")) {
49                         undef $h;
50                 }
51         }
52 }
53
54 my $in;
55
56 #$line =~ s/[^\w\/]//g;
57 #$line =~ s/\//\.\*\//g;
58
59 $line =~ s{[^\w/]}{}g;
60 $line =~ s{/}{.*/}g;
61 $line =~ s/^\s+//g;
62 $line =~ s/[\s\r]+$//g;
63 $line = "help" if $line =~ /^\s*$/;
64
65 # sort out aliases
66 my $alias = CmdAlias::get_hlp($line);
67 $line = $alias if $alias;
68
69 # non english help (if available)
70 if ($h) {
71         my $state = 0;
72         foreach $in (<$h>) {
73                 next if $in =~ /^\#/;
74                 chomp $in;
75                 $in =~ s/\r$//;
76                 if ($in =~ /^===/) {
77                         last if $state == 2;           # come out on next command
78                         $in =~ s/=== //;
79                         my ($priv, $cmd, $desc) = split /\^/, $in;
80                         next if $priv > $self->priv;             # ignore subcommands that are of no concern
81                         next unless $cmd =~ /^$line/i;
82                         push @out, "$cmd $desc" unless $cmd =~ /-$/o;
83                         $state = 1;
84                         next;
85                 }
86                 if ($state > 0) {
87                         push @out, " $in";
88                         $state = 2;
89                 }
90         }
91         $h->close;
92
93         # return if some help was given, otherwise continue to english help
94         return (1, @out) if @out && $state == 2;
95 }
96
97 # standard 'english' help
98 my $state = 0;
99 foreach $in (<$defh>) {
100         next if $in =~ /^\#/;
101         chomp $in;
102         if ($in =~ /^===/) {
103                 last if $state == 2;           # come out on next command
104                 $in =~ s/=== //;
105                 my ($priv, $cmd, $desc) = split /\^/, $in;
106                 next if $priv > $self->priv;             # ignore subcommands that are of no concern
107                 next unless $cmd =~ /^$line/i;
108                 push @out, "$cmd $desc" unless $cmd =~ /-$/o;
109                 $state = 1;
110                 next;
111         }
112         if ($state > 0) {
113                 push @out, " $in";
114                 $state = 2;
115         }
116 }
117 $defh->close;
118
119 push @out, $self->msg('helpe2', $line) if @out == 0;
120 return (1, @out);
121