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 #
  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