line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Version 0 module |
2
|
|
|
|
|
|
|
package Validator::Custom::Constraint; |
3
|
|
|
|
|
|
|
|
4
|
5
|
|
|
5
|
|
27
|
use strict; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
145
|
|
5
|
5
|
|
|
5
|
|
25
|
use warnings; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
138
|
|
6
|
|
|
|
|
|
|
|
7
|
5
|
|
|
5
|
|
179
|
use Carp 'croak'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
15454
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Carp trust relationship |
10
|
|
|
|
|
|
|
push @Validator::Custom::CARP_NOT, __PACKAGE__; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $NUM_RE = qr/^[-+]?[0-9]+(:?\.[0-9]+)?$/; |
13
|
|
|
|
|
|
|
|
14
|
6
|
100
|
100
|
6
|
0
|
47
|
sub ascii { defined $_[0] && $_[0] =~ /^[\x21-\x7E]+$/ ? 1 : 0 } |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub between { |
17
|
17
|
|
|
17
|
0
|
31
|
my ($value, $args) = @_; |
18
|
17
|
|
|
|
|
36
|
my ($start, $end) = @$args; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
17
|
100
|
100
|
|
|
726
|
croak "Constraint 'between' needs two numeric arguments" |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
22
|
|
|
|
|
|
|
unless defined($start) && $start =~ /$NUM_RE/ && defined($end) && $end =~ /$NUM_RE/; |
23
|
|
|
|
|
|
|
|
24
|
13
|
100
|
100
|
|
|
100
|
return 0 unless defined $value && $value =~ /$NUM_RE/; |
25
|
10
|
100
|
100
|
|
|
76
|
return $value >= $start && $value <= $end ? 1 : 0; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
18
|
100
|
|
18
|
0
|
111
|
sub blank { defined $_[0] && $_[0] eq '' } |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub date_to_timepiece { |
31
|
20
|
|
|
20
|
0
|
29
|
my $value = shift; |
32
|
|
|
|
|
|
|
|
33
|
20
|
|
|
|
|
103
|
require Time::Piece; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# To Time::Piece object |
36
|
20
|
100
|
|
|
|
54
|
if (ref $value eq 'ARRAY') { |
37
|
14
|
|
|
|
|
22
|
my $year = $value->[0]; |
38
|
14
|
|
|
|
|
19
|
my $mon = $value->[1]; |
39
|
14
|
|
|
|
|
20
|
my $mday = $value->[2]; |
40
|
|
|
|
|
|
|
|
41
|
14
|
100
|
100
|
|
|
100
|
return [0, undef] |
|
|
|
100
|
|
|
|
|
42
|
|
|
|
|
|
|
unless defined $year && defined $mon && defined $mday; |
43
|
|
|
|
|
|
|
|
44
|
11
|
100
|
100
|
|
|
102
|
unless ($year =~ /^[0-9]{1,4}$/ && $mon =~ /^[0-9]{1,2}$/ |
|
|
|
100
|
|
|
|
|
45
|
|
|
|
|
|
|
&& $mday =~ /^[0-9]{1,2}$/) |
46
|
|
|
|
|
|
|
{ |
47
|
6
|
|
|
|
|
28
|
return [0, undef]; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
5
|
|
|
|
|
22
|
my $date = sprintf("%04s%02s%02s", $year, $mon, $mday); |
51
|
|
|
|
|
|
|
|
52
|
5
|
|
|
|
|
6
|
my $tp; |
53
|
5
|
|
|
|
|
9
|
eval { |
54
|
5
|
|
|
0
|
|
32
|
local $SIG{__WARN__} = sub { die @_ }; |
|
0
|
|
|
|
|
0
|
|
55
|
5
|
|
|
|
|
21
|
$tp = Time::Piece->strptime($date, '%Y%m%d'); |
56
|
|
|
|
|
|
|
}; |
57
|
|
|
|
|
|
|
|
58
|
5
|
100
|
|
|
|
154
|
return $@ ? [0, undef] : [1, $tp]; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
else { |
61
|
6
|
100
|
|
|
|
18
|
$value = '' unless defined $value; |
62
|
6
|
|
|
|
|
86
|
$value =~ s/[^0-9]//g; |
63
|
|
|
|
|
|
|
|
64
|
6
|
100
|
|
|
|
39
|
return [0, undef] unless $value =~ /^[0-9]{8}$/; |
65
|
|
|
|
|
|
|
|
66
|
4
|
|
|
|
|
7
|
my $tp; |
67
|
4
|
|
|
|
|
10
|
eval { |
68
|
4
|
|
|
0
|
|
38
|
local $SIG{__WARN__} = sub { die @_ }; |
|
0
|
|
|
|
|
0
|
|
69
|
4
|
|
|
|
|
25
|
$tp = Time::Piece->strptime($value, '%Y%m%d'); |
70
|
|
|
|
|
|
|
}; |
71
|
4
|
100
|
|
|
|
190
|
return $@ ? [0, undef] : [1, $tp]; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub datetime_to_timepiece { |
76
|
26
|
|
|
26
|
0
|
37
|
my $value = shift; |
77
|
|
|
|
|
|
|
|
78
|
26
|
|
|
|
|
119
|
require Time::Piece; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# To Time::Piece object |
81
|
26
|
100
|
|
|
|
65
|
if (ref $value eq 'ARRAY') { |
82
|
20
|
|
|
|
|
33
|
my $year = $value->[0]; |
83
|
20
|
|
|
|
|
25
|
my $mon = $value->[1]; |
84
|
20
|
|
|
|
|
26
|
my $mday = $value->[2]; |
85
|
20
|
|
|
|
|
27
|
my $hour = $value->[3]; |
86
|
20
|
|
|
|
|
23
|
my $min = $value->[4]; |
87
|
20
|
|
|
|
|
26
|
my $sec = $value->[5]; |
88
|
|
|
|
|
|
|
|
89
|
20
|
100
|
100
|
|
|
275
|
return [0, undef] |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
90
|
|
|
|
|
|
|
unless defined $year && defined $mon && defined $mday |
91
|
|
|
|
|
|
|
&& defined $hour && defined $min && defined $sec; |
92
|
|
|
|
|
|
|
|
93
|
14
|
100
|
100
|
|
|
218
|
unless ($year =~ /^[0-9]{1,4}$/ && $mon =~ /^[0-9]{1,2}$/ |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
94
|
|
|
|
|
|
|
&& $mday =~ /^[0-9]{1,2}$/ && $hour =~ /^[0-9]{1,2}$/ |
95
|
|
|
|
|
|
|
&& $min =~ /^[0-9]{1,2}$/ && $sec =~ /^[0-9]{1,2}$/) |
96
|
|
|
|
|
|
|
{ |
97
|
9
|
|
|
|
|
44
|
return [0, undef]; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
5
|
|
|
|
|
24
|
my $date = sprintf("%04s%02s%02s%02s%02s%02s", |
101
|
|
|
|
|
|
|
$year, $mon, $mday, $hour, $min, $sec); |
102
|
5
|
|
|
|
|
7
|
my $tp; |
103
|
5
|
|
|
|
|
6
|
eval { |
104
|
5
|
|
|
0
|
|
28
|
local $SIG{__WARN__} = sub { die @_ }; |
|
0
|
|
|
|
|
0
|
|
105
|
5
|
|
|
|
|
19
|
$tp = Time::Piece->strptime($date, '%Y%m%d%H%M%S'); |
106
|
|
|
|
|
|
|
}; |
107
|
|
|
|
|
|
|
|
108
|
5
|
100
|
|
|
|
180
|
return $@ ? [0, undef] : [1, $tp]; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
else { |
111
|
6
|
100
|
|
|
|
15
|
$value = '' unless defined $value; |
112
|
6
|
|
|
|
|
42
|
$value =~ s/[^0-9]//g; |
113
|
|
|
|
|
|
|
|
114
|
6
|
100
|
|
|
|
28
|
return [0, undef] unless $value =~ /^[0-9]{14}$/; |
115
|
|
|
|
|
|
|
|
116
|
4
|
|
|
|
|
4
|
my $tp; |
117
|
4
|
|
|
|
|
9
|
eval { |
118
|
4
|
|
|
0
|
|
28
|
local $SIG{__WARN__} = sub { die @_ }; |
|
0
|
|
|
|
|
0
|
|
119
|
4
|
|
|
|
|
18
|
$tp = Time::Piece->strptime($value, '%Y%m%d%H%M%S'); |
120
|
|
|
|
|
|
|
}; |
121
|
4
|
100
|
|
|
|
125
|
return $@ ? [0, undef] : [1, $tp]; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub decimal { |
126
|
16
|
|
|
16
|
0
|
28
|
my ($value, $digits_tmp) = @_; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# 桁数情報を整理 |
129
|
16
|
|
|
|
|
29
|
my $digits; |
130
|
16
|
100
|
|
|
|
32
|
if (defined $digits_tmp) { |
131
|
13
|
100
|
|
|
|
25
|
if (ref $digits_tmp eq 'ARRAY') { |
132
|
9
|
|
|
|
|
13
|
$digits = $digits_tmp; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
else { |
135
|
4
|
|
|
|
|
10
|
$digits = [$digits_tmp, undef]; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
else { |
139
|
3
|
|
|
|
|
7
|
$digits = [undef, undef]; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# 正規表現を作成 |
143
|
16
|
|
|
|
|
19
|
my $re; |
144
|
16
|
100
|
100
|
|
|
81
|
if (defined $digits->[0] && defined $digits->[1]) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
145
|
4
|
|
|
|
|
100
|
$re = qr/^[0-9]{1,$digits->[0]}(\.[0-9]{0,$digits->[1]})?$/; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
elsif (defined $digits->[0]) { |
148
|
7
|
|
|
|
|
95
|
$re = qr/^[0-9]{1,$digits->[0]}(\.[0-9]*)?$/; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
elsif (defined $digits->[1]) { |
151
|
2
|
|
|
|
|
24
|
$re = qr/^[0-9]+(\.[0-9]{0,$digits->[1]})?$/; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
else { |
154
|
3
|
|
|
|
|
7
|
$re = qr/^[0-9]+(\.[0-9]*)?$/; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
# 値をチェック |
158
|
16
|
100
|
100
|
|
|
135
|
if (defined $value && $value =~ /$re/) { |
159
|
6
|
|
|
|
|
29
|
return 1; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
else { |
162
|
10
|
|
|
|
|
47
|
return 0; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub duplication { |
167
|
10
|
|
|
10
|
0
|
19
|
my $values = shift; |
168
|
|
|
|
|
|
|
|
169
|
10
|
100
|
100
|
|
|
58
|
return 0 unless defined $values->[0] && defined $values->[1]; |
170
|
6
|
100
|
|
|
|
43
|
return $values->[0] eq $values->[1] ? [1, $values->[0]] : 0; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub equal_to { |
174
|
9
|
|
|
9
|
0
|
15
|
my ($value, $target) = @_; |
175
|
|
|
|
|
|
|
|
176
|
9
|
100
|
100
|
|
|
303
|
croak "Constraint 'equal_to' needs a numeric argument" |
177
|
|
|
|
|
|
|
unless defined $target && $target =~ /$NUM_RE/; |
178
|
|
|
|
|
|
|
|
179
|
7
|
100
|
100
|
|
|
53
|
return 0 unless defined $value && $value =~ /$NUM_RE/; |
180
|
4
|
100
|
|
|
|
23
|
return $value == $target ? 1 : 0; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub greater_than { |
184
|
13
|
|
|
13
|
0
|
24
|
my ($value, $target) = @_; |
185
|
|
|
|
|
|
|
|
186
|
13
|
100
|
100
|
|
|
374
|
croak "Constraint 'greater_than' needs a numeric argument" |
187
|
|
|
|
|
|
|
unless defined $target && $target =~ /$NUM_RE/; |
188
|
|
|
|
|
|
|
|
189
|
11
|
100
|
100
|
|
|
88
|
return 0 unless defined $value && $value =~ /$NUM_RE/; |
190
|
8
|
100
|
|
|
|
39
|
return $value > $target ? 1 : 0; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub http_url { |
194
|
5
|
100
|
100
|
5
|
0
|
44
|
return defined $_[0] && $_[0] =~ /^s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+$/ ? 1 : 0; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
55
|
100
|
100
|
55
|
0
|
427
|
sub int { defined $_[0] && $_[0] =~ /^\-?[0-9]+$/ ? 1 : 0 } |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub in_array { |
200
|
6
|
|
|
6
|
0
|
10
|
my ($value, $args) = @_; |
201
|
6
|
100
|
|
|
|
15
|
$value = '' unless defined $value; |
202
|
6
|
|
|
|
|
13
|
my $match = grep { $_ eq $value } @$args; |
|
12
|
|
|
|
|
31
|
|
203
|
6
|
100
|
|
|
|
25
|
return $match > 0 ? 1 : 0; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub length { |
207
|
23
|
|
|
23
|
0
|
38
|
my ($value, $args) = @_; |
208
|
|
|
|
|
|
|
|
209
|
23
|
100
|
|
|
|
55
|
return unless defined $value; |
210
|
|
|
|
|
|
|
|
211
|
22
|
|
|
|
|
32
|
my $min; |
212
|
|
|
|
|
|
|
my $max; |
213
|
22
|
100
|
|
|
|
66
|
if(ref $args eq 'ARRAY') { ($min, $max) = @$args } |
|
8
|
100
|
|
|
|
15
|
|
214
|
|
|
|
|
|
|
elsif (ref $args eq 'HASH') { |
215
|
12
|
|
|
|
|
20
|
$min = $args->{min}; |
216
|
12
|
|
|
|
|
22
|
$max = $args->{max}; |
217
|
|
|
|
|
|
|
} |
218
|
2
|
|
|
|
|
4
|
else { $min = $max = $args } |
219
|
|
|
|
|
|
|
|
220
|
22
|
100
|
100
|
|
|
251
|
croak "Constraint 'length' needs one or two arguments" |
221
|
|
|
|
|
|
|
unless defined $min || defined $max; |
222
|
|
|
|
|
|
|
|
223
|
21
|
|
|
|
|
28
|
my $length = length $value; |
224
|
21
|
|
|
|
|
20
|
my $is_valid; |
225
|
21
|
100
|
100
|
|
|
97
|
if (defined $min && defined $max) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
226
|
13
|
|
100
|
|
|
70
|
$is_valid = $length >= $min && $length <= $max; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
elsif (defined $min) { |
229
|
4
|
|
|
|
|
8
|
$is_valid = $length >= $min; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
elsif (defined $max) { |
232
|
4
|
|
|
|
|
8
|
$is_valid =$length <= $max; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
21
|
|
|
|
|
81
|
return $is_valid; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub less_than { |
239
|
11
|
|
|
11
|
0
|
24
|
my ($value, $target) = @_; |
240
|
|
|
|
|
|
|
|
241
|
11
|
100
|
100
|
|
|
313
|
croak "Constraint 'less_than' needs a numeric argument" |
242
|
|
|
|
|
|
|
unless defined $target && $target =~ /$NUM_RE/; |
243
|
|
|
|
|
|
|
|
244
|
9
|
100
|
100
|
|
|
70
|
return 0 unless defined $value && $value =~ /$NUM_RE/; |
245
|
6
|
100
|
|
|
|
29
|
return $value < $target ? 1 : 0; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub merge { |
249
|
3
|
|
|
3
|
0
|
6
|
my $values = shift; |
250
|
|
|
|
|
|
|
|
251
|
3
|
100
|
|
|
|
11
|
$values = [$values] unless ref $values eq 'ARRAY'; |
252
|
|
|
|
|
|
|
|
253
|
3
|
|
|
|
|
15
|
return [1, join('', @$values)]; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
6
|
100
|
|
6
|
0
|
37
|
sub string { defined $_[0] && !ref $_[0] } |
257
|
30
|
100
|
|
30
|
0
|
201
|
sub not_blank { defined $_[0] && $_[0] ne '' } |
258
|
2
|
|
|
2
|
0
|
8
|
sub not_defined { !defined $_[0] } |
259
|
8
|
100
|
100
|
8
|
0
|
87
|
sub not_space { defined $_[0] && $_[0] !~ '^[ \t\n\r\f]*$' ? 1 : 0 } |
260
|
|
|
|
|
|
|
|
261
|
10
|
100
|
100
|
10
|
0
|
87
|
sub uint { defined $_[0] && $_[0] =~ /^[0-9]+$/ ? 1 : 0 } |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub regex { |
264
|
7
|
|
|
7
|
0
|
40
|
my ($value, $regex) = @_; |
265
|
7
|
100
|
100
|
|
|
98
|
defined $value && $value =~ /$regex/ ? 1 : 0; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub selected_at_least { |
269
|
10
|
|
|
10
|
0
|
19
|
my ($values, $num) = @_; |
270
|
|
|
|
|
|
|
|
271
|
10
|
100
|
|
|
|
18
|
my $selected = ref $values ? $values : [$values]; |
272
|
10
|
|
|
|
|
15
|
$num += 0; |
273
|
10
|
100
|
|
|
|
40
|
return scalar(@$selected) >= $num ? 1 : 0; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub shift_array { |
277
|
2
|
|
|
2
|
0
|
4
|
my $values = shift; |
278
|
|
|
|
|
|
|
|
279
|
2
|
100
|
|
|
|
8
|
$values = [$values] unless ref $values eq 'ARRAY'; |
280
|
|
|
|
|
|
|
|
281
|
2
|
|
|
|
|
8
|
return [1, shift @$values]; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
8
|
100
|
100
|
8
|
0
|
75
|
sub space { defined $_[0] && $_[0] =~ '^[ \t\n\r\f]*$' ? 1 : 0 } |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub to_array { |
287
|
8
|
|
|
8
|
0
|
15
|
my $value = shift; |
288
|
|
|
|
|
|
|
|
289
|
8
|
100
|
|
|
|
24
|
$value = [$value] unless ref $value eq 'ARRAY'; |
290
|
|
|
|
|
|
|
|
291
|
8
|
|
|
|
|
29
|
return [1, $value]; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub to_array_remove_blank { |
295
|
4
|
|
|
4
|
0
|
7
|
my $values = shift; |
296
|
|
|
|
|
|
|
|
297
|
4
|
100
|
|
|
|
19
|
$values = [$values] unless ref $values eq 'ARRAY'; |
298
|
4
|
50
|
|
|
|
9
|
$values = [grep { defined $_ && CORE::length $_} @$values]; |
|
8
|
|
|
|
|
41
|
|
299
|
|
|
|
|
|
|
|
300
|
4
|
|
|
|
|
22
|
return [1, $values]; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
sub trim { |
304
|
3
|
|
|
3
|
0
|
8
|
my $value = shift; |
305
|
3
|
50
|
|
|
|
34
|
$value =~ s/^[ \t\n\r\f]*(.*?)[ \t\n\r\f]*$/$1/ms if defined $value; |
306
|
3
|
|
|
|
|
17
|
return [1, $value]; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub trim_collapse { |
310
|
2
|
|
|
2
|
0
|
4
|
my $value = shift; |
311
|
2
|
50
|
|
|
|
6
|
if (defined $value) { |
312
|
2
|
|
|
|
|
9
|
$value =~ s/[ \t\n\r\f]+/ /g; |
313
|
2
|
|
|
|
|
12
|
$value =~ s/^[ \t\n\r\f]*(.*?)[ \t\n\r\f]*$/$1/ms; |
314
|
|
|
|
|
|
|
} |
315
|
2
|
|
|
|
|
10
|
return [1, $value]; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub trim_lead { |
319
|
2
|
|
|
2
|
0
|
6
|
my $value = shift; |
320
|
2
|
50
|
|
|
|
11
|
$value =~ s/^[ \t\n\r\f]+(.*)$/$1/ms if defined $value; |
321
|
2
|
|
|
|
|
9
|
return [1, $value]; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub trim_trail { |
325
|
2
|
|
|
2
|
0
|
4
|
my $value = shift; |
326
|
2
|
50
|
|
|
|
15
|
$value =~ s/^(.*?)[ \t\n\r\f]+$/$1/ms if defined $value; |
327
|
2
|
|
|
|
|
8
|
return [1, $value]; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub trim_uni { |
331
|
1
|
|
|
1
|
0
|
3
|
my $value = shift; |
332
|
1
|
50
|
|
|
|
11
|
$value =~ s/^\s*(.*?)\s*$/$1/ms if defined $value; |
333
|
1
|
|
|
|
|
11
|
return [1, $value]; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub trim_uni_collapse { |
337
|
1
|
|
|
1
|
0
|
3
|
my $value = shift; |
338
|
1
|
50
|
|
|
|
5
|
if (defined $value) { |
339
|
1
|
|
|
|
|
8
|
$value =~ s/\s+/ /g; |
340
|
1
|
|
|
|
|
7
|
$value =~ s/^\s*(.*?)\s*$/$1/ms; |
341
|
|
|
|
|
|
|
} |
342
|
1
|
|
|
|
|
5
|
return [1, $value]; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub trim_uni_lead { |
346
|
1
|
|
|
1
|
0
|
3
|
my $value = shift; |
347
|
1
|
50
|
|
|
|
21
|
$value =~ s/^\s+(.*)$/$1/ms if defined $value; |
348
|
1
|
|
|
|
|
5
|
return [1, $value]; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub trim_uni_trail { |
352
|
1
|
|
|
1
|
0
|
2
|
my $value = shift; |
353
|
1
|
50
|
|
|
|
19
|
$value =~ s/^(.*?)\s+$/$1/ms if defined $value; |
354
|
1
|
|
|
|
|
5
|
return [1, $value]; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
1; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=head1 NAME |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Validator::Custom::Constraint - Constrint functions |