use 5.006;
our $VERSION = '1.44';
our @ISA = qw( Text::Diff::Base Exporter );
our @EXPORT_OK = qw( expand_tabs );
my %escapes = map {
my $c =
$_ eq '"' || $_ eq '$' ? qq{'$_'}
: $_ eq "\\" ? qq{"\\\\"}
: qq{"$_"};
( ord eval $c => $_ )
} (
map( chr, 32..126),
map( sprintf( "\\x%02x", $_ ), ( 0..31, 127..255 ) ),
"\\t", "\\n", "\\r", "\\f", "\\b", "\\a", "\\e"
);
sub expand_tabs($) {
my $s = shift;
my $count = 0;
$s =~ s{(\t)(\t*)|([^\t]+)}{
if ( $1 ) {
my $spaces = " " x ( 8 - $count % 8 + 8 * length $2 );
$count = 0;
$spaces;
}
else {
$count += length $3;
$3;
}
}ge;
return $s;
}
sub trim_trailing_line_ends($) {
my $s = shift;
$s =~ s/[\r\n]+(?!\n)$//;
return $s;
}
sub escape($);
SCOPE: {
my $escaper = <<'EOCODE';
sub escape($) {
use utf8;
join "", map {
my $c = $_;
$_ = ord;
exists $escapes{$_}
? $escapes{$_}
: $Text::Diff::Config::Output_Unicode
? $c
: sprintf( "\\x{%04x}", $_ );
} split //, shift;
}
1;
EOCODE
unless ( eval $escaper ) {
$escaper =~ s/ *use *utf8 *;\n// or die "Can't drop use utf8;";
eval $escaper or die $@;
}
}
sub new {
my $proto = shift;
return bless { @_ }, $proto
}
my $missing_elt = [ "", "" ];
sub hunk {
my $self = shift;
my @seqs = ( shift, shift );
my $ops = shift;
my $options = shift;
my ( @A, @B );
for ( @$ops ) {
my $opcode = $_->[Text::Diff::OPCODE()];
if ( $opcode eq " " ) {
push @A, $missing_elt while @A < @B;
push @B, $missing_elt while @B < @A;
}
push @A, [ $_->[0] + ( $options->{OFFSET_A} || 0), $seqs[0][$_->[0]] ]
if $opcode eq " " || $opcode eq "-";
push @B, [ $_->[1] + ( $options->{OFFSET_B} || 0), $seqs[1][$_->[1]] ]
if $opcode eq " " || $opcode eq "+";
}
push @A, $missing_elt while @A < @B;
push @B, $missing_elt while @B < @A;
my @elts;
for ( 0..$#A ) {
my ( $A, $B ) = (shift @A, shift @B );
my $elt_type = $B == $missing_elt ? "A" :
$A == $missing_elt ? "B" :
$A->[1] eq $B->[1] ? "="
: "*";
if ( $elt_type ne "*" ) {
if ( $elt_type eq "=" || $A->[1] =~ /\S/ || $B->[1] =~ /\S/ ) {
$A->[1] = escape trim_trailing_line_ends expand_tabs $A->[1];
$B->[1] = escape trim_trailing_line_ends expand_tabs $B->[1];
}
else {
$A->[1] = escape $A->[1];
$B->[1] = escape $B->[1];
}
}
else {
$A->[1] =~ /^(\s*?)([^ \t].*?)?(\s*)(?![\n\r])$/s;
my ( $l_ws_A, $body_A, $t_ws_A ) = ( $1, $2, $3 );
$body_A = "" unless defined $body_A;
$B->[1] =~ /^(\s*?)([^ \t].*?)?(\s*)(?![\n\r])$/s;
my ( $l_ws_B, $body_B, $t_ws_B ) = ( $1, $2, $3 );
$body_B = "" unless defined $body_B;
my $added_escapes;
if ( $l_ws_A ne $l_ws_B ) {
$added_escapes = 1 if $l_ws_A =~ s/\t/\\t/g;
$added_escapes = 1 if $l_ws_B =~ s/\t/\\t/g;
}
if ( $t_ws_A ne $t_ws_B ) {
$added_escapes = 1 if $t_ws_A =~ s/ /\\s/g;
$added_escapes = 1 if $t_ws_B =~ s/ /\\s/g;
$added_escapes = 1 if $t_ws_A =~ s/\t/\\t/g;
$added_escapes = 1 if $t_ws_B =~ s/\t/\\t/g;
}
else {
$t_ws_A = $t_ws_B = "";
}
my $do_tab_escape = $added_escapes || do {
my $expanded_A = expand_tabs join( $body_A, $l_ws_A, $t_ws_A );
my $expanded_B = expand_tabs join( $body_B, $l_ws_B, $t_ws_B );
$expanded_A eq $expanded_B;
};
my $do_back_escape = $do_tab_escape || do {
my ( $unescaped_A, $escaped_A,
$unescaped_B, $escaped_B
) =
map
join( "", /(\\.)/g ),
map {
( $_, escape $_ )
}
expand_tabs join( $body_A, $l_ws_A, $t_ws_A ),
expand_tabs join( $body_B, $l_ws_B, $t_ws_B );
$unescaped_A ne $unescaped_B && $escaped_A eq $escaped_B;
};
if ( $do_back_escape ) {
$body_A =~ s/\\/\\\\/g;
$body_B =~ s/\\/\\\\/g;
}
my $line_A = join $body_A, $l_ws_A, $t_ws_A;
my $line_B = join $body_B, $l_ws_B, $t_ws_B;
unless ( $do_tab_escape ) {
$line_A = expand_tabs $line_A;
$line_B = expand_tabs $line_B;
}
$A->[1] = escape $line_A;
$B->[1] = escape $line_B;
}
push @elts, [ @$A, @$B, $elt_type ];
}
push @{$self->{ELTS}}, @elts, ["bar"];
return "";
}
sub _glean_formats {
my $self = shift;
}
sub file_footer {
my $self = shift;
my @seqs = (shift,shift);
my $options = pop;
my @heading_lines;
if ( defined $options->{FILENAME_A} || defined $options->{FILENAME_B} ) {
push @heading_lines, [
map(
{
( "", escape( defined $_ ? $_ : "<undef>" ) );
}
( @{$options}{qw( FILENAME_A FILENAME_B)} )
),
"=",
];
}
if ( defined $options->{MTIME_A} || defined $options->{MTIME_B} ) {
push @heading_lines, [
map( {
( "",
escape(
( defined $_ && length $_ )
? localtime $_
: ""
)
);
}
@{$options}{qw( MTIME_A MTIME_B )}
),
"=",
];
}
if ( defined $options->{INDEX_LABEL} ) {
push @heading_lines, [ "", "", "", "", "=" ] unless @heading_lines;
$heading_lines[-1]->[0] = $heading_lines[-1]->[2] =
$options->{INDEX_LABEL};
}
my $four_column_mode = 0;
for my $cols ( @heading_lines, @{$self->{ELTS}} ) {
next if $cols->[-1] eq "bar";
if ( $cols->[0] ne $cols->[2] ) {
$four_column_mode = 1;
last;
}
}
unless ( $four_column_mode ) {
for my $cols ( @heading_lines, @{$self->{ELTS}} ) {
next if $cols->[-1] eq "bar";
splice @$cols, 2, 1;
}
}
my @w = (0,0,0,0);
for my $cols ( @heading_lines, @{$self->{ELTS}} ) {
next if $cols->[-1] eq "bar";
for my $i (0..($#$cols-1)) {
$w[$i] = length $cols->[$i]
if defined $cols->[$i] && length $cols->[$i] > $w[$i];
}
}
my %fmts = $four_column_mode
? (
"=" => "| %$w[0]s|%-$w[1]s | %$w[2]s|%-$w[3]s |\n",
"A" => "* %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s |\n",
"B" => "| %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s *\n",
"*" => "* %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s *\n",
)
: (
"=" => "| %$w[0]s|%-$w[1]s |%-$w[2]s |\n",
"A" => "* %$w[0]s|%-$w[1]s |%-$w[2]s |\n",
"B" => "| %$w[0]s|%-$w[1]s |%-$w[2]s *\n",
"*" => "* %$w[0]s|%-$w[1]s |%-$w[2]s *\n",
);
my @args = ('', '', '');
push(@args, '') if $four_column_mode;
$fmts{bar} = sprintf $fmts{"="}, @args;
$fmts{bar} =~ s/\S/+/g;
$fmts{bar} =~ s/ /-/g;
no warnings;
return join( "",
map {
sprintf( $fmts{$_->[-1]}, @$_ );
} (
["bar"],
@heading_lines,
@heading_lines ? ["bar"] : (),
@{$self->{ELTS}},
),
);
@{$self->{ELTS}} = [];
}
1;