File Coverage

blib/lib/Algorithm/Diff/HTMLTable.pm
Criterion Covered Total %
statement 107 107 100.0
branch 36 40 90.0
condition 19 24 79.1
subroutine 16 16 100.0
pod 2 2 100.0
total 180 189 95.2


line stmt bran cond sub pod time code
1             package Algorithm::Diff::HTMLTable;
2              
3             # ABSTRACT: Show differences of a file as a HTML table
4              
5 10     10   699688 use strict;
  10         96  
  10         280  
6 10     10   52 use warnings;
  10         19  
  10         305  
7              
8 10     10   5626 use Algorithm::Diff;
  10         47212  
  10         478  
9 10     10   86 use Carp;
  10         24  
  10         588  
10 10     10   5871 use HTML::Entities;
  10         54885  
  10         834  
11 10     10   5320 use Time::Piece;
  10         104614  
  10         49  
12              
13             our $VERSION = '0.05';
14              
15             sub new {
16 10     10 1 2045 my ($class, @param) = @_;
17              
18 10         54 return bless {@param}, $class;
19             }
20              
21             sub diff {
22 12     12 1 2672 my $self = shift;
23              
24 12 100       349 croak "need two filenames" if @_ != 2;
25              
26 9         21 my %files;
27              
28 9         44 @files{qw/a b/} = @_;
29              
30             NAME:
31 9         28 for my $name ( qw/a b/ ) {
32              
33 16 100 100     154 croak 'Need either filename or array reference' if ref $files{$name} && ref $files{$name} ne 'ARRAY';
34 15 100       47 next NAME if ref $files{$name};
35              
36 11 100       279 croak $files{$name} . " is not a file" if !-f $files{$name};
37 10 50       146 croak $files{$name} . " is not a readable file" if !-r $files{$name};
38             }
39              
40 7         48 my $html = $self->_start_table( %files );
41 7         40 $html .= $self->_build_table( %files );
42 7         49 $html .= $self->_end_table( %files );
43              
44 7         67 return $html;
45             }
46              
47             sub _start_table {
48 7     7   54 my $self = shift;
49 7         28 my %files = @_;
50              
51 7         51 my $old = $self->_file_info( $files{a}, 'old' );
52 7         48 my $new = $self->_file_info( $files{b}, 'new' );
53            
54 7 100       61 my $id = defined $self->{id} ? qq~id="$self->{id}"~ : '';
55              
56 7         46 return qq~
57            
58            
59            
60             $old
61             $new
62            
63            
64            
65             ~;
66             }
67              
68             sub _build_table {
69 7     7   16 my $self = shift;
70              
71 7         22 my %files = @_;
72              
73 7         30 my @seq_a = $self->_read_file( $files{a} );
74 7         34 my @seq_b = $self->_read_file( $files{b} );
75              
76 7         67 my $diff = Algorithm::Diff->new( \@seq_a, \@seq_b );
77              
78 7         2799 $diff->Base(1);
79              
80 7         65 my $rows = '';
81              
82 7         22 my ($line_nr_a, $line_nr_b) = (1, 1);
83 7         31 while ( $diff->Next ) {
84 55 100       1150 if ( my $count = $diff->Same ) {
    100          
    100          
85 27         566 for my $string ( $diff->Same ) {
86 37         593 $rows .= $self->_add_tablerow(
87             line_nr_a => $line_nr_a++,
88             line_nr_b => $line_nr_b++,
89             line_a => $string,
90             line_b => $string,
91             color_a => '',
92             color_b => '',
93             );
94             }
95             }
96             elsif ( !$diff->Items(2) ) {
97 5         195 my @items_1 = $diff->Items(1);
98 5         112 my @items_2 = $diff->Items(2);
99            
100 5 50       80 my $max = @items_1 > @items_2 ? scalar( @items_1 ) : scalar( @items_2 );
101            
102 5         22 for my $index ( 1 .. $max ) {
103 5   50     66 $rows .= $self->_add_tablerow(
      50        
104             line_nr_a => $line_nr_a++,
105             line_nr_b => '',
106             line_a => $items_1[ $index - 1 ] // '',
107             line_b => $items_2[ $index - 1 ] // '',
108             color_a => 'red',
109             color_b => '',
110             );
111             }
112             }
113             elsif ( !$diff->Items(1) ) {
114 10         328 my @items_1 = $diff->Items(1);
115 10         139 my @items_2 = $diff->Items(2);
116            
117 10 50       154 my $max = @items_1 > @items_2 ? scalar( @items_1 ) : scalar( @items_2 );
118            
119 10         30 for my $index ( 1 .. $max ) {
120 10   50     73 $rows .= $self->_add_tablerow(
      50        
121             line_nr_a => '',
122             line_nr_b => $line_nr_b++,
123             line_a => $items_1[ $index - 1 ] // '',
124             line_b => $items_2[ $index - 1 ] // '',
125             color_a => '',
126             color_b => 'green',
127             );
128             }
129             }
130             else {
131 13         449 my @items_1 = $diff->Items(1);
132 13         197 my @items_2 = $diff->Items(2);
133            
134 13 50       202 my $max = @items_1 > @items_2 ? scalar( @items_1 ) : scalar( @items_2 );
135            
136 13         35 for my $index ( 1 .. $max ) {
137 26   100     148 $rows .= $self->_add_tablerow(
      50        
138             line_nr_a => $line_nr_a++,
139             line_nr_b => $line_nr_b++,
140             line_a => $items_1[ $index - 1 ] // '',
141             line_b => $items_2[ $index - 1 ] // '',
142             color_a => 'red',
143             color_b => 'green',
144             );
145             }
146             }
147             }
148              
149 7         289 return $rows;
150             }
151              
152             sub _add_tablerow {
153 83     83   1458 my $self = shift;
154              
155 83         280 my %params = @_;
156              
157 83         183 my ($line_nr_a, $line_a, $color_a) = @params{qw/line_nr_a line_a color_a/};
158 83         159 my ($line_nr_b, $line_b, $color_b) = @params{qw/line_nr_b line_b color_b/};
159              
160 83 100       220 $color_a = $color_a ? qq~style="color: $color_a;"~ : '';
161 83 100       149 $color_b = $color_b ? qq~style="color: $color_b;"~ : '';
162              
163 83   100     241 $line_a = encode_entities( $line_a // '' );
164 83   100     1271 $line_b = encode_entities( $line_b // '' );
165              
166 83         977 $line_a =~ s{ }{ }g;
167 83         159 $line_b =~ s{ }{ }g;
168              
169 83         532 my $row = qq~
170            
171             $line_nr_a
172             $line_a
173             $line_nr_b
174             $line_b
175            
176             ~;
177             }
178              
179             sub _end_table {
180 7     7   22 my $self = shift;
181              
182 7         27 return qq~
183            
184            
185             ~;
186             }
187              
188             sub _file_info {
189 14     14   42 my ($self, $file, $index) = @_;
190              
191 14 100       116 if ( $self->{"title_$index"} ) {
192 2         7 return $self->{"title_$index"};
193             }
194              
195 12 100       216 return '' if !-f $file;
196              
197 10         116 my $mtime = (stat $file)[9];
198 10         41 my $date = _format_date( $mtime );
199              
200 10         559 return "$file
$date";
201             }
202              
203             sub _format_date {
204 10     10   24 my ($time) = @_;
205              
206 10         43 my $date = localtime $time;
207 10         718 return $date->cdate;
208             }
209              
210             sub _read_file {
211 20     20   13052 my ($self, $file) = @_;
212            
213 20 100       74 return if !$file;
214              
215 19 100 100     82 if ( ref $file && ref $file eq 'ARRAY' ) {
216 6         12 return @{ $file };
  6         30  
217             }
218              
219 13 100       293 return if !-r $file;
220            
221 11         31 my @lines;
222 11         318 open my $fh, '<', $file;
223 11 100       60 if ( $self->{encoding} ) {
224 2     1   53 binmode $fh, ':encoding(' . $self->{encoding} . ')';
  1         10  
  1         1  
  1         9  
225             }
226            
227 11   100     10898 local $/ = $self->{eol} // "\n";
228            
229 11         300 @lines = <$fh>;
230 11         105 close $fh;
231            
232 11         101 return @lines;
233             }
234              
235             1;
236              
237             __END__