line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package String::Examine; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
String::Examine - String comparisions and offset checking |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use String::Examine; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my $str = String::Examine::new('string1' => 'foo', $string2 => 'bar'); |
12
|
|
|
|
|
|
|
my $match = $str->compare(); |
13
|
|
|
|
|
|
|
my $match2 = $str->nocase_compare(); |
14
|
|
|
|
|
|
|
my $match3 = $str->regex_compare(); |
15
|
|
|
|
|
|
|
my $match4 = $str->vector_compare(); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
if($match || $match2 || $match3 || $match4) |
18
|
|
|
|
|
|
|
{ |
19
|
|
|
|
|
|
|
my $offset = $str->str_pos(); |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$str->string2("new_string"); |
23
|
|
|
|
|
|
|
$str->string1("new_string_also"); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
This module does basic string comparision, string1 is always the primary that string2 is matched against |
28
|
|
|
|
|
|
|
there is 4 builtin comparisions, 'compare()' which just does a basic eq/ne compare, 'nocase_compare()' |
29
|
|
|
|
|
|
|
which converts to lowercase and does eq/ne match, 'regex_compare()' which is simply string matching using m//, |
30
|
|
|
|
|
|
|
'vector_compare()' a slightly more unusual comparision, converts each character into vector and concatenates |
31
|
|
|
|
|
|
|
the converted vectors and does a '==' there is instances on some strings where this has found a failure that |
32
|
|
|
|
|
|
|
other compares failed to find, however, due to the nature it is the most expensive compare. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
The final function is 'str_pos()' in the event that a string doesn't match this function can be called to find |
35
|
|
|
|
|
|
|
the position in the string2 where it failed, it is offset from 0, ie: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
string1 = 'aaaaba'; |
38
|
|
|
|
|
|
|
string2 = 'aaaaaa'; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
str_pos() would return '4'. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=cut |
43
|
|
|
|
|
|
|
|
44
|
1
|
|
|
1
|
|
40446
|
use 5.008007; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
44
|
|
45
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
37
|
|
46
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
50
|
|
47
|
1
|
|
|
1
|
|
6
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
795
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
require Exporter; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
52
|
|
|
|
|
|
|
@EXPORT_OK = qw/new string1 string2 compare nocase_compare regex_compare vector_compare str_pos/; |
53
|
|
|
|
|
|
|
@EXPORT = qw//; |
54
|
|
|
|
|
|
|
%EXPORT_TAGS = (all => [@EXPORT_OK]); |
55
|
|
|
|
|
|
|
$VERSION = '0.01'; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head1 FUNCTIONS |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head2 new |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $str = String::Examine::new(); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
You can pass the optional parameters 'string1', and 'string2' here. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=cut |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub new |
69
|
|
|
|
|
|
|
{ |
70
|
0
|
|
|
0
|
1
|
|
my $class = "String::Examine"; |
71
|
0
|
|
|
|
|
|
my %params = @_; |
72
|
0
|
|
|
|
|
|
my $self = {}; |
73
|
0
|
|
0
|
|
|
|
$self->{'_string1'} = $params{'string1'} || undef; |
74
|
0
|
|
0
|
|
|
|
$self->{'_string2'} = $params{'string2'} || undef; |
75
|
0
|
|
|
|
|
|
bless $self, $class; |
76
|
0
|
|
|
|
|
|
return $self; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head2 string1 |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
$str->string1("string"); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
If a value is pass string1 will be set to the value if not it will just return the |
84
|
|
|
|
|
|
|
currently set value. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub string1 |
89
|
|
|
|
|
|
|
{ |
90
|
0
|
|
|
0
|
1
|
|
my ($self, $new_val) = @_; |
91
|
0
|
0
|
|
|
|
|
$self->{'_string1'} = $new_val if $new_val; |
92
|
0
|
|
|
|
|
|
return $self->{'_string1'}; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head2 string2 |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
$str->string2("string"); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
If a value is pass string2 will be set to the value if not it will just return the |
100
|
|
|
|
|
|
|
currently set value. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub string2 |
105
|
|
|
|
|
|
|
{ |
106
|
0
|
|
|
0
|
1
|
|
my ($self, $new_val) = @_; |
107
|
0
|
0
|
|
|
|
|
$self->{'_string2'} = $new_val if $new_val; |
108
|
0
|
|
|
|
|
|
return $self->{'_string2'}; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 compare |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
$str->compare(); |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Performs a basic eq compare on string1 and string2, string1 is always primary, |
116
|
|
|
|
|
|
|
returns 0 strings are equal or 1 if not |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=cut |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub compare |
121
|
|
|
|
|
|
|
{ |
122
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
123
|
|
|
|
|
|
|
|
124
|
0
|
0
|
|
|
|
|
if($self->{'_string1'} eq $self->{'_string2'}) |
125
|
|
|
|
|
|
|
{ |
126
|
0
|
|
|
|
|
|
return 0; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
else |
129
|
|
|
|
|
|
|
{ |
130
|
0
|
|
|
|
|
|
return 1; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head2 nocase_compare |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
$str->nocase_compare(); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Exactly as compare() except it performs lc() first. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=cut |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub nocase_compare |
143
|
|
|
|
|
|
|
{ |
144
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
145
|
|
|
|
|
|
|
|
146
|
0
|
0
|
|
|
|
|
if(lc($self->{'_string1'}) eq lc($self->{'_string2'})) |
147
|
|
|
|
|
|
|
{ |
148
|
0
|
|
|
|
|
|
return 0; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
else |
151
|
|
|
|
|
|
|
{ |
152
|
0
|
|
|
|
|
|
return 1; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head2 regex_compare |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
$str->regex_compare(); |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
Performs the compare based on a regular expression using string1 =~ m/string2/ |
161
|
|
|
|
|
|
|
returns 0 if they are equal or 1 if not. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub regex_compare |
166
|
|
|
|
|
|
|
{ |
167
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
168
|
|
|
|
|
|
|
|
169
|
0
|
0
|
|
|
|
|
if($self->{'_string1'} =~ m/$self->{'_string2'}/) |
170
|
|
|
|
|
|
|
{ |
171
|
0
|
|
|
|
|
|
return 0; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
else |
174
|
|
|
|
|
|
|
{ |
175
|
0
|
|
|
|
|
|
return 1; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 vector_compare |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
$str->vector_compare(); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Converts the strings into 4bit vectors and performs a compare based on the concatenated output. |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=cut |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub vector_compare |
188
|
|
|
|
|
|
|
{ |
189
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
190
|
0
|
|
|
|
|
|
my ($vec1, $vec2); |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
foreach my $c (split //, $self->{'_string1'}) |
193
|
|
|
|
|
|
|
{ |
194
|
0
|
|
|
|
|
|
$vec1 .= vec($c, 0, 4); |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
foreach my $c (split //, $self->{'_string2'}) |
198
|
|
|
|
|
|
|
{ |
199
|
0
|
|
|
|
|
|
$vec2 .= vec($c, 0, 4); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
0
|
0
|
|
|
|
|
if($vec1 == $vec2) |
203
|
|
|
|
|
|
|
{ |
204
|
0
|
|
|
|
|
|
return 0; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
else |
207
|
|
|
|
|
|
|
{ |
208
|
0
|
|
|
|
|
|
return 1; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=head2 str_pos |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
$str->str_pos(); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Returns the offset number of string2 at the point at which the 2 strings do not match, counts from 0. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=cut |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub str_pos |
221
|
|
|
|
|
|
|
{ |
222
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
223
|
0
|
|
|
|
|
|
my $strcount = 0; |
224
|
0
|
|
|
|
|
|
my @str1 = split(//, $self->{'_string1'}); |
225
|
0
|
|
|
|
|
|
my @str2 = split(//, $self->{'_string2'}); |
226
|
|
|
|
|
|
|
|
227
|
0
|
|
|
|
|
|
foreach my $char (@str1) |
228
|
|
|
|
|
|
|
{ |
229
|
0
|
0
|
|
|
|
|
if($char ne $str2[$strcount]) |
230
|
|
|
|
|
|
|
{ |
231
|
0
|
|
|
|
|
|
return $strcount; |
232
|
|
|
|
|
|
|
} |
233
|
0
|
|
|
|
|
|
$strcount++; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
return -1; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
1; |
240
|
|
|
|
|
|
|
__END__ |