File Coverage

blib/lib/Algorithm/Diff/HTMLTable.pm
Criterion Covered Total %
statement 103 103 100.0
branch 31 40 77.5
condition 17 27 62.9
subroutine 16 16 100.0
pod 2 2 100.0
total 169 188 89.8


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 7     7   192315 use strict;
  7         16  
  7         168  
6 7     7   34 use warnings;
  7         13  
  7         189  
7              
8 7     7   6246 use Algorithm::Diff;
  7         35495  
  7         304  
9 7     7   47 use Carp;
  7         17  
  7         499  
10 7     7   5374 use HTML::Entities;
  7         47178  
  7         503  
11 7     7   5998 use Time::Piece;
  7         86527  
  7         36  
12              
13             our $VERSION = 0.04;
14              
15             sub new {
16 7     7 1 1221 my ($class, @param) = @_;
17              
18 7         33 return bless {@param}, $class;
19             }
20              
21             sub diff {
22 7     7 1 44 my $self = shift;
23              
24 7 50       34 croak "need two filenames" if @_ != 2;
25              
26 7         15 my %files;
27              
28 7         32 @files{qw/a b/} = @_;
29              
30             NAME:
31 7         22 for my $name ( qw/a b/ ) {
32              
33 14 100 66     83 next NAME if ref $files{$name} && ref $files{$name} eq 'ARRAY';
34              
35 10 50       197 croak $files{$name} . " is not a file" if !-f $files{$name};
36 10 50       122 croak $files{$name} . " is not a readable file" if !-r $files{$name};
37             }
38              
39 7         52 my $html = $self->_start_table( %files );
40 7         43 $html .= $self->_build_table( %files );
41 7         37 $html .= $self->_end_table( %files );
42              
43 7         67 return $html;
44             }
45              
46             sub _start_table {
47 7     7   19 my $self = shift;
48 7         24 my %files = @_;
49              
50 7         40 my $old = $self->_file_info( $files{a}, 'old' );
51 7         42 my $new = $self->_file_info( $files{b}, 'new' );
52            
53 7 100       51 my $id = defined $self->{id} ? qq~id="$self->{id}"~ : '';
54              
55 7         52 return qq~
56            
57            
58            
59             $old
60             $new
61            
62            
63            
64             ~;
65             }
66              
67             sub _build_table {
68 7     7   16 my $self = shift;
69              
70 7         21 my %files = @_;
71              
72 7         39 my @seq_a = $self->_read_file( $files{a} );
73 7         35 my @seq_b = $self->_read_file( $files{b} );
74              
75 7         81 my $diff = Algorithm::Diff->new( \@seq_a, \@seq_b );
76              
77 7         2489 $diff->Base(1);
78              
79 7         51 my $rows = '';
80              
81 7         18 my ($line_nr_a, $line_nr_b) = (1, 1);
82 7         38 while ( $diff->Next ) {
83 55 100       947 if ( my $count = $diff->Same ) {
    100          
    100          
84 27         457 for my $string ( $diff->Same ) {
85 37         506 $rows .= $self->_add_tablerow(
86             line_nr_a => $line_nr_a++,
87             line_nr_b => $line_nr_b++,
88             line_a => $string,
89             line_b => $string,
90             color_a => '',
91             color_b => '',
92             );
93             }
94             }
95             elsif ( !$diff->Items(2) ) {
96 5         179 my @items_1 = $diff->Items(1);
97 5         87 my @items_2 = $diff->Items(2);
98            
99 5 50       75 my $max = @items_1 > @items_2 ? scalar( @items_1 ) : scalar( @items_2 );
100            
101 5         40 for my $index ( 1 .. $max ) {
102 5   50     101 $rows .= $self->_add_tablerow(
      50        
103             line_nr_a => $line_nr_a++,
104             line_nr_b => '',
105             line_a => $items_1[ $index - 1 ] // '',
106             line_b => $items_2[ $index - 1 ] // '',
107             color_a => 'red',
108             color_b => '',
109             );
110             }
111             }
112             elsif ( !$diff->Items(1) ) {
113 10         320 my @items_1 = $diff->Items(1);
114 10         130 my @items_2 = $diff->Items(2);
115            
116 10 50       169 my $max = @items_1 > @items_2 ? scalar( @items_1 ) : scalar( @items_2 );
117            
118 10         25 for my $index ( 1 .. $max ) {
119 10   50     79 $rows .= $self->_add_tablerow(
      50        
120             line_nr_a => '',
121             line_nr_b => $line_nr_b++,
122             line_a => $items_1[ $index - 1 ] // '',
123             line_b => $items_2[ $index - 1 ] // '',
124             color_a => '',
125             color_b => 'green',
126             );
127             }
128             }
129             else {
130 13         428 my @items_1 = $diff->Items(1);
131 13         177 my @items_2 = $diff->Items(2);
132            
133 13 50       178 my $max = @items_1 > @items_2 ? scalar( @items_1 ) : scalar( @items_2 );
134            
135 13         31 for my $index ( 1 .. $max ) {
136 26   100     164 $rows .= $self->_add_tablerow(
      50        
137             line_nr_a => $line_nr_a++,
138             line_nr_b => $line_nr_b++,
139             line_a => $items_1[ $index - 1 ] // '',
140             line_b => $items_2[ $index - 1 ] // '',
141             color_a => 'red',
142             color_b => 'green',
143             );
144             }
145             }
146             }
147              
148 7         257 return $rows;
149             }
150              
151             sub _add_tablerow {
152 78     78   106 my $self = shift;
153              
154 78         310 my %params = @_;
155              
156 78         149 my ($line_nr_a, $line_a, $color_a) = @params{qw/line_nr_a line_a color_a/};
157 78         121 my ($line_nr_b, $line_b, $color_b) = @params{qw/line_nr_b line_b color_b/};
158              
159 78 100       176 $color_a = $color_a ? qq~style="color: $color_a;"~ : '';
160 78 100       141 $color_b = $color_b ? qq~style="color: $color_b;"~ : '';
161              
162 78   50     268 $line_a = encode_entities( $line_a // '' );
163 78   50     939 $line_b = encode_entities( $line_b // '' );
164              
165 78         1351 my $row = qq~
166            
167             $line_nr_a
168             $line_a
169             $line_nr_b
170             $line_b
171            
172             ~;
173             }
174              
175             sub _end_table {
176 7     7   15 my $self = shift;
177              
178 7         18 return qq~
179            
180            
181             ~;
182             }
183              
184             sub _file_info {
185 14     14   33 my ($self, $file, $index) = @_;
186              
187 14 100       75 if ( $self->{"title_$index"} ) {
188 2         8 return $self->{"title_$index"};
189             }
190              
191 12 100       159 return '' if !-f $file;
192              
193 10         119 my $mtime = (stat $file)[9];
194 10         30 my $date = _format_date( $mtime );
195              
196 10         692 return "$file
$date";
197             }
198              
199             sub _format_date {
200 10     10   20 my ($time) = @_;
201              
202 10         44 my $date = localtime $time;
203 10         671 return $date->cdate;
204             }
205              
206             sub _read_file {
207 14     14   33 my ($self, $file) = @_;
208            
209 14 50       39 return if !$file;
210              
211 14 100 66     107 if ( $file && ref $file && ref $file eq 'ARRAY' ) {
      66        
212 4         5 return @{ $file };
  4         23  
213             }
214              
215 10 50       155 return if !-r $file;
216            
217 10         17 my @lines;
218 10 50       323 if ( open my $fh, '<', $file ) {
219 10 100       31 if ( $self->{encoding} ) {
220 2     1   45 binmode $fh, ':encoding(' . $self->{encoding} . ')';
  1         29  
  1         2  
  1         9  
221             }
222            
223 10   100     11823 local $/ = $self->{eol} // "\n";
224            
225 10         289 @lines = <$fh>;
226             }
227            
228 10         128 return @lines;
229             }
230              
231             1;
232              
233             __END__