X-Git-Url: http://git.maemo.org/git/?a=blobdiff_plain;f=deb-src%2Flibtext-diff-perl%2Flibtext-diff-perl-0.35%2Flib%2FText%2FDiff%2FTable.pm;fp=deb-src%2Flibtext-diff-perl%2Flibtext-diff-perl-0.35%2Flib%2FText%2FDiff%2FTable.pm;h=6320c1a2418c519cc6dbf49d89acab121b3d2240;hb=3df72cc8383a92be91804b0f275517da27f60b20;hp=0000000000000000000000000000000000000000;hpb=6f6761b824b9e64ac6775851b55d364442cd7835;p=pkg-perl diff --git a/deb-src/libtext-diff-perl/libtext-diff-perl-0.35/lib/Text/Diff/Table.pm b/deb-src/libtext-diff-perl/libtext-diff-perl-0.35/lib/Text/Diff/Table.pm new file mode 100644 index 0000000..6320c1a --- /dev/null +++ b/deb-src/libtext-diff-perl/libtext-diff-perl-0.35/lib/Text/Diff/Table.pm @@ -0,0 +1,411 @@ +package Text::Diff::Table; + +=head1 NAME + + Text::Diff::Table - Text::Diff plugin to generate "table" format output + +=head1 SYNOPSIS + + use Text::Diff; + + diff \@a, $b { STYLE => "Table" }; + +=head1 DESCRIPTION + +This is a plugin output formatter for Text::Diff that generates "table" style +diffs: + + +--+----------------------------------+--+------------------------------+ + | |../Test-Differences-0.2/MANIFEST | |../Test-Differences/MANIFEST | + | |Thu Dec 13 15:38:49 2001 | |Sat Dec 15 02:09:44 2001 | + +--+----------------------------------+--+------------------------------+ + | | * 1|Changes * + | 1|Differences.pm | 2|Differences.pm | + | 2|MANIFEST | 3|MANIFEST | + | | * 4|MANIFEST.SKIP * + | 3|Makefile.PL | 5|Makefile.PL | + | | * 6|t/00escape.t * + | 4|t/00flatten.t | 7|t/00flatten.t | + | 5|t/01text_vs_data.t | 8|t/01text_vs_data.t | + | 6|t/10test.t | 9|t/10test.t | + +--+----------------------------------+--+------------------------------+ + +This format also goes to some pains to highlight "invisible" characters on +differing elements by selectively escaping whitespace. Each element is split +in to three segments (leading whitespace, body, trailing whitespace). If +whitespace differs in a segement, that segment is whitespace escaped. + +Here is an example of the selective whitespace. + + +--+--------------------------+--------------------------+ + | |demo_ws_A.txt |demo_ws_B.txt | + | |Fri Dec 21 08:36:32 2001 |Fri Dec 21 08:36:50 2001 | + +--+--------------------------+--------------------------+ + | 1|identical |identical | + * 2| spaced in | also spaced in * + * 3|embedded space |embedded tab * + | 4|identical |identical | + * 5| spaced in |\ttabbed in * + * 6|trailing spaces\s\s\n |trailing tabs\t\t\n * + | 7|identical |identical | + * 8|lf line\n |crlf line\r\n * + * 9|embedded ws |embedded\tws * + +--+--------------------------+--------------------------+ + +Here's why the lines do or do not have whitespace escaped: + +=over + +=item lines 1, 4, 7 don't differ, no need. + +=item lines 2, 3 differ in non-whitespace, no need. + +=item lines 5, 6, 8, 9 all have subtle ws changes. + +=back + +Whether or not line 3 should have that tab character escaped is a judgement +call; so far I'm choosing not to. + +=cut + +@ISA = qw( Text::Diff::Base Exporter ); +@EXPORT_OK = qw( expand_tabs ); +$VERSION = 1.2; + +use strict; +use Carp; + + +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 ) ), +# map( "\\c$_", "A".."Z"), + "\\t", "\\n", "\\r", "\\f", "\\b", "\\a", "\\e" + ## NOTE: "\\\\" is not here because some things are explicitly + ## escaped before escape() is called and we don't want to + ## double-escape "\". Also, in most texts, leaving "\" more + ## readable makes sense. +) ; + + +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($); + +{ + ## use utf8 if available. don't if not. + my $escaper = <<'EOCODE' ; + sub escape($) { + use utf8; + join "", map { + $_ = ord; + exists $escapes{$_} + ? $escapes{$_} + : 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; ## Leave sequences in @_[0,1] + 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 ); + + ## Do minimal cleaning on identical elts so these look "normal": + ## tabs are expanded, trailing newelts removed, etc. For differing + ## elts, make invisible characters visible if the invisible characters + ## differ. + 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 { + ## not using \z here for backcompat reasons. + $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 ) { + ## Make leading tabs visible. Other non-' ' chars + ## will be dealt with in escape(), but this prevents + ## tab expansion from hiding tabs by making them + ## look like ' '. + $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 ) { + ## Only trailing whitespace gets the \s treatment + ## to make it obvious what's going on. + $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 $_ ? $_ : "" ) ); + } + ( @{$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}; + } + + ## Not ushifting on to @{$self->{ELTS}} in case it's really big. Want + ## to avoid the overhead. + + 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", + ); + + $fmts{bar} = sprintf $fmts{"="}, "", "", "", "" ; + $fmts{bar} =~ s/\S/+/g; + $fmts{bar} =~ s/ /-/g; + return join( "", + map { + sprintf( $fmts{$_->[-1]}, @$_ ) + } ( + ["bar"], + @heading_lines, + @heading_lines ? ["bar"] : (), + @{$self->{ELTS}}, + ), + ); + + @{$self->{ELTS}} = []; +} + + +=head1 LIMITATIONS + +Table formatting requires buffering the entire diff in memory in order to +calculate column widths. This format should only be used for smaller +diffs. + +Assumes tab stops every 8 characters, as $DIETY intended. + +Assumes all character codes >= 127 need to be escaped as hex codes, ie that the +user's terminal is ASCII, and not even "high bit ASCII", capable. This can be +made an option when the need arises. + +Assumes that control codes (character codes 0..31) that don't have slash-letter +escapes ("\n", "\r", etc) in Perl are best presented as hex escapes ("\x01") +instead of octal ("\001") or control-code ("\cA") escapes. + +=head1 AUTHOR + + Barrie Slaymaker + +=head1 LICENSE + +Copyright 2001 Barrie Slaymaker, All Rights Reserved. + +You may use this software under the terms of the GNU public license, any +version, or the Artistic license. + +=cut + +1;