File Coverage

blib/lib/Text/WordDiff.pm

Criterion	Covered	Total	%
statement	109	111	98.2
branch	34	44	77.2
condition	9	17	52.9
subroutine	27	27	100.0
pod	0	1	0.0
total	179	200	89.5

package Text::WordDiff;

use strict;
use vars qw(@ISA $VERSION);
use Algorithm::Diff ();
use IO::File;
use Carp;

$VERSION = '0.09';

# _Mastering Regular Expressions_, p. 132.
my $BEGIN_WORD = $] >= 5.006
    ? qr/(?:(?
    : qr/(?:(?

my %styles = (
    ANSIColor    => undef,
    HTML         => undef,
    HTMLTwoLines => undef,
);

sub import {
    my $caller = caller;
    no strict 'refs';
    *{"$caller\::word_diff"} = \&word_diff;
}

sub word_diff ($$;$) {
    my @seqs = ( shift, shift );
    my $opts = $_[0] ? { %{ +shift } } : {};
    $opts->{FILENAME_PREFIX_A} ||= '---';
    $opts->{FILENAME_PREFIX_B} ||= '+++';
    my $AorB = 'A';

    for my $seq (@seqs) {
        my $type = ref $seq;

        while ( $type eq 'CODE' ) {
            $seq = $seq->( $opts );
            $type = ref $seq;
        }

        # Get a handle on options.
        my $filename = \$opts->{"FILENAME_$AorB"};
        my $mtime    = \$opts->{"MTIME_$AorB"};

        if ( $type eq 'ARRAY' ) {
            # The work has already been done for us.
        }

        elsif ( $type eq 'SCALAR' ) {
            # Parse the words from the string.
            $seq     = [ split $BEGIN_WORD, $$seq ];
        }

        elsif ( !$type ) {
            # Assume that it's a raw file name.
            $$filename = $seq           unless defined $$filename;
            $$mtime    = (stat $seq)[9] unless defined $$mtime;

            # Parse the words from the file.
            my $seq_fh = IO::File->new($seq, '<');
            $seq       = do { local $/; [ split $BEGIN_WORD, <$seq_fh> ] };
            $seq_fh->close;
        }

        elsif ( $type eq "GLOB" || UNIVERSAL::isa( $seq, "IO::Handle" ) ) {
            # Parse the words from the file.
            $seq       = do { local $/; [ split $BEGIN_WORD, <$seq> ] };
        }

        else {
            # Damn.
            confess "Can't handle input of type $type";
        }
        $AorB++;
    }

    # Set up the output handler.
    my $output;
    my $out_handler = delete $opts->{OUTPUT};
    my $type = ref $out_handler ;

    if ( ! defined $out_handler ) {
        # Default to concatenating a string.
        $output = '';
        $out_handler = sub { $output .= shift };
    }
    elsif ( $type eq 'CODE' ) {
        # We'll just use the handler.
    }
    elsif ( $type eq 'SCALAR' ) {
        # Append to the scalar reference.
        my $out_ref = $out_handler;
        $out_handler = sub { $$out_ref .= shift };
    }
    elsif ( $type eq 'ARRAY' ) {
        # Push each item onto the array.
        my $out_ref = $out_handler;
        $out_handler = sub { push @$out_ref, shift };
    }
    elsif ( $type eq 'GLOB' || UNIVERSAL::isa( $out_handler, 'IO::Handle' )) {
        # print to the file handle.
        my $output_handle = $out_handler;
        $out_handler = sub { print $output_handle shift };
    }
    else {
        # D'oh!
        croak "Unrecognized output type: $type";
    }

    # Instantiate the diff object, along with any options.
    my $diff = Algorithm::Diff->new(@seqs, delete $opts->{DIFF_OPTS});

    # Load the style class and instantiate an instance.
    my $style  = delete $opts->{STYLE} || 'ANSIColor';
    $style     = __PACKAGE__ . "::$style" if exists $styles{$style};
    eval "require $style" or die $@ unless $style->can('new');
    $style     = $style->new($opts) if !ref $style;

    # Run the diff.
    my $hunks = 0;
    $out_handler->($style->file_header());
    while ($diff->Next) {
        $hunks++;
        $out_handler->( $style->hunk_header() );

        # Output unchanged items.
        if (my @same = $diff->Same) {
            $out_handler->( $style->same_items(@same) );
        }

        # Output deleted and inserted items.
        else {
            if (my @del = $diff->Items(1)) {
                $out_handler->( $style->delete_items(@del) );
            }
            if (my @ins = $diff->Items(2)) {
                $out_handler->( $style->insert_items(@ins) );
            }
        }
        $out_handler->( $style->hunk_footer() );
    }
    $out_handler->( $style->file_footer() );

    return defined $output ? $output : $hunks;
}

package Text::WordDiff::Base;

sub new {
    my ($class, $opts) = @_;
    return bless { %{$opts} } => $class;
}


sub file_header  {
    my $self = shift;
    my $fn1 = $self->filename_a;
    my $fn2 = $self->filename_b;
    return '' unless defined $fn1 && defined $fn2;

    my $p1 = $self->filename_prefix_a;
    my $t1 = $self->mtime_a;
    my $p2 = $self->filename_prefix_b;
    my $t2 = $self->mtime_b;

    return "$p1 $fn1" . (defined $t1 ? "\t" . localtime $t1 : '') . "\n"
         . "$p2 $fn2" . (defined $t2 ? "\t" . localtime $t2 : '') . "\n"
         ;
}

sub hunk_header         { return '' }
sub same_items          { return '' }
sub insert_items        { return '' }
sub delete_items        { return '' }
sub hunk_footer         { return '' }
sub file_footer         { return '' }
sub filename_a          { return shift->{FILENAME_A} }
sub filename_b          { return shift->{FILENAME_B} }
sub mtime_a             { return shift->{MTIME_A}    }
sub mtime_b             { return shift->{MTIME_B}    }
sub filename_prefix_a   { return shift->{FILENAME_PREFIX_A} }
sub filename_prefix_b   { return shift->{FILENAME_PREFIX_B} }

1;
__END__