diff options
Diffstat (limited to 'libexec/makewhatis')
| -rw-r--r-- | libexec/makewhatis/makewhatis.pl | 544 |
1 files changed, 272 insertions, 272 deletions
diff --git a/libexec/makewhatis/makewhatis.pl b/libexec/makewhatis/makewhatis.pl index 1633b762173..75efc839f42 100644 --- a/libexec/makewhatis/makewhatis.pl +++ b/libexec/makewhatis/makewhatis.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl -w -# ex:ts=4 sw=4: +# ex:ts=8 sw=4: -# $OpenBSD: makewhatis.pl,v 1.3 2000/03/31 15:55:06 espie Exp $ +# $OpenBSD: makewhatis.pl,v 1.4 2000/03/31 15:56:59 espie Exp $ # # Copyright (c) 2000 Marc Espie. # @@ -33,351 +33,351 @@ use IO::File; # write_uniques($list, $file): # -# write $list to file named $file, removing duplicate entries. -# Change $file mode/owners to expected values +# write $list to file named $file, removing duplicate entries. +# Change $file mode/owners to expected values # sub write_uniques { - my $list = shift; - my $f = shift; - my ($out, $last); - local $_; + my $list = shift; + my $f = shift; + my ($out, $last); + local $_; - $out = new IO::File $f, "w" or die "$0: Can't open $f"; + $out = new IO::File $f, "w" or die "$0: Can't open $f"; - my @sorted = sort @$list; + my @sorted = sort @$list; - while ($_ = shift @sorted) { - print $out $_, "\n" unless defined $last and $_ eq $last; - $last = $_; - } - close $out; - chmod 0444, $f; - chown 0, (getgrnam 'bin')[2], $f; + while ($_ = shift @sorted) { + print $out $_, "\n" unless defined $last and $_ eq $last; + $last = $_; + } + close $out; + chmod 0444, $f; + chown 0, (getgrnam 'bin')[2], $f; } sub add_fsubject { - my $lines = shift; - my $toadd = shift; - my $section = shift; - local $_ = join(' ', @$toadd); - # unbreakable spaces - s/\\\s+/ /g; - # em dashes - s/\\\(em\s+/- /g; - # font changes - s/\\f[BIRP]//g; - s/\\-/($section) -/ || s/\s-\s/ ($section) - /; - # other dashes - s/\\-/-/g; - # sequence of spaces - s/\s+$//; - s/\s+/ /g; - # escaped characters - s/\\\&(.)/$1/g; - # gremlins... - s/\\c//g; - push(@$lines, $_); + my $lines = shift; + my $toadd = shift; + my $section = shift; + local $_ = join(' ', @$toadd); + # unbreakable spaces + s/\\\s+/ /g; + # em dashes + s/\\\(em\s+/- /g; + # font changes + s/\\f[BIRP]//g; + s/\\-/($section) -/ || s/\s-\s/ ($section) - /; + # other dashes + s/\\-/-/g; + # sequence of spaces + s/\s+$//; + s/\s+/ /g; + # escaped characters + s/\\\&(.)/$1/g; + # gremlins... + s/\\c//g; + push(@$lines, $_); } sub handle_unformated { - my $f = shift; - my $filename = shift; - my @lines = (); - my $so_found = 0; - local $_; - # retrieve basename of file - my ($name, $section) = $filename =~ m|(?:.*/)?(.*)\.([\w\d]+)|; - # scan until macro - while (<$f>) { + my $f = shift; + my $filename = shift; + my @lines = (); + my $so_found = 0; + local $_; + # retrieve basename of file + my ($name, $section) = $filename =~ m|(?:.*/)?(.*)\.([\w\d]+)|; + # scan until macro + while (<$f>) { + next unless m/^\./; + if (m/^\.de/) { + while (<$f>) { + last if m/^\.\./; + } + next; + } + $so_found = 1 if m/\.so/; + if (m/^\.TH/ || m/^\.th/) { + # ($name2, $section2) = m/^\.(?:TH|th)\s+(\S+)\s+(\S+)/; + while (<$f>) { next unless m/^\./; - if (m/^\.de/) { - while (<$f>) { + if (m/^\.SH/ || m/^\.sh/) { + my @subject = (); + while (<$f>) { + last if m/^\.SH/ || m/^\.sh/ || m/^\.SS/ || + m/^\.ss/ || m/^\.nf/; + if (m/^\.PP/ || m/^\.br/ || m/^\.PD/ || /^\.sp/) { + add_fsubject(\@lines, \@subject, $section) + if @subject != 0; + @subject = (); + next; + } + next if m/^\'/ || m/\.tr\s+/ || m/\.\\\"/; + if (m/^\.de/) { + while (<$f>) { last if m/^\.\./; + } + next; } - next; + chomp; + s/\.(?:B|I|IR|SM)\s+//; + push(@subject, $_) unless m/^\s*$/; + } + add_fsubject(\@lines, \@subject, $section) + if @subject != 0; + return \@lines; } - $so_found = 1 if m/\.so/; - if (m/^\.TH/ || m/^\.th/) { - # ($name2, $section2) = m/^\.(?:TH|th)\s+(\S+)\s+(\S+)/; - while (<$f>) { - next unless m/^\./; - if (m/^\.SH/ || m/^\.sh/) { - my @subject = (); - while (<$f>) { - last if m/^\.SH/ || m/^\.sh/ || m/^\.SS/ || - m/^\.ss/ || m/^\.nf/; - if (m/^\.PP/ || m/^\.br/ || m/^\.PD/ || /^\.sp/) { - add_fsubject(\@lines, \@subject, $section) - if @subject != 0; - @subject = (); - next; - } - next if m/^\'/ || m/\.tr\s+/ || m/\.\\\"/; - if (m/^\.de/) { - while (<$f>) { - last if m/^\.\./; - } - next; - } - chomp; - s/\.(?:B|I|IR|SM)\s+//; - push(@subject, $_) unless m/^\s*$/; - } - add_fsubject(\@lines, \@subject, $section) - if @subject != 0; - return \@lines; - } - } - warn "Couldn't find subject in old manpage $filename\n"; - } elsif (m/^\.Dt/) { - $section .= "/$1" if (m/^\.Dt\s+\S+\s+\d\S*\s+(\S+)/); - while (<$f>) { - next unless m/^\./; - if (m/^\.Sh/) { - # subject/keep is the only way to deal with Nm/Nd pairs - my @subject = (); - my @keep = (); - my $nd_seen = 0; - while (<$f>) { - last if m/^\.Sh/; - s/\s,/,/g; - if (s/^\.(..)\s+//) { - my $macro = $1; - next if $macro eq "\\\""; - s/\"(.*?)\"/$1/g; - s/\\-/-/g; - $macro eq 'Xr' and s/^(\S+)\s+(\d\S*)/$1 ($2)/; - $macro eq 'Ox' and s/^/OpenBSD /; - $macro eq 'Nx' and s/^/NetBSD /; - if ($macro eq 'Nd') { - if (@keep != 0) { - add_fsubject(\@lines, \@keep, $section); - @keep = (); - } - push(@subject, "\\-"); - $nd_seen = 1; - } - if ($nd_seen && $macro eq 'Nm') { - @keep = @subject; - @subject = (); - $nd_seen = 0; - } - } - push(@subject, $_) unless m/^\s*$/; - } - unshift(@subject, @keep) if @keep != 0; - add_fsubject(\@lines, \@subject, $section) - if @subject != 0; - return \@lines; + } + warn "Couldn't find subject in old manpage $filename\n"; + } elsif (m/^\.Dt/) { + $section .= "/$1" if (m/^\.Dt\s+\S+\s+\d\S*\s+(\S+)/); + while (<$f>) { + next unless m/^\./; + if (m/^\.Sh/) { + # subject/keep is the only way to deal with Nm/Nd pairs + my @subject = (); + my @keep = (); + my $nd_seen = 0; + while (<$f>) { + last if m/^\.Sh/; + s/\s,/,/g; + if (s/^\.(..)\s+//) { + my $macro = $1; + next if $macro eq "\\\""; + s/\"(.*?)\"/$1/g; + s/\\-/-/g; + $macro eq 'Xr' and s/^(\S+)\s+(\d\S*)/$1 ($2)/; + $macro eq 'Ox' and s/^/OpenBSD /; + $macro eq 'Nx' and s/^/NetBSD /; + if ($macro eq 'Nd') { + if (@keep != 0) { + add_fsubject(\@lines, \@keep, $section); + @keep = (); } + push(@subject, "\\-"); + $nd_seen = 1; + } + if ($nd_seen && $macro eq 'Nm') { + @keep = @subject; + @subject = (); + $nd_seen = 0; + } } + push(@subject, $_) unless m/^\s*$/; + } + unshift(@subject, @keep) if @keep != 0; + add_fsubject(\@lines, \@subject, $section) + if @subject != 0; + return \@lines; } + } } - if ($so_found == 0) { - warn "Unknown manpage type $filename\n"; - } - return \@lines; + } + if ($so_found == 0) { + warn "Unknown manpage type $filename\n"; + } + return \@lines; } - - + + sub add_subject { - my $lines = shift; - local $_ = shift; - my $section = shift; + my $lines = shift; + local $_ = shift; + my $section = shift; - if (m/-/) { - # some twits underline the command name - while (s/_\cH//g || s/(.)\cH\1/$1/g) - {} - s/([-+.\w\d,])\s+/$1 /g; - s/([a-z][A-z])-\s+/$1/g; - # some twits use: func -- description - if (m/^[^-+.\w\d]*(.*) -(?:-?)\s+(.*)$/) { - my ($func, $descr) = ($1, $2); - $func =~ s/,\s*$//; - push(@$lines, "$func ($section) - $descr"); - return; - } + if (m/-/) { + # some twits underline the command name + while (s/_\cH//g || s/(.)\cH\1/$1/g) + {} + s/([-+.\w\d,])\s+/$1 /g; + s/([a-z][A-z])-\s+/$1/g; + # some twits use: func -- description + if (m/^[^-+.\w\d]*(.*) -(?:-?)\s+(.*)$/) { + my ($func, $descr) = ($1, $2); + $func =~ s/,\s*$//; + push(@$lines, "$func ($section) - $descr"); + return; } - print STDERR "Weird subject line $_ in ", shift, "\n"; + } + print STDERR "Weird subject line $_ in ", shift, "\n"; } # $lines = handle_formated($file) # -# handle a formatted manpage in $file +# handle a formatted manpage in $file # -# may return several subjects, perl(3p) do ! +# may return several subjects, perl(3p) do ! # sub handle_formated { - my $file = shift; - my $filename = shift; - local $_; - my ($section, $subject); - my @lines=(); - while (<$file>) { - next if /^$/; + my $file = shift; + my $filename = shift; + local $_; + my ($section, $subject); + my @lines=(); + while (<$file>) { + next if /^$/; + chomp; + # Remove boldface and underlining + while (s/_\cH//g || s/(.)\cH\1/$1/g) + {} + if (m/\w[-+.\w\d]*\(([-+.\w\d\/]+)\)/) { + $section = $1; + # Find architecture + if (m/Manual\s+\((.*?)\)/) { + $section = "$section/$1"; + } + } + # Not all man pages are in english + if (m/^(?:NAME|NAMN|Name)\s*$/) { + unless (defined $section) { + print STDERR "Can't find section in $filename\n"; + $section='??'; + } + while (<$file>) { chomp; - # Remove boldface and underlining - while (s/_\cH//g || s/(.)\cH\1/$1/g) - {} - if (m/\w[-+.\w\d]*\(([-+.\w\d\/]+)\)/) { - $section = $1; - # Find architecture - if (m/Manual\s+\((.*?)\)/) { - $section = "$section/$1"; - } - } - # Not all man pages are in english - if (m/^(?:NAME|NAMN|Name)\s*$/) { - unless (defined $section) { - print STDERR "Can't find section in $filename\n"; - $section='??'; - } - while (<$file>) { - chomp; - # perl agregates several subjects in one manpage - if (m/^$/) { - add_subject(\@lines, $subject, $section, $filename) - if defined $subject; - $subject = undef; - } elsif (m/^\S/ || m/^\s+\*{3,}\s*$/) { - add_subject(\@lines, $subject, $section, $filename) - if defined $subject; - last; - } else { - $subject.=$_; - } - } - last; + # perl agregates several subjects in one manpage + if (m/^$/) { + add_subject(\@lines, $subject, $section, $filename) + if defined $subject; + $subject = undef; + } elsif (m/^\S/ || m/^\s+\*{3,}\s*$/) { + add_subject(\@lines, $subject, $section, $filename) + if defined $subject; + last; + } else { + $subject.=$_; } + } + last; } + } - print STDERR "Can't parse $filename (not a manpage ?)\n" if @lines == 0; - return \@lines; + print STDERR "Can't parse $filename (not a manpage ?)\n" if @lines == 0; + return \@lines; } # $list = find_manpages($dir) # -# find all manpages under $dir, trim some duplicates. +# find all manpages under $dir, trim some duplicates. # sub find_manpages { - my $dir = shift; - my ($list, %nodes); - $list=[]; - find( - sub { - return unless /\.\d\w*(?:\.Z|\.gz)?$/; - return unless -f $_; - my $inode = (stat _)[1]; - return if defined $nodes{$inode}; - $nodes{$inode} = 1; - push(@$list, $File::Find::name); - }, $dir); - return $list; + my $dir = shift; + my ($list, %nodes); + $list=[]; + find( + sub { + return unless /\.\d\w*(?:\.Z|\.gz)?$/; + return unless -f $_; + my $inode = (stat _)[1]; + return if defined $nodes{$inode}; + $nodes{$inode} = 1; + push(@$list, $File::Find::name); + }, $dir); + return $list; } # $subjects = scan_manpages($list) # -# scan a set of manpages, return list of subjects +# scan a set of manpages, return list of subjects # sub scan_manpages { - my $list = shift; - local $_; - my ($done); - $done=[]; + my $list = shift; + local $_; + my ($done); + $done=[]; - for (@$list) { - my ($file, $subjects); - if (m/\.(?:Z|gz)$/) { - $file = new IO::File "gzip -fdc $_|"; - $_ = $`; - } else { - $file = new IO::File $_ or die "$0: Can't read $_\n"; - } - if (m/\.[1-9][^.]*$/) { - $subjects = handle_unformated($file, $_); - } elsif (m/\.0$/) { - $subjects = handle_formated($file, $_); - } else { - warn "Can't find type of $_"; - next; - } - push @$done, @$subjects; + for (@$list) { + my ($file, $subjects); + if (m/\.(?:Z|gz)$/) { + $file = new IO::File "gzip -fdc $_|"; + $_ = $`; + } else { + $file = new IO::File $_ or die "$0: Can't read $_\n"; + } + if (m/\.[1-9][^.]*$/) { + $subjects = handle_unformated($file, $_); + } elsif (m/\.0$/) { + $subjects = handle_formated($file, $_); + } else { + warn "Can't find type of $_"; + next; } - return $done; + push @$done, @$subjects; + } + return $done; } # build_index($dir) # -# build index for $dir +# build index for $dir sub build_index { - my $dir = shift; - my $list = find_manpages($dir); - my $subjects = scan_manpages($list); - write_uniques($subjects, "$dir/whatis.db"); + my $dir = shift; + my $list = find_manpages($dir); + my $subjects = scan_manpages($list); + write_uniques($subjects, "$dir/whatis.db"); } # main code while ($#ARGV != -1 and $ARGV[0] =~ m/^-/) { - my $opt = shift; - last if $opt eq '--'; - if ($opt eq '-d') { - my $mandir = shift; - unless (-d $mandir) { - die "$0: $mandir: not a directory" - } - chdir $mandir; + my $opt = shift; + last if $opt eq '--'; + if ($opt eq '-d') { + my $mandir = shift; + unless (-d $mandir) { + die "$0: $mandir: not a directory" + } + chdir $mandir; - my $whatis = "$mandir/whatis.db"; - my $old = new IO::File $whatis or - die "$0 $whatis to merge with"; - my $subjects = scan_manpages(\@ARGV); - while (<$old>) { - chomp; - push(@$subjects, $_); - } - close $old; - write_uniques($subjects, $whatis); - exit 0; - } else { - die "$0: unknown option $opt\n"; + my $whatis = "$mandir/whatis.db"; + my $old = new IO::File $whatis or + die "$0 $whatis to merge with"; + my $subjects = scan_manpages(\@ARGV); + while (<$old>) { + chomp; + push(@$subjects, $_); } + close $old; + write_uniques($subjects, $whatis); + exit 0; + } else { + die "$0: unknown option $opt\n"; + } } if ($#ARGV == -1) { - local $_; - @ARGV=(); - my $conf; - $conf = new IO::File '/etc/man.conf' or - die "$0: Can't open /etc/man.conf"; - while (<$conf>) { - chomp; - push(@ARGV, $1) if /^_whatdb\s+(.*)\/whatis\.db\s*$/; - } - close $conf; + local $_; + @ARGV=(); + my $conf; + $conf = new IO::File '/etc/man.conf' or + die "$0: Can't open /etc/man.conf"; + while (<$conf>) { + chomp; + push(@ARGV, $1) if /^_whatdb\s+(.*)\/whatis\.db\s*$/; + } + close $conf; } - + for my $mandir (@ARGV) { - if (-f $mandir) { - my @l = ($mandir); - my $s = scan_manpages(\@l); - print join("\n", @$s), "\n"; - exit 0; - } - unless (-d $mandir) { - die "$0: $mandir: not a directory" - } + if (-f $mandir) { + my @l = ($mandir); + my $s = scan_manpages(\@l); + print join("\n", @$s), "\n"; + exit 0; + } + unless (-d $mandir) { + die "$0: $mandir: not a directory" + } build_index($mandir); } |