File Coverage

blib/lib/Text/Same.pm
Criterion Covered Total %
statement 100 100 100.0
branch 20 22 90.9
condition 4 5 80.0
subroutine 14 14 100.0
pod 1 1 100.0
total 139 142 97.8


line stmt bran cond sub pod time code
1             package Text::Same;
2              
3             =head1 NAME
4              
5             Text::Same - Look for similarities between files or arrays
6              
7             =head1 SYNOPSIS
8              
9             use Text::Same;
10              
11             my $matchmap = compare "file_1", "file_2", { ignore_whitespace => 1 };
12             my $matchmap = compare \@records1, \@records2, { ignore_simple => 3 };
13              
14             or use the "psame" command:
15              
16             psame -a file_1 file_2 | more
17              
18             =head1 DESCRIPTION
19              
20             C compares two files or arrays of strings and returns a MatchMap
21             object holding the results.
22              
23             =cut
24              
25             =head1 FUNCTIONS
26              
27             =cut
28              
29 3     3   90834 use warnings;
  3         9  
  3         102  
30 3     3   17 use strict;
  3         5  
  3         94  
31 3     3   15 use Carp;
  3         15  
  3         240  
32 3     3   14 use vars qw($VERSION @ISA @EXPORT);
  3         5  
  3         383  
33 3     3   15 use Exporter;
  3         5  
  3         201  
34              
35             @ISA = qw( Exporter );
36             @EXPORT = qw( compare );
37              
38             $VERSION = '0.07';
39              
40 3     3   3049 use Text::Same::Match;
  3         7  
  3         155  
41 3     3   2128 use Text::Same::ChunkPair;
  3         10  
  3         84  
42 3     3   2294 use Text::Same::MatchMap;
  3         9  
  3         256  
43 3     3   2144 use Text::Same::Cache;
  3         10  
  3         97  
44 3     3   27 use Text::Same::Util;
  3         7  
  3         3002  
