#===========================================================================

package Sitescooper::HTMLFindNew;

=head1 NAME

Sitescooper::HTMLFindNew - Find new bits in two bodies of HTML markup

=head1 SYNOPSIS

  use Sitescooper::HTMLFindNew;
  $old = "<h1>foo</h1> <p>bar</p> <p>etc</p>";
  $new = "<h1>foo2</h1> <p>baz</p> <p>etc</p>";
  $finder = new Sitescooper::HTMLFindNew();
  $newbits = $finder->find_new ($old, $new);

=head1 DESCRIPTION

C<Sitescooper::HTMLFindNew> will compare two bodies of HTML markup text, and
strip out any sections that are shared by both of them, leaving only the new
additions or modifications to that text.  Consider it a one-directional diff
for HTML.

An attempt will be made to split segments of the HTML text at probable
paragraph, table or list-item break points, to produce useful output.

An external diff command can be specified using set_diff_command(); if this is
not specified, the Algorithm::Diff module will be used.

=head1 SEE ALSO

L<sitescooper(1)>

=head1 COPYRIGHT

Copyright (c) 2000 Justin Mason, All rights reserved.

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AUTHOR

Justin Mason <jm-cpan@jmason.org>

=cut

require Exporter;
use Carp;

use strict;

use vars       qw(
		@ISA @EXPORT $VERSION 
		);

@ISA = qw(Exporter);
@EXPORT= qw();
$VERSION = "0.1";
sub Version { $VERSION; }

sub new {
  my $class = shift; $class = ref($class) || $class;

  my $self = { };

  bless ($self, $class);
  $self;
}

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

