#!/usr/bin/perl
# manpages -- lintian check script

# Copyright (C) 1998 by Christian Schwarz
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.

($#ARGV == 1) or fail("syntax: manpages <pkg> <type>");
$pkg = shift;
$type = shift;

# Read file info...
open(IN,"file-info") or fail("cannot find file-info for $type package $pkg");
while (<IN>) {
  chop;
  
  /^(.*?):\s+(.*)$/o or fail("syntax error in file-info file: $_");
  my ($file,$info) = ($1,$2);

  next unless $file =~ /man/o;

  $file_info{$file} = $info;
}
close(IN);

# Read package contents...
open(IN,"index") or fail("cannot open index file index: $!");
while (<IN>) {
  chop;

  my ($perm,$owner,$size,$date,$time,$file) = split(' ', $_, 6);
  $file =~ s/ link to .*//;

  my $link;
  if ($perm =~ m/^l/) {
      ($file, $link) = split(' -> ', $file);
  }

  # binary that wants a manual page?
  if (($perm =~ m,^[\-l],o) and
      (($file =~ m,^bin/(\S+)(\s|\Z),o) or
       ($file =~ m,^sbin/(\S+)(\s|\Z),o) or
       ($file =~ m,^usr/bin/(\S+)(\s|\Z),o) or
       ($file =~ m,^usr/sbin/(\S+)(\s|\Z),o) or
       ($file =~ m,^usr/games/(\S+)(\s|\Z),o) or
       ($file =~ m,^usr/X11R6/bin/(\S+)(\s|\Z),o) ))
  {
    my $bin = $1;
    
    # special case for sub-directories (e.g., /usr/bin/mh):
    $bin =~ s,^\S+/,,o;

    $binary{$bin} = $file;

    next;
  }

  # manual page?
  next unless ($perm =~ m,^[\-l],o) and (($file =~ m,^usr/man(/\S+),o) or ($file =~ m,^usr/X11R6/man(/\S+),o));
  my $t = $1;
  if (not $t =~ m,^.*man(\d)/([^/]+)$,o) {
    print "E: $pkg $type: manpage-in-wrong-directory $file\n";
    next;
  }
  my ($section,$name) = ($1,$2);
  if ($name =~ m,^(\S+)\.$section[a-zA-Z]*(\.gz)?$,) {
    my ($sname,$ext) = ($1,$2);
    if ($ext eq '.gz') {
      # ok!
      if ($perm =~ m,^-,o) {
	# compressed with maximum compression rate?
	my $info = $file_info{$file};
	if ($info !~ /gzip compressed data/o) {
	  print "E: $pkg $type: manpage-not-compressed-with-gzip $file\n";
	} else {
	  if ($info !~ /max compression/o) {
	    print "E: $pkg $type: manpage-not-compressed-with-max-compression $file\n";
	  }
	}
      }
    } else {
      print "E: $pkg $type: manpage-not-compressed $file\n";
    }
    
    $manpage{$sname} = $file;
  } else {
    print "E: $pkg $type: manpage-has-wrong-extension $file\n";
  }

  # special check for manual pages for X11 games
  if ($file =~ m,^usr/X11R6/man/man6/\S,o) {
    print "W: $pkg $type: x11-games-should-be-in-usr-games $file\n";
  }

  # check symbolic links to other manual pages
  if ($perm =~ m,^l,o) {
    if ($link =~ m,(^|/)undocumented,o) {
      if ($file =~ m,^usr/man,o) {
	# undocumented link in /usr/man--three possibilities
	#    ../man?/undocumented...
	#    ../../man/man?/undocumented...
	#    ../../../usr/man/man?/undocumented...
	unless (($link =~ m,^(\.\./man[237]/)?undocumented.[237]\.gz$,o) or
		($link =~ m,^(\.\./\.\./man/man[237]/)?undocumented.[237]\.gz$,o) or
		($link =~ m,^(\.\./\.\./\.\./usr/man/man[237]/)?undocumented.[237]\.gz$,o)) {
	  print "E: $pkg $type: bad-link-to-undocumented-manpage $file\n";
	}
      } else {
	# undocumented link in /usr/X11R6/man--possibilities:
	#    ../../../man/man?/undocumented...
	#    ../../../../usr/man/man?/undocumented...
	unless (($link =~ m,^(\.\./\.\./\.\./man/man[237]/)?undocumented.[237]\.gz$,o) or
		($link =~ m,^(\.\./\.\./\.\./\.\./usr/man/man[237]/)?undocumented.[237]\.gz$,o)) {
	  print "E: $pkg $type: bad-link-to-undocumented-manpage $file\n";
	}
      }
    }
  }
}
close(IN);

for $f (sort keys %binary) {
  if (exists $manpage{$f}) {
    # X11 binary?
    if ($binary{$f} =~ /X11/) {
      # yes. manpage in X11 too?
      if ($manpage{$f} =~ /X11/) {
	# ok.
      } else {
	print "E: $pkg $type: manpage-for-x11-binary-in-wrong-directory $binary{$f} $manpage{$f}\n";
      }
    } else {
      # no. manpage in X11?
      if ($manpage{$f} =~ /X11/) {
	print "E: $pkg $type: manpage-for-non-x11-binary-in-wrong-directory $binary{$f} $manpage{$f}\n";
      } else {
	# ok.
      }
    }
  } else {
    # versioned binary?
    if ($f =~ /\d$/o) {
      # yes, so skip this check
      next;
    }

    print "E: $pkg $type: binary-without-manpage $f\n";
  }
}

exit 0;

# -----------------------------------

sub fail {
  if ($_[0]) {
    print STDERR "error: $_[0]\n";
  } elsif ($!) {
    print STDERR "error: $!\n";
  } else {
    print STDERR "error.\n";
  }
  exit 1;
}
