#!/usr/bin/perl -w

# 14 Sep 2006, Tom Browder (tom.browder@gmail.com)

# This form seem to be the most efficient.

# To do:
#   eliminate false positives for common docbook stuff
#   fine tune regexes
#   more optimization
#   correct reporting of line numbers
#   save warnings for a final report
#   modify instructions for the preferred_forms file (to account for regexes)
#   add a help ooption to build an example preferred_forms file

# I like to have a program tell the user how to use it.
my $nargs = scalar(@ARGV);
if (!$nargs) {
  print<<"HERE";

Usage: $0 <preferred forms file> <file1> [<file2> ... <fileN>][--debug]
  Check the input files for use of non-preferred forms of phrases or word.

HERE
  exit;
}

$pref_filename = shift; # the file containing the deprecated/preferred forms

my $debug = 0;
@dbfiles = (); # the docbook files to check
foreach my $arg (@ARGV) {
  if ($arg =~ /-debug/) { $debug = 1; }
  else { push @dbfiles, $arg; }
}

open(PREF_FORMS, $pref_filename) || die "Can't open preferred forms file $pref_filename: $!";

%forms = ();

while (<PREF_FORMS>) {
  if (! /^\s*\#|^\s*$/) { # if line is not a comment or empty
    chop;
    (my $depr, my $repl, my $comm) = split(m!/!);
    if (! $comm) { $comm = ""};
    $forms{"$depr"} = [ $repl, $comm ];
  }
}

foreach my $dbfile (@dbfiles) {
  open(DBFILE, $dbfile) || die "Can't open docbook file $_: $!";

  # Since we want to check for phrases across line breaks, and since we are
  # looping iside the input file, check two lines at a time.
  my $line1 = 0;
  my @lines = <DBFILE>;
  my $nlines = scalar(@lines);
  for (my $ii = 0; $ii < $nlines; ++$ii) {
    my $line = $lines[$ii];

    # Make a tmp line for testing across the line break.
    my $tmp_line = '';
    if (defined($lines[$ii+1])) {
      $tmp_line = $line . $lines[$ii+1];
      # Don't want the ending newline:
      chomp $tmp_line;
    }

    foreach my $depform (keys %forms) {

      # $depform is usually a phrase and the one used may have multiple spaces
      # which are generally ignored in docbook conversions to html or pdf.  So
      # we want to transform the "bad" phrase to a search expression which
      # ignores multiple whitespace between parts of the phrase. For eaxmple,
      # if $depform == 'anti alias' we change it to 'anti\Walias' for the search.

      # Save $depform though for later use.
      my $regex = $depform;
      my @d = split(' ', $regex);
      my $nparts = scalar(@d);
      # If > 1, indicates embedded white space.
      if ($nparts > 1) {
	$regex = join('\\s+', @d);
	if (0 && $debug) {
	  print "\$regex = '$regex'\n";
	  next;
	}
      }
      while ($line =~ /(^|\s+)$regex(\s+|$)*/g) {
	# Note the regex includes allowing for the phrase to start at the
	# beginning of a line or it can end a line.
	print "Deprecated form  `$depform'. Prefer `$forms{$depform}[0]'";
	if ($comment) {
	  print "($comment)";
	}
	print "\n";
	print "${dbfile}:${.}: $line";
	print " " x ( length("${dbfile}:${.}: ") + $-[0] + 1 ), "^^^\n";
      }

      next if ($nparts < 2);

      next if (!$tmp_line);

      # Now we make a string combining the current line with the next line to
      # search across the single line break.

      # Perhaps a better solution is to build a new regex with all
      # combinations of phrase parts with one newline per regex subexpression.
      # For instance, say the phrase for search is 'part1 part2 part3', then
      # we would have something like:
      #   regex = /(part1\s*\n\s*part2\s+\part3)|(part1\s+part2\s*\n\s*\part3)/

      # Build the subexpressions:
      my $np = $nparts - 1;
      my @regex = ();
      for (my $i = 0; $i < $np; ++$i) {
	$regex[$i] = "($d[0]";
	for (my $j = 0; $j < $np; ++$j) {
	  if ($j == $i) {
	    $regex[$i] .= '\\s*\\n\\s*';
	  }
	  else {
	    $regex[$i] .= '\\s+';
	  }
	  $regex[$i] .= $d[$j+1];
	}
	$regex[$i] .= ')';
      }

      # Build the final regex (this can be incorporated into the build above
      # later after it is found to work:
      my $regex2 = '';
      for (my $i = 0; $i < $np; ++$i) {
	if ($i) {
	  $regex2 .= '|';
	}
	$regex2 .= $regex[$i];
      }

      if ($debug) {
	print "Line break \$regex2 = '$regex2'\n";
	print "\$tmp_line = '$tmp_line'\n";
	next;
      }

      while ($tmp_line =~ /$regex2/g) {
	# Test the match.
	print "==Across line break:\n";
	print "Deprecated form (across line break) `$depform'. Prefer `$forms{$depform}[0]'";
	if ($comment) {
	  print "($comment)";
	}
	print "\n";
	print "${dbfile}:${.}: $line";
	print " " x ( length("${dbfile}:${.}: ") + $-[0] + 1 ), "^^^\n";
      }
    }
  }
  close(DBFILE);
}
