File Coverage

blib/lib/Text/Same/Util.pm
Criterion Covered Total %
statement 33 37 89.1
branch 6 10 60.0
condition 2 3 66.6
subroutine 9 9 100.0
pod 2 2 100.0
total 52 61 85.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Text::Same::Util
4              
5             =head1 DESCRIPTION
6              
7             Utility methods for Text::Same
8              
9             =head1 METHODS
10              
11             See below. Methods private to this module are prefixed by an
12             underscore.
13              
14             =cut
15              
16             package Text::Same::Util;
17              
18 4     4   20 use warnings;
  4         6  
  4         98  
19 4     4   19 use strict;
  4         5  
  4         103  
20 4     4   19 use Carp;
  4         7  
  4         403  
21              
22 4     4   23 use vars qw($VERSION @ISA @EXPORT);
  4         6  
  4         237  
23 4     4   22 use Exporter;
  4         5  
  4         243  
24              
25             @ISA = qw( Exporter );
26             @EXPORT = qw( hash is_ignorable );
27              
28             $VERSION = '0.07';
29              
30 4     4   44 use Digest::MD5 qw(md5);
  4         7  
  4         1955  
31              
32             =head2 hash
33              
34             Title : hash
35             Usage : my $hash_value = hash($options, $text)
36             Function: return an integer hash/checksum for the given text
37              
38             =cut
39              
40             sub hash
41             {
42 1672     1672 1 2885 my $options = shift;
43 1672         2502 my $text = shift;
44              
45 1672 100       3988 if ($options->{ignore_case}) {
46 399         745 $text = lc $text;
47             }
48 1672 100       3646 if ($options->{ignore_space}) {
49 281         699 $text =~ s/^\s+//;
50 281         1712 $text =~ s/\s+/ /g;
51 281         962 $text =~ s/\s+$//;
52             }
53 1672         11044 return md5($text);
54             }
55              
56             sub _is_simple
57             {
58 824     824   1126 my ($options, $text) = @_;
59 824 50       1687 if ($options->{ignore_simple}) {
60 0         0 my $simple_len = $options->{ignore_simple};
61 0         0 $text =~ s/\s+//g;
62 0 0       0 if (length $text <= $simple_len) {
63 0         0 return 1;
64             }
65             }
66 824         4124 return 0;
67             }
68              
69             =head2 is_ignorable
70              
71             Title : is_ignorable
72             Usage : if (is_ignorable($options, $text)) { ... }
73             Function: return true if and only if for the given options, the given text
74             should be ignored during comparisons
75              
76             =cut
77              
78             sub is_ignorable
79             {
80 928     928 1 1533 my ($options, $text) = @_;
81 928 50       1772 return 1 if !defined $text;
82 928   66     4463 return (($options->{ignore_blanks} && $text =~ m/^\s*$/) ||
83             _is_simple($options, $text));
84             }
85              
86             =head1 AUTHOR
87              
88             Kim Rutherford
89              
90             =head1 COPYRIGHT & LICENSE
91              
92             Copyright 2005,2006 Kim Rutherford. All rights reserved.
93              
94             This program is free software; you can redistribute it and/or modify it
95             under the same terms as Perl itself.
96              
97             =head1 DISCLAIMER
98              
99             This module is provided "as is" without warranty of any kind. It
100             may redistributed under the same conditions as Perl itself.
101              
102             =cut
103              
104             1;