sub clean_pre_tags_for_diff {
  my $self = shift;

  my $file = shift;
  my $pre_nl_tag = shift;
  my $pre_pre_tag = shift;
  my $pre_slashpre_tag = shift;

  my $start = '';
  my $end = '';

  ($file =~ s/^(.*)<pre>//i) and $start = $1;
  ($file =~ s/<\/pre>(.*)$//i) and $end = $1;
  $file =~ s/\n/${pre_nl_tag}/gs;

  $start.$pre_pre_tag.$file.$pre_slashpre_tag.$end;
}

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

=item $finder->set_debug ( $bool )

Enables or disables debugging mode, where the diffed files and the
result will be saved to files.  The default is off.

=cut

sub set_debug {
  my ($self, $val) = @_;
  $self->{debugdiffs} = $val;
}

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

=item $finder->set_diff_command ( $command )

Set the command to use as the external diff tool. If this is not specified, the
Perl module Algorithm::Diff will be used instead. Note that if this is
specified, two temporary files will be created and deleted in the current
directory when find_new() is called.

=cut

sub set_diff_command {
  my ($self, $val) = @_;
  $self->{diffcmd} = $val;
}

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

=item $finder->find_new ( $oldtext, $newtext )

Perform the comparison.  

=cut

sub find_new {
  my ($self, $oldfile, $newfile) = @_;
  local ($_);

  if (!defined $oldfile || $oldfile =~ /^\s*$/) {
    if (!$self->{debugdiffs}) { return $newfile; }
    $oldfile = '';
  }

  # it's important to keep these names 8.3 for Windows-95 compatibility,
  # as some Windoze diffs may not be able to handle them otherwise!
  # This also requires that we are chdir'd into the temporary directory
  # to avoid hassles with long filenames in the args when we run the
  # diff command. What a pain!
  #
  my $oldf = "a$$.tmp";		# we are already chdir'ed
  my $newf = "b$$.tmp";

  if ($self->{debugdiffs}) {
    $oldf = "diff_old.tmp";
    $newf = "diff_new.tmp";
  }

  # Split the file lines at probable story-header endpoints.
  # This makes them more amenable to diffing, hopefully without
  # losing bits we don't want to lose, or gaining bits we don't
  # want to gain. Also try to keep cross-line-split HTML tags
  # together.

  # preserve newlines in <pre> text
  my $cleaned_pre_nls = 0;
  my $pre_nl_tag = "<!!!n>";
  my $pre_pre_tag = "<!!!pre>";
  my $pre_slashpre_tag = "<!!!/pre>";

  while ($oldfile =~ /<pre>/i) {
    $oldfile = $self->clean_pre_tags_for_diff ($oldfile,
    			$pre_nl_tag, $pre_pre_tag, $pre_slashpre_tag);
    $cleaned_pre_nls = 1;
  }

  while ($newfile =~ /<pre>/i) {
    $newfile = $self->clean_pre_tags_for_diff ($newfile,
    			$pre_nl_tag, $pre_pre_tag, $pre_slashpre_tag);
    $cleaned_pre_nls = 1;
  }

  # canonicalise all other newlines (we control the vertical!)
  $oldfile =~ s/\s*[\r\n]+\s*/ /gs;
  $newfile =~ s/\s*[\r\n]+\s*/ /gs;

  # remove extraneous whitespace from inside tags
  $oldfile =~ s/<\s*([^>]+?)\s*>/ $_=$1; s,\s+, ,gs; "<$_>"; /gies;
  $newfile =~ s/<\s*([^>]+?)\s*>/ $_=$1; s,\s+, ,gs; "<$_>"; /gies;

  # handle the two types of <p> tags -- <p>...</p>, and just ...<p>
  $oldfile =~ s/<p( *[^>]*>.*?<\/p *[^>]*>)/\n<!!!p$1\n/gi;
  $newfile =~ s/<p( *[^>]*>.*?<\/p *[^>]*>)/\n<!!!p$1\n/gi;

  $oldfile =~ s/(<p *[^>]*>)/$1\n/gi;
  $newfile =~ s/(<p *[^>]*>)/$1\n/gi;

  $oldfile =~ s/<!!!p/<p/gi;
  $newfile =~ s/<!!!p/<p/gi;

  # put newline before these tags (thx Carsten Clasohm, again!)
  $oldfile =~ s/(<(?:table|tr|th|td|div|item) *[^>]*>)/\n$1/gi;
  $newfile =~ s/(<(?:table|tr|th|td|div|item) *[^>]*>)/\n$1/gi;
  # after these ones
  $oldfile =~ s/(<(?:br|hr|table|\/th|\/td|\/table|\/tr|\/div) *[^>]*>)/$1\n/gi;
  $newfile =~ s/(<(?:br|hr|table|\/th|\/td|\/table|\/tr|\/div) *[^>]*>)/$1\n/gi;

  # remove newlines inside <a href> tags. Thx to Carsten Clasohm.
  1 while $oldfile =~ s/(<a href\s*=[^>]+>([^\n<]|<(?!\/a>))*)\n+/$1 /gis;
  1 while $newfile =~ s/(<a href\s*=[^>]+>([^\n<]|<(?!\/a>))*)\n+/$1 /gis;

  if ($cleaned_pre_nls) {
    $oldfile =~ s/${pre_nl_tag}/\n/g; $oldfile =~ s/${pre_pre_tag}/<pre>/g;
    $oldfile =~ s/${pre_slashpre_tag}/<\/pre>/g;
    $newfile =~ s/${pre_nl_tag}/\n/g; $newfile =~ s/${pre_pre_tag}/<pre>/g;
    $newfile =~ s/${pre_slashpre_tag}/<\/pre>/g;
  }

  my $page = '';
  my $created_newf = 0;

  if ($self->{diffcmd} eq '') {
    # use the perl module implementation of diff instead!
    eval '
      use Algorithm::Diff qw(diff);

      my @chunk;
      my ($sign, $lineno, $text);
      my @f1 = split "\n", $oldfile;
      my @f2 = split "\n", $newfile;

      my $diffs = diff(\@f1, \@f2);

      if (@$diffs) {
	my ($chunk, $line);
	foreach $chunk (@$diffs) {
	  foreach $line (@$chunk) {
	    ($sign, $lineno, $text) = @$line;
	    if ($sign =~ /\+/) {
	      $page .= $text . "\n";
	    }
	  }
	}
      }
    1;' or die ("diff code eval failed: $@");

  } else {
    # use an external diff tool for speed
    open (F1, "> $oldf") || warn "cannot write to $oldf\n";
    print F1 $oldfile; close F1;
    open (F2, "> $newf") || warn "cannot write to $newf\n";
    print F2 $newfile; close F2;
    $created_newf = 1;

    if ($self->{diffcmd} ne '' &&
      			open (DIFF, "$self->{diffcmd} $oldf $newf |"))
    {
      while (<DIFF>) {
	/^>(.*)$/ and $page .= $1;
      }
      close DIFF;	# ignore exit status -- exit 1 only means no diffs.

    } else {
      warn "cannot run Diff command \"$self->{diffcmd}\"".
      			", using entire page instead.\n";
      $page = $newfile;
    }
  }

  if ($self->{debugdiffs}) {
    open (F1, "> diff_out.tmp"); print F1 $page; close F1;
    warn "$self->{diffcmd} $oldf $newf = diff_out.tmp\n";

  } else {
    if ($created_newf) {
      unlink $oldf; unlink $newf;
    }
  }

  $page;
}

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

1;