init III
This commit is contained in:
142
Perl OTRS/Kernel/cpan-lib/Text/Diff/Config.pm
Normal file
142
Perl OTRS/Kernel/cpan-lib/Text/Diff/Config.pm
Normal file
@@ -0,0 +1,142 @@
|
||||
package Text::Diff::Config;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.43';
|
||||
our $Output_Unicode;
|
||||
|
||||
BEGIN
|
||||
{
|
||||
$Output_Unicode = $ENV{'DIFF_OUTPUT_UNICODE'};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Text::Diff::Config - global configuration for Text::Diff (as a
|
||||
separate module).
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Text::Diff::Config;
|
||||
|
||||
$Text::Diff::Config::Output_Unicode = 1;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module configures Text::Diff and its related modules. Currently it contains
|
||||
only one global variable $Text::Diff::Config::Output_Unicode which is a boolean
|
||||
flag, that if set outputs unicode characters as themselves without escaping them
|
||||
as C< \x{HHHH} > first.
|
||||
|
||||
It is initialized to the value of C< $ENV{DIFF_OUTPUT_UNICODE} >, but can be
|
||||
set to a different value at run-time, including using local.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Shlomi Fish, L<http://www.shlomifish.org/> .
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2010, Shlomi Fish.
|
||||
|
||||
This file is licensed under the MIT/X11 License:
|
||||
L<http://www.opensource.org/licenses/mit-license.php>.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in
|
||||
all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
|
||||
THE SOFTWARE.
|
||||
|
||||
=cut
|
||||
|
||||
package Text::Diff::Config;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use vars qw($Output_Unicode);
|
||||
|
||||
BEGIN
|
||||
{
|
||||
$Output_Unicode = $ENV{'DIFF_OUTPUT_UNICODE'};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Text::Diff::Config - global configuration for Text::Diff (as a
|
||||
separate module).
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Text::Diff::Config;
|
||||
|
||||
$Text::Diff::Config::Output_Unicode = 1;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module configures Text::Diff and its related modules. Currently it contains
|
||||
only one global variable $Text::Diff::Config::Output_Unicode which is a boolean
|
||||
flag, that if set outputs unicode characters as themselves without escaping them
|
||||
as C< \x{HHHH} > first.
|
||||
|
||||
It is initialized to the value of C< $ENV{DIFF_OUTPUT_UNICODE} >, but can be
|
||||
set to a different value at run-time, including using local.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Shlomi Fish, L<http://www.shlomifish.org/> .
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright 2010, Shlomi Fish.
|
||||
|
||||
This file is licensed under the MIT/X11 License:
|
||||
L<http://www.opensource.org/licenses/mit-license.php>.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in
|
||||
all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
|
||||
THE SOFTWARE.
|
||||
|
||||
=cut
|
||||
|
||||
374
Perl OTRS/Kernel/cpan-lib/Text/Diff/FormattedHTML.pm
Normal file
374
Perl OTRS/Kernel/cpan-lib/Text/Diff/FormattedHTML.pm
Normal file
@@ -0,0 +1,374 @@
|
||||
package Text::Diff::FormattedHTML;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use File::Slurp;
|
||||
use Algorithm::Diff 'traverse_balanced';
|
||||
use String::Diff 'diff';
|
||||
|
||||
use base 'Exporter';
|
||||
|
||||
our @EXPORT = (qw'diff_files diff_strings diff_css');
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Text::Diff::FormattedHTML - Generate a colorful HTML diff of strings/files.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.08
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.08';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Text::Diff::FormattedHTML;
|
||||
|
||||
my $output = diff_files($file1, $file2);
|
||||
|
||||
# for strings
|
||||
|
||||
my $output = diff_strings( { vertical => 1 }, $file1, $file2);
|
||||
|
||||
|
||||
# as you might want some CSS:
|
||||
open OUT, ">diff.html";
|
||||
print OUT "<style type='text/css'>\n", diff_css(), "</style>\n";
|
||||
print OUT diff_files('fileA', 'fileB');
|
||||
close OUT;
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Presents in a (nice?) HTML table the difference between two files or strings.
|
||||
Inspired on GitHub diff view.
|
||||
|
||||
=head1 SUBROUTINES
|
||||
|
||||
=head2 diff_files
|
||||
|
||||
my $html = diff_files("filename1", "filename2");
|
||||
|
||||
C<diff_files> and C<diff_strings> support a first optional argument
|
||||
(an hash reference) where options can be set.
|
||||
|
||||
Valid options are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item C<vertical>
|
||||
|
||||
Can be set to a true value, for a more compact table.
|
||||
|
||||
=item C<limit_onesided>
|
||||
|
||||
Makes tables look nicer when there is a side with too many new lines.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub diff_files {
|
||||
my $settings = {};
|
||||
$settings = shift if ref($_[0]) eq "HASH";
|
||||
|
||||
my ($f1, $f2) = @_;
|
||||
|
||||
die "$f1 not available" unless -f $f1;
|
||||
die "$f2 not available" unless -f $f2;
|
||||
|
||||
my @f1 = read_file $f1;
|
||||
my @f2 = read_file $f2;
|
||||
|
||||
_internal_diff($settings, \@f1, \@f2);
|
||||
}
|
||||
|
||||
=head2 diff_strings
|
||||
|
||||
my $html = diff_strings("string1", "string2");
|
||||
|
||||
Compare strings. First split by newline, and then treat them as file
|
||||
content (see function above).
|
||||
|
||||
=cut
|
||||
|
||||
sub diff_strings {
|
||||
my $settings = {};
|
||||
$settings = shift if ref($_[0]) eq "HASH";
|
||||
|
||||
my ($s1, $s2) = @_;
|
||||
my @f1 = split /\n/, $s1;
|
||||
my @f2 = split /\n/, $s2;
|
||||
_internal_diff($settings, \@f1, \@f2);
|
||||
}
|
||||
|
||||
=head2 diff_css
|
||||
|
||||
my $css = diff_css;
|
||||
|
||||
Return the default css. You are invited to override it.
|
||||
|
||||
=cut
|
||||
|
||||
sub diff_css {
|
||||
return <<'EOCSS';
|
||||
table.diff {
|
||||
border-collapse: collapse;
|
||||
border-top: solid 1px #999999;
|
||||
border-left: solid 1px #999999;
|
||||
}
|
||||
|
||||
table.diff td {
|
||||
padding: 2px;
|
||||
padding-left: 5px;
|
||||
padding-right: 5px;
|
||||
border-right: solid 1px #999999;
|
||||
border-bottom: solid 1px #999999;
|
||||
}
|
||||
|
||||
table.diff td:nth-child(1),
|
||||
table.diff td:nth-child(2) {
|
||||
background-color: #deedff;
|
||||
}
|
||||
|
||||
table.diff tr.change,
|
||||
table.diff tr.disc_a,
|
||||
table.diff tr.disc_b {
|
||||
background-color: #ffffdd;
|
||||
}
|
||||
|
||||
table.diff tr.del {
|
||||
background-color: #ffeeee;
|
||||
}
|
||||
|
||||
table.diff tr.ins {
|
||||
background-color: #eeffee;
|
||||
}
|
||||
|
||||
|
||||
table.diff td:nth-child(3),
|
||||
table.diff td:nth-child(4) {
|
||||
font-family: monospace;
|
||||
white-space: pre;
|
||||
}
|
||||
|
||||
table.diff td ins {
|
||||
padding: 2px;
|
||||
color: #009900;
|
||||
background-color: #ccffcc;
|
||||
text-decoration: none;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
table.diff td del {
|
||||
padding: 2px;
|
||||
color: #990000;
|
||||
background-color: #ffcccc;
|
||||
text-decoration: none;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
EOCSS
|
||||
}
|
||||
|
||||
sub _protect {
|
||||
my $x = shift;
|
||||
if ($x) {
|
||||
$x =~ s/&/&/g;
|
||||
$x =~ s/</</g;
|
||||
$x =~ s/>/>/g;
|
||||
}
|
||||
return $x;
|
||||
}
|
||||
|
||||
sub _internal_diff {
|
||||
my ($settings, $sq1, $sq2) = @_;
|
||||
|
||||
my $get = sub {
|
||||
my ($l, $r) = @_;
|
||||
$l = $sq1->[$l];
|
||||
$r = $sq2->[$r];
|
||||
chomp($l) if $l;
|
||||
chomp($r) if $r;
|
||||
return ($l,$r);
|
||||
};
|
||||
|
||||
my ($ll, $rl);
|
||||
|
||||
my $line = sub {
|
||||
sprintf("<tr class='%s'><td>%s</td><td>%s</td><td>%s</td><td>%s</td></tr>\n", @_);
|
||||
};
|
||||
|
||||
if ($settings->{limit_onesided}) {
|
||||
# Prevent really long lists where we just go on showing
|
||||
# all of the values that one side does not have
|
||||
if($settings->{vertical}){
|
||||
die "Option: [vertical] is incompatible with [limit_empty]";
|
||||
}
|
||||
my ($am_skipping, $num_since_lc, $num_since_rc) = (0, 0, 0);
|
||||
$line = sub {
|
||||
my ($class, $ln, $rn, $l, $r) = @_;
|
||||
|
||||
my $out = '';
|
||||
if(
|
||||
($class ne 'disc_a') &&
|
||||
($class ne 'disc_b')
|
||||
){
|
||||
if($am_skipping){
|
||||
$out .= "($num_since_lc, $num_since_rc)</td></tr>\n";
|
||||
}
|
||||
($am_skipping, $num_since_lc, $num_since_rc) = (0, 0, 0);
|
||||
}elsif($class ne 'disc_a'){
|
||||
$num_since_lc++;
|
||||
}elsif($class ne 'disc_b'){
|
||||
$num_since_rc++;
|
||||
}
|
||||
if(
|
||||
($num_since_lc > $settings->{limit_onesided}) ||
|
||||
($num_since_rc > $settings->{limit_onesided})
|
||||
){
|
||||
if(!$am_skipping){
|
||||
$out = '<tr><td colspan=4>';
|
||||
$am_skipping = 1;
|
||||
}
|
||||
$out .= '. ';
|
||||
return $out;
|
||||
}
|
||||
|
||||
$out .= sprintf("<tr class='%s'><td>%s</td><td>%s</td><td>%s</td><td>%s</td></tr>\n", @_);
|
||||
return $out;
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
if ($settings->{vertical}) {
|
||||
$line = sub {
|
||||
my $out = "";
|
||||
my ($class, $ln, $rn, $l, $r) = @_;
|
||||
if ($l eq $r) {
|
||||
$out .= sprintf("<tr class='%s'><td>%s</td><td>%s</td><td>%s</td></tr>\n",
|
||||
$class, $ln, $rn, $l);
|
||||
} else {
|
||||
$class eq "disc_a" && ($class = "disc_a del");
|
||||
$class eq "disc_b" && ($class = "disc_b ins");
|
||||
|
||||
$class eq "change" && ($class = "change del");
|
||||
$l and $out .= sprintf("<tr class='%s'><td>%s</td><td></td><td>%s</td></tr>\n",
|
||||
$class, $ln, $l);
|
||||
$class eq "change del" && ($class = "change ins");
|
||||
$r and $out .= sprintf("<tr class='%s'><td></td><td>%s</td><td>%s</td></tr>\n",
|
||||
$class, $rn, $r);
|
||||
}
|
||||
$out
|
||||
}
|
||||
}
|
||||
|
||||
my $out = "<table class='diff'>\n";
|
||||
|
||||
traverse_balanced $sq1, $sq2,
|
||||
{
|
||||
MATCH => sub {
|
||||
my ($l, $r) = $get->(@_);
|
||||
++$ll; ++$rl;
|
||||
$out .= $line->('match', $ll, $rl, _protect($l), _protect($r));
|
||||
},
|
||||
DISCARD_A => sub {
|
||||
my ($l, $r) = $get->(@_);
|
||||
++$ll;
|
||||
$out .= $line->('disc_a', $ll, '', _protect($l), '');
|
||||
},
|
||||
DISCARD_B => sub {
|
||||
my ($l, $r) = $get->(@_);
|
||||
++$rl;
|
||||
$out .= $line->('disc_b', '', $rl, '', _protect($r));
|
||||
},
|
||||
CHANGE => sub {
|
||||
my ($l, $r) = $get->(@_);
|
||||
my $diff = diff($l, $r,
|
||||
remove_open => '#del#',
|
||||
remove_close => '#/del#',
|
||||
append_open => '#ins#',
|
||||
append_close => '#/ins#',
|
||||
);
|
||||
++$ll; ++$rl;
|
||||
$out .= $line->('change', $ll, $rl,
|
||||
_retag(_protect($diff->[0])), _retag(_protect($diff->[1])));
|
||||
},
|
||||
};
|
||||
$out .= "</table>\n";
|
||||
}
|
||||
|
||||
sub _retag {
|
||||
my $x = shift;
|
||||
$x =~ s/#(.?(?:del|ins))#/<$1>/g;
|
||||
return $x;
|
||||
}
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Alberto Simoes, C<< <ambs at cpan.org> >>
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Please report any bugs or feature requests to
|
||||
C<bug-text-diff-formattedhtml at rt.cpan.org>, or through the web
|
||||
interface at
|
||||
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Text-Diff-FormattedHTML>.
|
||||
I will be notified, and then you'll automatically be notified of
|
||||
progress on your bug as I make changes.
|
||||
|
||||
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc Text::Diff::FormattedHTML
|
||||
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * RT: CPAN's request tracker (report bugs here)
|
||||
|
||||
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-Diff-FormattedHTML>
|
||||
|
||||
=item * AnnoCPAN: Annotated CPAN documentation
|
||||
|
||||
L<http://annocpan.org/dist/Text-Diff-FormattedHTML>
|
||||
|
||||
=item * CPAN Ratings
|
||||
|
||||
L<http://cpanratings.perl.org/d/Text-Diff-FormattedHTML>
|
||||
|
||||
=item * Search CPAN
|
||||
|
||||
L<http://search.cpan.org/dist/Text-Diff-FormattedHTML/>
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS
|
||||
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 2011 Alberto Simoes.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of either: the GNU General Public License as published
|
||||
by the Free Software Foundation; or the Artistic License.
|
||||
|
||||
See http://dev.perl.org/licenses/ for more information.
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of Text::Diff::FormattedHTML
|
||||
222
Perl OTRS/Kernel/cpan-lib/Text/Diff/HTML.pm
Normal file
222
Perl OTRS/Kernel/cpan-lib/Text/Diff/HTML.pm
Normal file
@@ -0,0 +1,222 @@
|
||||
package Text::Diff::HTML;
|
||||
|
||||
use strict;
|
||||
use vars qw(@ISA $VERSION);
|
||||
use HTML::Entities;
|
||||
use Text::Diff (); # Just to be safe.
|
||||
|
||||
$VERSION = '0.07';
|
||||
@ISA = qw(Text::Diff::Unified);
|
||||
|
||||
sub file_header {
|
||||
return '<div class="file"><span class="fileheader">'
|
||||
. encode_entities(shift->SUPER::file_header(@_))
|
||||
. '</span>';
|
||||
}
|
||||
|
||||
sub hunk_header {
|
||||
return '<div class="hunk"><span class="hunkheader">'
|
||||
. encode_entities(shift->SUPER::hunk_header(@_))
|
||||
. '</span>';
|
||||
}
|
||||
|
||||
sub hunk_footer {
|
||||
return '<span class="hunkfooter">'
|
||||
. encode_entities(shift->SUPER::hunk_footer(@_))
|
||||
. '</span></div>';
|
||||
}
|
||||
|
||||
sub file_footer {
|
||||
return '<span class="filefooter">'
|
||||
. encode_entities(shift->SUPER::file_footer(@_))
|
||||
. '</span></div>';
|
||||
}
|
||||
|
||||
# Each of the items in $seqs is an array reference. The first one has the
|
||||
# contents of the first file and the second has the contents of the second
|
||||
# file, all broken into hunks. $ops is an array reference of array references,
|
||||
# one corresponding to each of the hunks in the sequences.
|
||||
#
|
||||
# The contents of each op in $ops tell us what to do with each hunk. Each op
|
||||
# can have up to four items:
|
||||
#
|
||||
# 0: The index of the relevant hunk in the first file sequence.
|
||||
# 1: The index of the relevant hunk in the second file sequence.
|
||||
# 2: The opcode for the hunk, either '+', '-', or ' '.
|
||||
# 3: A flag; not sure what this is, doesn't seem to apply to unified diffs.
|
||||
#
|
||||
# So what we do is figure out which op we have and output the relevant span
|
||||
# element if it is different from the last op. Then we select the hunk from
|
||||
# second sequence (SEQ_B_IDX) if it's '+' and the first sequence (SEQ_A_IDX)
|
||||
# otherwise, and then output the opcode and the hunk.
|
||||
|
||||
use constant OPCODE => 2; # "-", " ", "+"
|
||||
use constant SEQ_A_IDX => 0;
|
||||
use constant SEQ_B_IDX => 1;
|
||||
|
||||
my %code_map = (
|
||||
'+' => [ 'ins' => 'ins' ],
|
||||
'-' => [ 'del' => 'del' ],
|
||||
' ' => [ 'span class="ctx"' => 'span' ]
|
||||
);
|
||||
|
||||
sub hunk {
|
||||
shift;
|
||||
my $seqs = [ shift, shift ];
|
||||
my $ops = shift;
|
||||
return unless @$ops;
|
||||
|
||||
# Start the span element for the first opcode.
|
||||
my $last = $ops->[0][ OPCODE ];
|
||||
my $hunk = qq{<$code_map{ $last }->[0]>};
|
||||
|
||||
# Output each line of the hunk.
|
||||
while (my $op = shift @$ops) {
|
||||
my $opcode = $op->[OPCODE];
|
||||
my $elem = $code_map{ $opcode } or next;
|
||||
|
||||
# Close the last span and start a new one for a new opcode.
|
||||
if ($opcode ne $last) {
|
||||
$hunk .= "</$code_map{ $last }->[1]><$elem->[0]>";
|
||||
$last = $opcode;
|
||||
}
|
||||
|
||||
# Output the appropriate line.
|
||||
my $idx = $opcode ne '+' ? SEQ_A_IDX : SEQ_B_IDX;
|
||||
$hunk .= encode_entities("$opcode $seqs->[$idx][$op->[$idx]]");
|
||||
}
|
||||
|
||||
return $hunk . "</$code_map{ $last }->[1]>";
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
##############################################################################
|
||||
|
||||
=head1 Name
|
||||
|
||||
Text::Diff::HTML - XHTML format for Text::Diff::Unified
|
||||
|
||||
=head1 Synopsis
|
||||
|
||||
use Text::Diff;
|
||||
|
||||
my $diff = diff "file1.txt", "file2.txt", { STYLE => 'Text::Diff::HTML' };
|
||||
my $diff = diff \$string1, \$string2, { STYLE => 'Text::Diff::HTML' };
|
||||
my $diff = diff \*FH1, \*FH2, { STYLE => 'Text::Diff::HTML' };
|
||||
my $diff = diff \&reader1, \&reader2, { STYLE => 'Text::Diff::HTML' };
|
||||
my $diff = diff \@records1, \@records2, { STYLE => 'Text::Diff::HTML' };
|
||||
my $diff = diff \@records1, "file.txt", { STYLE => 'Text::Diff::HTML' };
|
||||
|
||||
=head1 Description
|
||||
|
||||
This class subclasses Text::Diff::Unified, a formatting class provided by the
|
||||
L<Text::Diff> module, to add XHTML markup to the unified diff format. For
|
||||
details on the interface of the C<diff()> function, see the L<Text::Diff>
|
||||
documentation.
|
||||
|
||||
In the XHTML formatted by this module, the contents of the diff returned by
|
||||
C<diff()> are wrapped in a C<< <div> >> element, as is each hunk of the diff.
|
||||
Within each hunk, all content is properly HTML encoded using
|
||||
L<HTML::Entities>, and the various sections of the diff are marked up with the
|
||||
appropriate XHTML elements. The elements used are as follows:
|
||||
|
||||
=over
|
||||
|
||||
=item * C<< <div class="file"> >>
|
||||
|
||||
This element contains the entire contents of the diff "file" returned by
|
||||
C<diff()>. All of the following elements are subsumed by this one.
|
||||
|
||||
=over
|
||||
|
||||
=item * C<< <span class="fileheader"> >>
|
||||
|
||||
The header section for the files being C<diff>ed, usually something like:
|
||||
|
||||
--- in.txt Thu Sep 1 12:51:03 2005
|
||||
+++ out.txt Thu Sep 1 12:52:12 2005
|
||||
|
||||
This element immediately follows the opening "file" C<< <div> >> element.
|
||||
|
||||
=item * C<< <div class="hunk"> >>
|
||||
|
||||
This element contains a single diff "hunk". Each hunk may contain the
|
||||
following elements:
|
||||
|
||||
=over
|
||||
|
||||
=item * C<< <span class="hunkheader"> >>
|
||||
|
||||
Header for a diff hunk. The hunk header is usually something like:
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
|
||||
This element immediately follows the opening "hunk" C<< <div> >> element.
|
||||
|
||||
=item * C<< <span class="ctx"> >>
|
||||
|
||||
Context around the important part of a C<diff> hunk. These are contents that
|
||||
have I<not> changed between the files being C<diff>ed.
|
||||
|
||||
=item * C<< <ins> >>
|
||||
|
||||
Inserted content, each line starting with C<+>.
|
||||
|
||||
=item * C<< <del> >>
|
||||
|
||||
Deleted content, each line starting with C<->.
|
||||
|
||||
=item * C<< <span class="hunkfooter"> >>
|
||||
|
||||
The footer section of a hunk; contains no contents.
|
||||
|
||||
=back
|
||||
|
||||
=item * C<< <span class="filefooter"> >>
|
||||
|
||||
The footer section of a file; contains no contents.
|
||||
|
||||
=back
|
||||
|
||||
=back
|
||||
|
||||
You may do whatever you like with these elements and classes; I highly
|
||||
recommend that you style them using CSS. You'll find an example CSS file in
|
||||
the F<eg> directory in the Text-Diff-HTML distribution. You will also likely
|
||||
want to wrap the output of your diff in its own element (a C<< <div> >> will
|
||||
do) styled with "white-space: pre".
|
||||
|
||||
=head1 See Also
|
||||
|
||||
=over
|
||||
|
||||
=item L<Text::Diff>
|
||||
|
||||
=item L<Algorithm::Diff>
|
||||
|
||||
=back
|
||||
|
||||
=head1 Support
|
||||
|
||||
This module is stored in an open L<GitHub
|
||||
repository|http://github.com/theory/text-diff-html/>. Feel free to fork and
|
||||
contribute!
|
||||
|
||||
Please file bug reports via L<GitHub
|
||||
Issues|http://github.com/theory/text-diff-html/issues/> or by sending mail to
|
||||
L<bug-Text-Diff-HTML@rt.cpan.org|mailto:bug-Text-Diff-HTML@rt.cpan.org>.
|
||||
|
||||
=head1 Author
|
||||
|
||||
David E. Wheeler <david@justatheory.com>
|
||||
|
||||
=head1 Copyright and License
|
||||
|
||||
Copyright (c) 2005-2011 David E. Wheeler. Some Rights Reserved.
|
||||
|
||||
This module is free software; you can redistribute it and/or modify it under the
|
||||
same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
429
Perl OTRS/Kernel/cpan-lib/Text/Diff/Table.pm
Normal file
429
Perl OTRS/Kernel/cpan-lib/Text/Diff/Table.pm
Normal file
@@ -0,0 +1,429 @@
|
||||
package Text::Diff::Table;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Text::Diff::Config;
|
||||
|
||||
our $VERSION = '1.43';
|
||||
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 ) ),
|
||||
# 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($);
|
||||
|
||||
SCOPE: {
|
||||
## use utf8 if available. don't if not.
|
||||
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; ## 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 $_ ? $_ : "<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};
|
||||
}
|
||||
|
||||
## 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",
|
||||
);
|
||||
|
||||
my @args = ('', '', '');
|
||||
push(@args, '') if $four_column_mode;
|
||||
$fmts{bar} = sprintf $fmts{"="}, @args;
|
||||
$fmts{bar} =~ s/\S/+/g;
|
||||
$fmts{bar} =~ s/ /-/g;
|
||||
|
||||
# Sometimes the sprintf has too many arguments,
|
||||
# which results in a warning on Perl 5.021+
|
||||
# I really wanted to write:
|
||||
# no warnings 'redundant';
|
||||
# but that causes a compilation error on older versions of perl
|
||||
# where the warnings pragma doesn't know about 'redundant'
|
||||
no warnings;
|
||||
|
||||
return join( "",
|
||||
map {
|
||||
sprintf( $fmts{$_->[-1]}, @$_ );
|
||||
} (
|
||||
["bar"],
|
||||
@heading_lines,
|
||||
@heading_lines ? ["bar"] : (),
|
||||
@{$self->{ELTS}},
|
||||
),
|
||||
);
|
||||
|
||||
@{$self->{ELTS}} = [];
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=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.
|
||||
|
||||
=head1 UNICODE
|
||||
|
||||
To output the raw unicode chracters consult the documentation of
|
||||
L<Text::Diff::Config>. You can set the C<DIFF_OUTPUT_UNICODE> environment
|
||||
variable to 1 to output it from the command line. For more information,
|
||||
consult this bug: L<https://rt.cpan.org/Ticket/Display.html?id=54214> .
|
||||
|
||||
=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 E<lt>barries@slaysys.comE<gt>
|
||||
|
||||
=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
|
||||
Reference in New Issue
Block a user