45              
46             sub _process_hits
47             {
48 242     242   374 my ($options, $this_chunk_indx, $seen_pairs_ref, $matching_chunk_indexes_ref,
49             $this_chunked_source, $other_chunked_source) = @_;
50              
51 242         402 for my $other_chunk_indx (@$matching_chunk_indexes_ref) {
52 313         1001 my $chunk_pair = new Text::Same::ChunkPair($this_chunk_indx,
53             $other_chunk_indx);
54 313         824 my $pair_id = $chunk_pair->packed_pair();
55              
56 313 50       780 if (!exists $seen_pairs_ref->{$pair_id}) {
57 313         788 my $this_prev_chunk_indx =
58             $this_chunked_source->get_previous_chunk_indx($options,
59             $this_chunk_indx);
60 313         881 my $other_prev_chunk_indx =
61             $other_chunked_source->get_previous_chunk_indx($options,
62             $other_chunk_indx);
63              
64 313 100 100     1332 if (defined $this_prev_chunk_indx && defined $other_prev_chunk_indx) {
65 254         648 my $this_prev_chunk_text =
66             $this_chunked_source->get_chunk_by_indx($this_prev_chunk_indx);
67 254         685 my $other_prev_chunk_text =
68             $other_chunked_source->get_chunk_by_indx($other_prev_chunk_indx);
69 254         671 my $this_prev_hash =
70             Text::Same::ChunkedSource::hash($options, $this_prev_chunk_text);
71 254         649 my $other_prev_hash =
72             Text::Same::ChunkedSource::hash($options, $other_prev_chunk_text);
73              
74 254 100       708 if ($this_prev_hash eq $other_prev_hash) {
75 206         484 my $prev_pair_id =
76             Text::Same::ChunkPair::make_packed_pair($this_prev_chunk_indx,
77             $other_prev_chunk_indx);
78 206         367 my $prev_match = $seen_pairs_ref->{$prev_pair_id};
79              
80 206 50       372 if (defined $prev_match) {
81 206         535 $prev_match->add($chunk_pair);
82 206         466 $seen_pairs_ref->{$pair_id} = $prev_match;
83 206         1007 next;
84             }
85             }
86             }
87              
88 107         487 my $match = new Text::Same::Match(source1=>$this_chunked_source,
89             source2=>$other_chunked_source,
90             pairs=>[$chunk_pair]);
91 107         562 $seen_pairs_ref->{$pair_id} = $match;
92             }
93             }
94             }
95              
96             sub _find_matches($$$)
97             {
98 37     37   62 my ($options, $source1, $source2) = @_;
99              
100 37         124 my $source1_chunk_indexes = $source1->get_filtered_chunk_indexes($options);
101              
102 37         78 my %seen_pairs = ();
103              
104 37         71 for my $this_chunk_indx (@$source1_chunk_indexes) {
105 260         741 my $chunk_text = $source1->get_chunk_by_indx($this_chunk_indx);
106 260         791 my @matching_chunk_indexes =
107             $source2->get_matching_chunk_indexes($options, $chunk_text);
108              
109 260 100       764 if (@matching_chunk_indexes) {
110 242         552 _process_hits($options, $this_chunk_indx, \%seen_pairs,
111             \@matching_chunk_indexes, $source1, $source2);
112             }
113             }
114              
115 37         112 return \%seen_pairs;
116             }
117              
118             sub _extend_matches
119             {
120 37     37   71 my ($options, $matches, $source1, $source2) = @_;
121              
122 37         71 for my $match (@$matches) {
123 107         156 my ($prev, $next) = undef;
124              
125 107         301 $prev = $source1->get_previous_chunk_indx($options, $match->min1());
126 107 100       207 if (defined $prev) {
127 63         208 $match->set_min1($prev + 1);
128             } else {
129 44         138 $match->set_min1(0);
130             }
131 107         273 $prev = $source2->get_previous_chunk_indx($options, $match->min2());
132 107 100       217 if (defined $prev) {
133 64         195 $match->set_min2($prev + 1);
134             } else {
135 43         129 $match->set_min2(0);
136             }
137 107         274 $next = $source1->get_next_chunk_indx($options, $match->max1());
138 107 100       232 if (defined $next) {
139 51         170 $match->set_max1($next - 1);
140             } else {
141 56         170 $match->set_max1($source1->get_all_chunks_count() - 1);
142             }
143 107         314 $next = $source2->get_next_chunk_indx($options, $match->max2());
144 107 100       220 if (defined $next) {
145 67         211 $match->set_max2($next - 1);
146             } else {
147 40         125 $match->set_max2($source2->get_all_chunks_count() - 1);
148             }
149             }
150             }
151              
152             =head2 compare
153              
154             Title : compare
155             Usage : $matchmap = compare($options, $file1, $file2)
156             or
157             $matchmap = compare($options, \@array1, \@array2)
158             then:
159             my @all_matches = $matchmap->all_matches;
160             Function: return a MatchMap object holding matches and non-matches between the
161             two given files or arrays of strings
162              
163             =cut
164              
165             sub compare
166             {
167 37   50 37 1 6333 my $options = shift || {};
168 37         55 my $data1 = shift;
169 37         55 my $data2 = shift;
170              
171 37         206 my $cache = new Text::Same::Cache();
172              
173 37         55 my $source1;
174              
175 37 100       92 if (ref $data1 eq "ARRAY") {
176 1         12 $source1 = new Text::Same::ChunkedSource(name=>"array1", chunks=>$data1);
177             } else {
178 36         124 $source1 = $cache->get($data1, $options);
179             }
180              
181 37         58 my $source2;
182              
183 37 100       91 if (ref $data2 eq "ARRAY") {
184 1         5 $source2 = new Text::Same::ChunkedSource(name=>"array2", chunks=>$data2);
185             } else {
186 36         110 $source2 = $cache->get($data2, $options);
187             }
188              
189 37         113 my $seen_pairs_ref = _find_matches $options, $source1, $source2;
190              
191 37         47 my @matches = values %{$seen_pairs_ref};
  37         175  
192 37         86 my %uniq_matches = ();
193              
194 37         73 for my $match (@matches) {
195 313         672 $uniq_matches{$match} = $match;
196             }
197              
198 37         109 my @unique_matches = values %uniq_matches;
199              
200 37         112 _extend_matches($options, \@unique_matches, $source1, $source2);
201              
202 37         242 return new Text::Same::MatchMap(options=>$options, source1=>$source1,
203             source2=>$source2,
204             matches=>\@unique_matches);
205             }
206              
207             =head1 SEE ALSO
208              
209             B
210              
211             =head1 AUTHOR
212              
213             Kim Rutherford
214              
215             =head1 COPYRIGHT & LICENSE
216              
217             Copyright 2005,2006 Kim Rutherford, all rights reserved.
218              
219             This program is free software; you can redistribute it and/or modify it
220             under the same terms as Perl itself.
221              
222             =cut
223              
224             1;