cmd/apropos.pl

   1 # the help subsystem
   2 #
   3 # apropos - this does a grep on the command file and returns the commands
   4 # that contain the string searched for
   5 #
   6 # Copyright (c) 1998 - Dirk Koopman G1TLH
   7 #
   8 #
   9 #
  10
  11 my ($self, $line) = @_;
  12 my @out;
  13
  14 my $lang = $self->lang;
  15 $lang = 'en' if !$lang;
  16
  17 #print "$line\n";
  18 my $in;
  19 $line = 'help' unless $line;
  20 $line =~ s/\ball\b/.*/;
  21 $line =~ s/\W//g;   # remove dubious characters
  22 print "$line\n";
  23
  24 my ($priv, $cmd, $param, $desc);
  25 my %cmd;
  26
  27 my $defh = new IO::File;
  28 unless ($defh->open("$main::localcmd/Commands_en.hlp")) {
  29         unless($defh->open("$main::cmd/Commands_en.hlp")) {
  30                 return (1, $self->msg('helpe1'));
  31         }
  32 }
  33
  34 my $h;
  35 if ($lang ne 'en') {
  36         $h = new IO::File;
  37         unless ($h->open("$main::localcmd/Commands_$lang.hlp")) {
  38                 unless($h->open("$main::cmd/Commands_$lang.hlp")) {
  39                         undef $h;
  40                 }
  41         }
  42 }
  43
  44 # do english help
  45 foreach $in (<$defh>) {
  46         next if $in =~ /^\#/;
  47         chomp $in;
  48         $in =~ s/\r$//;
  49         if ($in =~ /^===/) {
  50 #               print "$in\n";
  51                 ($priv, $cmd, $param, $desc) = $in =~ m{^===\s+(\d)\^(\S+)(\s+[^\^]+)?\^(.*)};
  52                 $param ||= '';
  53                 $desc ||= '';
  54                 next if $priv > $self->priv;             # ignore subcommands that are of no concern
  55                 next unless $in =~ /$line/i;
  56                 next if $cmd =~ /-$/o;
  57                 push @{$cmd{$cmd}->{en}}, "$cmd$param $desc";
  58                 next;
  59         }
  60 }
  61 $defh->close;
  62
  63 # override with any not english help
  64 if ($h) {
  65         my $include;
  66         foreach $in (<$h>) {
  67                 next if $in =~ /^\#/;
  68                 chomp $in;
  69                 $in =~ s/\r$//;
  70                 if ($in =~ /^===/) {
  71 #                       print "$in\n";
  72                         ($priv, $cmd, $param, $desc) = $in =~ m{^===\s+(\d)\^(\S+)(\s+[^\^]+)?\^(.*)};
  73                         $param ||= '';
  74                     $desc ||= '';
  75                         next if $priv > $self->priv;             # ignore subcommands that are of no concern
  76                         next unless $in =~ /$line/i;
  77                         next if $cmd =~ /-$/o;
  78                         push @{$cmd{$cmd}->{$lang}}, "$cmd$param $desc";
  79                         next;
  80                 }
  81         }
  82         $h->close;
  83 }
  84
  85 foreach my $k (sort keys %cmd) {
  86         my $v;
  87         if ($v = $cmd{$k}->{$lang}) {
  88                 push @out, @$v;
  89         } elsif ($v = $cmd{$k}->{en}) {
  90                 push @out, @$v;
  91         }
  92 }
  93
  94 push @out, $self->msg('helpe2', $line) if @out == 0;
  95
  96 return (1, @out);