#!/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("an error in the file pkg is preventing lintian from checking this package: $_");
  my ($file,$info) = ($1,$2);

  next unless $file =~ /man/o;
  $file =~ s,^(\./)?,,;

  $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,^(\./),,;
  	$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) 
			or ($file =~ m,^usr/share/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"; }

#  reformatted to here

  # check symbolic links to other manual pages
  if ($perm =~ m,^l,o) {
    if ($link =~ m,(^|/)undocumented,o) {
      if ($file =~ m,^usr/share/man,o) {
	# undocumented link in /usr/share/man--four possibilities
	#    ../man?/undocumented...
	#    ../../man/man?/undocumented...
	#    ../../../share/man/man?/undocumented...
	#    ../../../../usr/share/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,^(\.\./\.\./\.\./share/man/man[237]/)?undocumented.[237]\.gz$,o) or
		($link =~ m,^(\.\./\.\./\.\./\.\./usr/share/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:
	#    ../../../share/man/man?/undocumented...
	#    ../../../../usr/share/man/man?/undocumented...
	unless (($link =~ m,^(\.\./\.\./\.\./share/man/man[237]/)?undocumented.[237]\.gz$,o) or
		($link =~ m,^(\.\./\.\./\.\./\.\./usr/share/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 "internal error: $_[0]\n";
  } elsif ($!) {
    print STDERR "internal error: $!\n";
  } else {
    print STDERR "internal error.\n";
  }
  exit 1;
}
