/libexec/makewhatis/OpenBSD/Makewhatis/Check.pm

https://bitbucket.org/kmv/aeriebsd-src · Perl · 83 lines · 57 code · 4 blank · 22 comment · 17 complexity · 0238025231d673ba6f06eee1356fa0f0 MD5 · raw file

  1. # ex:ts=8 sw=4:
  2. # Copyright (c) 2000-2004 Marc Espie <espie@openbsd.org>
  3. #
  4. # Permission to use, copy, modify, and distribute this software for any
  5. # purpose with or without fee is hereby granted, provided that the above
  6. # copyright notice and this permission notice appear in all copies.
  7. #
  8. # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  9. # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  10. # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  11. # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  12. # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  13. # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  14. # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  15. use strict;
  16. use warnings;
  17. package OpenBSD::Makewhatis::Check;
  18. sub found($$)
  19. {
  20. my ($pattern, $filename) = @_;
  21. my @candidates = glob $pattern;
  22. if (@candidates > 0) {
  23. # quick check of inode, dev number
  24. my ($dev_cmp, $inode_cmp) = (stat $filename)[0,1];
  25. for my $f (@candidates) {
  26. my ($dev, $inode) = (stat $f)[0, 1];
  27. if ($dev == $dev_cmp && $inode == $inode_cmp) {
  28. return 1;
  29. }
  30. }
  31. # slow check with File::Compare
  32. require File::Compare;
  33. for my $f (@candidates) {
  34. if (File::Compare::compare($f, $filename) == 0) {
  35. return 1;
  36. }
  37. }
  38. }
  39. return 0;
  40. }
  41. # verify_subject($subject, $filename):
  42. #
  43. # reparse the subject we're about to add, and check whether it makes
  44. # sense, e.g., is there a man page around.
  45. sub verify_subject($$)
  46. {
  47. local $_ = shift;
  48. my $filename = shift;
  49. if (m/\s*(.*?)\s*\((.*?)\)\s-\s/) {
  50. my $man = $1;
  51. my $section = $2;
  52. my @mans = split(/\s*,\s*|\s+/, $man);
  53. my $base = $filename;
  54. if ($base =~ m|/|) {
  55. $base =~ s,/[^/]*$,,;
  56. } else {
  57. $base = '.';
  58. }
  59. my @notfound = ();
  60. for my $func (@mans) {
  61. my $i = $func;
  62. next if found("$base/$i.*", $filename);
  63. # try harder
  64. $i =~ s/\(\)//;
  65. $i =~ s/\-//g;
  66. $i =~ s,^etc/,,;
  67. next if found("$base/$i.*", $filename);
  68. # and harder...
  69. $i =~ tr/[A-Z]/[a-z]/;
  70. next if found("$base/$i.*", $filename);
  71. push(@notfound, $func);
  72. }
  73. if (@notfound > 0) {
  74. print STDERR "Couldn't find ", join(', ', @notfound),
  75. " in $filename:\n$_\n"
  76. }
  77. }
  78. }
  79. 1;