X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=cmd%2Fapropos.pl;h=1d6ac6bf5ab73b80715fc41098f81f1e9edea55c;hb=eac4538f1f78b3d014539dc548fc6322e8337429;hp=e69de29bb2d1d6434b8b29ae775ad8c2e48c5391;hpb=4c92a7711c41cc7ba1c60d5a49a94db239032ac1;p=spider.git diff --git a/cmd/apropos.pl b/cmd/apropos.pl index e69de29b..1d6ac6bf 100644 --- a/cmd/apropos.pl +++ b/cmd/apropos.pl @@ -0,0 +1,96 @@ +# the help subsystem +# +# apropos - this does a grep on the command file and returns the commands +# that contain the string searched for +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# +# + +my ($self, $line) = @_; +my @out; + +my $lang = $self->lang; +$lang = 'en' if !$lang; + +#print "$line\n"; +my $in; +$line = 'help' unless $line; +$line =~ s/\ball\b/.*/; +$line =~ s/\W//g; # remove dubious characters +print "$line\n"; + +my ($priv, $cmd, $param, $desc); +my %cmd; + +my $defh = new IO::File; +unless ($defh->open("$main::localcmd/Commands_en.hlp")) { + unless($defh->open("$main::cmd/Commands_en.hlp")) { + return (1, $self->msg('helpe1')); + } +} + +my $h; +if ($lang ne 'en') { + $h = new IO::File; + unless ($h->open("$main::localcmd/Commands_$lang.hlp")) { + unless($h->open("$main::cmd/Commands_$lang.hlp")) { + undef $h; + } + } +} + +# do english help +foreach $in (<$defh>) { + next if $in =~ /^\#/; + chomp $in; + $in =~ s/\r$//; + if ($in =~ /^===/) { +# print "$in\n"; + ($priv, $cmd, $param, $desc) = $in =~ m{^===\s+(\d)\^(\S+)(\s+[^\^]+)?\^(.*)}; + $param ||= ''; + $desc ||= ''; + next if $priv > $self->priv; # ignore subcommands that are of no concern + next unless $in =~ /$line/i; + next if $cmd =~ /-$/o; + push @{$cmd{$cmd}->{en}}, "$cmd$param $desc"; + next; + } +} +$defh->close; + +# override with any not english help +if ($h) { + my $include; + foreach $in (<$h>) { + next if $in =~ /^\#/; + chomp $in; + $in =~ s/\r$//; + if ($in =~ /^===/) { +# print "$in\n"; + ($priv, $cmd, $param, $desc) = $in =~ m{^===\s+(\d)\^(\S+)(\s+[^\^]+)?\^(.*)}; + $param ||= ''; + $desc ||= ''; + next if $priv > $self->priv; # ignore subcommands that are of no concern + next unless $in =~ /$line/i; + next if $cmd =~ /-$/o; + push @{$cmd{$cmd}->{$lang}}, "$cmd$param $desc"; + next; + } + } + $h->close; +} + +foreach my $k (sort keys %cmd) { + my $v; + if ($v = $cmd{$k}->{$lang}) { + push @out, @$v; + } elsif ($v = $cmd{$k}->{en}) { + push @out, @$v; + } +} + +push @out, $self->msg('helpe2', $line) if @out == 0; + +return (1, @out);