| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Params::Filter; |
|
2
|
6
|
|
|
6
|
|
1084985
|
use v5.36; |
|
|
6
|
|
|
|
|
25
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.016'; |
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Params::Filter - Field filtering for strict parameter construction |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=encoding utf-8 |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use Params::Filter qw/filter/; # import filter() subroutine |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Define filter rules |
|
16
|
|
|
|
|
|
|
my @required_fields = qw(name email); |
|
17
|
|
|
|
|
|
|
my @accepted_fields = qw(phone city state zip); |
|
18
|
|
|
|
|
|
|
my @excluded_fields = qw(ssn password); |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Functional interface |
|
21
|
|
|
|
|
|
|
# Apply filter to incoming data (from web form, CLI, API, etc.) |
|
22
|
|
|
|
|
|
|
my ($filtered_data, $status) = filter( |
|
23
|
|
|
|
|
|
|
$incoming_params, # Data from external source |
|
24
|
|
|
|
|
|
|
\@required_fields, |
|
25
|
|
|
|
|
|
|
\@accepted_fields, |
|
26
|
|
|
|
|
|
|
\@excluded_fields, |
|
27
|
|
|
|
|
|
|
); |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
if ($filtered_data) { |
|
30
|
|
|
|
|
|
|
# Success - use filtered data |
|
31
|
|
|
|
|
|
|
process_user($filtered_data); |
|
32
|
|
|
|
|
|
|
} else { |
|
33
|
|
|
|
|
|
|
# Error - missing required fields |
|
34
|
|
|
|
|
|
|
die "Filtering failed: $status"; |
|
35
|
|
|
|
|
|
|
} |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Object-oriented interface |
|
38
|
|
|
|
|
|
|
my $user_filter = Params::Filter->new_filter({ |
|
39
|
|
|
|
|
|
|
required => ['username', 'email'], |
|
40
|
|
|
|
|
|
|
accepted => ['first_name', 'last_name', 'phone', 'bio'], |
|
41
|
|
|
|
|
|
|
excluded => ['password', 'ssn', 'credit_card'], |
|
42
|
|
|
|
|
|
|
}); |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Apply same filter to multiple incoming datasets |
|
45
|
|
|
|
|
|
|
my ($user1, $msg1) = $user_filter->apply($web_form_data); |
|
46
|
|
|
|
|
|
|
my ($user2, $msg2) = $user_filter->apply($api_request_data); |
|
47
|
|
|
|
|
|
|
my ($user3, $msg3) = $user_filter->apply($db_record_data); |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# Closure interface (maximum speed) |
|
50
|
|
|
|
|
|
|
use Params::Filter qw/make_filter/; |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
my $fast_filter = make_filter( |
|
53
|
|
|
|
|
|
|
[qw(id username)], # required |
|
54
|
|
|
|
|
|
|
[qw(email bio)], # accepted |
|
55
|
|
|
|
|
|
|
[qw(password token)], # excluded |
|
56
|
|
|
|
|
|
|
); |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# Apply to high-volume data stream |
|
59
|
|
|
|
|
|
|
for my $record (@large_dataset) { |
|
60
|
|
|
|
|
|
|
my $filtered = $fast_filter->($record); |
|
61
|
|
|
|
|
|
|
next unless $filtered; # Skip if required fields missing |
|
62
|
|
|
|
|
|
|
process($filtered); |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
C provides lightweight parameter filtering that checks |
|
68
|
|
|
|
|
|
|
only for the presence or absence of specified fields. It does B validate |
|
69
|
|
|
|
|
|
|
values - no type checking, truthiness testing, or lookups. |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
This module separates field filtering from value validation: |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=over 4 |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item * **Field filtering** (this module) - Check which fields are present/absent |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item * **Value validation** (later step) - Check if field values are correct |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=back |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head2 Primary Benefits |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
The main advantages of using Params::Filter are: |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=over 4 |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=item * **Consistency** - Converts varying incoming data formats to consistent key-value pairs |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item * **Security** - Sensitive fields (passwords, SSNs, credit cards) never reach your validation code or database statements |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item * **Compliance** - Automatically excludes fields that shouldn't be processed or stored (e.g., GDPR, PCI-DSS) |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=item * **Correctness** - Ensures only expected fields are processed, preventing accidental data leakage or processing errors |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item * **Maintainability** - Clear separation between data filtering (what fields to accept) and validation (whether values are correct) |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=back |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head2 Performance Considerations |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
The functional and OO interfaces include features that add overhead |
|
102
|
|
|
|
|
|
|
compared to manual hash lookups, especially when the incoming data is in a known |
|
103
|
|
|
|
|
|
|
consistent format. The value of Params::Filter shows in its capability to assure the |
|
104
|
|
|
|
|
|
|
security, compliance, and correctness benefits listed above. |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
For speed with fewer features, the closure interface (C) |
|
107
|
|
|
|
|
|
|
provides maximum performance and can be faster than hand-written Perl filtering |
|
108
|
|
|
|
|
|
|
code due to pre-computed exclusion lookups and specialized closure variants. |
|
109
|
|
|
|
|
|
|
Use C for hot code paths or high-frequency filtering. |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
For all interfaces, Params::Filter CAN improve overall performance when downstream |
|
112
|
|
|
|
|
|
|
validation is expensive (database statements, API calls, complex regex) by failing |
|
113
|
|
|
|
|
|
|
fast when required fields are missing. |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
A simple benchmark comparing the validation cost of typical input to that of |
|
116
|
|
|
|
|
|
|
input restricted to required fields would reveal any speed gain with expensive |
|
117
|
|
|
|
|
|
|
downstream validations. |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head2 This Approach Handles Common Issues |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=over 4 |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=item * Subroutine signatures can become unwieldy with many parameters |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=item * Ad-hoc argument checking is error-prone |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=item * Validation may not catch missing inputs quickly enough |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=item * Many fields to check multiplies validation time (for expensive validation) |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=back |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head2 When to Use This Module |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
This module is useful when you have: |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=over 4 |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=item * Known parameters for downstream input or processes (API calls, method/subroutine arguments, database operations) |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=over 8 |
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=item * Fields that must be provided for success downstream ("required") |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=item * Fields useful downstream if provided ("accepted") |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item * Fields to remove before further processing ("excluded") |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=back |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=item * Incoming data from external sources (web forms, APIs, databases, user input) |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item * No guarantee that incoming data is consistent or complete |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item * Multiple data instances to process with the same rules |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=item * Multiple uses tapping incoming data |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=item * A distinction between missing and "false" data |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=back |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head1 FEATURES |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=over 4 |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=item * **Dual interface** - Functional or OO usage |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=item * **Fast-fail** - Returns immediately on missing required parameters |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item * **Fast-success** - Returns immediately if all required parameters are provided and no others are provided or will be accepted |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=item * **Flexible input** - Accepts hashrefs, arrayrefs, or scalars |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=item * **Wildcard support** - Use C<'*'> in accepted list to accept all fields |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=item * **No value checking** - Only presence/absence of fields |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item * **Debug mode** - Optional warnings about unrecognized or excluded fields |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=item * **Method chaining** - Modifier methods return C<$self> |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=item * **Perl 5.36+** - Modern Perl with signatures and post-deref |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=item * **No dependencies** - Only core Perl's L |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=back |
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head2 When NOT to Use This Module |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
If you're constructing both the filter rules B the data structure |
|
192
|
|
|
|
|
|
|
at the same point in your code, you probably don't need this module. |
|
193
|
|
|
|
|
|
|
The module's expected use is to apply pre-defined rules to data that |
|
194
|
|
|
|
|
|
|
may be inconsistent or incomplete for its intended use. |
|
195
|
|
|
|
|
|
|
If there isn't repetition or an unknown/unreliable data structure, this might be overkill. |
|
196
|
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=cut |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head2 This Module Does NOT Do Fancy Stuff |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
As much as this module attempts to be versatile in usage, there are some B |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=over 4 |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item * No regex field name matching for designating fields to require, accept, or exclude |
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=item * No conditional field designations I a filter: |
|
208
|
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
C # No way a filter can do this |
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=item * No coderefs or callbacks for use when filtering |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=item * No substitutions or changes to field names |
|
214
|
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=item * No built-in filter lists except an empty arrayref C<[]> = none |
|
216
|
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item * No fields ADDED to yielded data, EXCEPT: |
|
218
|
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=over 8 |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=item * If the provided data resolves to a list or array with an odd number of elements, the LAST element is treated as a flag, set to the value 1 |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=item * If the provided data resolves to a single non-reference scalar (probably a text string) the data is stored as a hashref value with the key C<'_'>, and returned if C<'_'> is included in the accepted list or the list is set to C<['*']> (accept all) |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=back |
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=back |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=cut |
|
230
|
|
|
|
|
|
|
|
|
231
|
6
|
|
|
6
|
|
46
|
use Exporter; |
|
|
6
|
|
|
|
|
47
|
|
|
|
6
|
|
|
|
|
15823
|
|
|
232
|
|
|
|
|
|
|
our @ISA = qw{ Exporter }; |
|
233
|
|
|
|
|
|
|
our @EXPORT = qw{ }; |
|
234
|
|
|
|
|
|
|
our @EXPORT_OK = qw{ filter make_filter }; |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub new_filter { |
|
237
|
30055
|
|
|
30055
|
1
|
6864304
|
my ($class,$args) = @_; |
|
238
|
30055
|
100
|
66
|
|
|
158103
|
$args = {} unless ($args and ref($args) =~ /hash/i); |
|
239
|
|
|
|
|
|
|
my $self = { |
|
240
|
|
|
|
|
|
|
required => $args->{required} || [], |
|
241
|
|
|
|
|
|
|
accepted => $args->{accepted} || [], |
|
242
|
|
|
|
|
|
|
excluded => $args->{excluded} || [], |
|
243
|
30055
|
|
100
|
|
|
205940
|
debug => $args->{DEBUG} || $args->{debug} || 0, |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
244
|
|
|
|
|
|
|
}; |
|
245
|
30055
|
|
|
|
|
54699
|
bless $self, __PACKAGE__; |
|
246
|
30055
|
|
|
|
|
61728
|
return $self; |
|
247
|
|
|
|
|
|
|
} |
|
248
|
|
|
|
|
|
|
|
|
249
|
16
|
|
|
16
|
1
|
333468
|
sub make_filter ($req,$ok=[],$no=[]) { |
|
|
16
|
|
|
|
|
90
|
|
|
|
16
|
|
|
|
|
33
|
|
|
|
16
|
|
|
|
|
29
|
|
|
|
16
|
|
|
|
|
30
|
|
|
250
|
16
|
|
|
|
|
58
|
my $exclusions = { map { $_ => 1 } $no->@* }; |
|
|
8
|
|
|
|
|
36
|
|
|
251
|
16
|
|
|
|
|
40
|
my $any = grep { $_ eq '*' } $ok->@*; # added to enable use of '*' wildcard' |
|
|
14
|
|
|
|
|
39
|
|
|
252
|
16
|
100
|
|
|
|
58
|
unless ($ok->@*) { |
|
253
|
|
|
|
|
|
|
# Only check for required; nothing else will be included in output |
|
254
|
|
|
|
|
|
|
return sub { |
|
255
|
5
|
|
|
5
|
|
43
|
my ($unfiltered) = @_; |
|
256
|
5
|
|
|
|
|
13
|
my $filtered = {}; |
|
257
|
5
|
|
|
|
|
12
|
for ($req->@*) { |
|
258
|
8
|
100
|
|
|
|
46
|
return unless exists $unfiltered->{$_}; |
|
259
|
|
|
|
|
|
|
} |
|
260
|
3
|
|
|
|
|
11
|
$filtered->@{ $req->@* } = $unfiltered->@{ $req->@* }; |
|
261
|
3
|
|
|
|
|
9
|
return $filtered; |
|
262
|
|
|
|
|
|
|
} |
|
263
|
5
|
|
|
|
|
43
|
} |
|
264
|
|
|
|
|
|
|
return $any |
|
265
|
|
|
|
|
|
|
# Check for required, and allow all additional input fields, minus exclusions |
|
266
|
|
|
|
|
|
|
? sub { |
|
267
|
5
|
|
|
5
|
|
1203
|
my ($unfiltered) = @_; |
|
268
|
5
|
|
|
|
|
13
|
my $filtered = {}; |
|
269
|
5
|
|
|
|
|
14
|
for ($req->@*) { |
|
270
|
6
|
100
|
|
|
|
25
|
return unless exists $unfiltered->{$_}; |
|
271
|
|
|
|
|
|
|
} |
|
272
|
3
|
|
|
|
|
10
|
$filtered->@{ $req->@* } = $unfiltered->@{ $req->@* }; |
|
273
|
3
|
|
|
|
|
13
|
for (keys $unfiltered->%*) { |
|
274
|
14
|
100
|
|
|
|
33
|
next if $exclusions->{$_}; |
|
275
|
10
|
|
|
|
|
24
|
$filtered->{$_} = $unfiltered->{$_}; |
|
276
|
|
|
|
|
|
|
} |
|
277
|
3
|
|
|
|
|
11
|
return $filtered; |
|
278
|
|
|
|
|
|
|
} |
|
279
|
|
|
|
|
|
|
# Check for required, and allow only specified accepted input fields, minus exclusions |
|
280
|
|
|
|
|
|
|
: sub { |
|
281
|
5
|
|
|
5
|
|
45
|
my ($unfiltered) = @_; |
|
282
|
5
|
|
|
|
|
9
|
my $filtered = {}; |
|
283
|
5
|
|
|
|
|
14
|
for ($req->@*) { |
|
284
|
8
|
100
|
|
|
|
28
|
return unless exists $unfiltered->{$_}; |
|
285
|
|
|
|
|
|
|
} |
|
286
|
3
|
|
|
|
|
27
|
$filtered->@{ $req->@* } = $unfiltered->@{ $req->@* }; |
|
287
|
3
|
|
|
|
|
8
|
for ($ok->@*) { |
|
288
|
6
|
100
|
|
|
|
18
|
next if $exclusions->{$_}; |
|
289
|
5
|
50
|
|
|
|
20
|
$filtered->{$_} = $unfiltered->{$_} if exists $unfiltered->{$_}; |
|
290
|
|
|
|
|
|
|
} |
|
291
|
3
|
|
|
|
|
7
|
return $filtered; |
|
292
|
|
|
|
|
|
|
} |
|
293
|
11
|
100
|
|
|
|
91
|
} |
|
294
|
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head1 SECURITY |
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
This module provides important security benefits by excluding sensitive fields |
|
298
|
|
|
|
|
|
|
before they reach downstream systems like logging, validation, or storage. |
|
299
|
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 Safe Logging - Exclude Credentials |
|
301
|
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
A common security requirement is logging user activity without exposing credentials: |
|
303
|
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
use Params::Filter qw/make_filter/; |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# Create filter for safe logging - exclude credentials |
|
307
|
|
|
|
|
|
|
my $log_filter = make_filter( |
|
308
|
|
|
|
|
|
|
[qw(timestamp action)], # required |
|
309
|
|
|
|
|
|
|
[qw(username email ip_address)], # accepted - safe to log |
|
310
|
|
|
|
|
|
|
[qw(user_id password session_token)], # excluded - never logged |
|
311
|
|
|
|
|
|
|
); |
|
312
|
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# Web form submission from user login |
|
314
|
|
|
|
|
|
|
my $form_data = { |
|
315
|
|
|
|
|
|
|
timestamp => '2026-01-27T10:30:00Z', |
|
316
|
|
|
|
|
|
|
action => 'login_attempt', |
|
317
|
|
|
|
|
|
|
username => 'alice', |
|
318
|
|
|
|
|
|
|
email => 'alice@example.com', |
|
319
|
|
|
|
|
|
|
ip_address => '192.168.1.100', |
|
320
|
|
|
|
|
|
|
user_id => 12345, |
|
321
|
|
|
|
|
|
|
password => 'secret123', # MUST NOT appear in logs |
|
322
|
|
|
|
|
|
|
session_token => 'abc123xyz', # MUST NOT appear in logs |
|
323
|
|
|
|
|
|
|
}; |
|
324
|
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# Filter for logging - credentials automatically excluded |
|
326
|
|
|
|
|
|
|
my $log_entry = $log_filter->($form_data); |
|
327
|
|
|
|
|
|
|
write_audit_log($log_entry); |
|
328
|
|
|
|
|
|
|
# Logged: { timestamp, action, username, email, ip_address } |
|
329
|
|
|
|
|
|
|
# Never logged: user_id, password, session_token |
|
330
|
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=head2 Multiple Filters for Data Segregation |
|
332
|
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Use different filters on the same input to route data to appropriate subsystems, |
|
334
|
|
|
|
|
|
|
ensuring credentials only reach authentication and never reach public display: |
|
335
|
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# Auth filter - requires credentials, excludes public data |
|
337
|
|
|
|
|
|
|
my $auth_filter = Params::Filter->new_filter({ |
|
338
|
|
|
|
|
|
|
required => ['user_id', 'password'], |
|
339
|
|
|
|
|
|
|
accepted => [], # Only credentials, nothing else |
|
340
|
|
|
|
|
|
|
excluded => ['name', 'comment', 'category', 'date'], |
|
341
|
|
|
|
|
|
|
}); |
|
342
|
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# Comment filter - accepts public data, excludes credentials |
|
344
|
|
|
|
|
|
|
my $comment_filter = Params::Filter->new_filter({ |
|
345
|
|
|
|
|
|
|
required => ['name', 'comment'], |
|
346
|
|
|
|
|
|
|
accepted => ['category', 'date'], |
|
347
|
|
|
|
|
|
|
excluded => ['user_id', 'password'], # Never show on comment page |
|
348
|
|
|
|
|
|
|
}); |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# Single web form submission with mixed data |
|
351
|
|
|
|
|
|
|
my $form_submission = { |
|
352
|
|
|
|
|
|
|
user_id => 12345, |
|
353
|
|
|
|
|
|
|
password => 'secret123', |
|
354
|
|
|
|
|
|
|
name => 'Alice', |
|
355
|
|
|
|
|
|
|
comment => 'Great article!', |
|
356
|
|
|
|
|
|
|
category => 'feedback', |
|
357
|
|
|
|
|
|
|
date => '2026-01-27', |
|
358
|
|
|
|
|
|
|
}; |
|
359
|
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# Route to authentication system - only credentials |
|
361
|
|
|
|
|
|
|
my ($auth_data, $auth_msg) = $auth_filter->apply($form_submission); |
|
362
|
|
|
|
|
|
|
if ($auth_data) { |
|
363
|
|
|
|
|
|
|
$app->authenticate($auth_data); |
|
364
|
|
|
|
|
|
|
# Sent to auth: { user_id => 12345, password => 'secret123' } |
|
365
|
|
|
|
|
|
|
} |
|
366
|
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# Route to comment display - only public data |
|
368
|
|
|
|
|
|
|
my ($comment_data, $comment_msg) = $comment_filter->apply($form_submission); |
|
369
|
|
|
|
|
|
|
if ($comment_data) { |
|
370
|
|
|
|
|
|
|
$app->add_comment($comment_data); |
|
371
|
|
|
|
|
|
|
# Sent to comment page: { name => 'Alice', comment => '...', category => '...', date => '...' } |
|
372
|
|
|
|
|
|
|
# Password and user_id NEVER reach the comment display system |
|
373
|
|
|
|
|
|
|
} |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=head2 Compliance Benefits |
|
376
|
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Helps meet regulatory requirements by design: |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=over 4 |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=item * **PCI-DSS** - Ensure credit card numbers never touch logging or validation code |
|
382
|
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=item * **GDPR** - Exclude fields you shouldn't store before processing |
|
384
|
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=item * **Data Minimization** - Only process fields you actually need for each subsystem |
|
386
|
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=item * **Audit Trails** - Clear record of what fields are accepted/excluded per destination |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=back |
|
390
|
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=head2 Defense in Depth |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
Even if downstream validation code has bugs or is later modified, excluded fields |
|
394
|
|
|
|
|
|
|
B reach it: |
|
395
|
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# Logging system updated to dump all input - credentials still excluded |
|
397
|
|
|
|
|
|
|
my $safe_data = $log_filter->($user_activity); |
|
398
|
|
|
|
|
|
|
log_everything($safe_data); # Password field was already filtered out |
|
399
|
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
This provides defense in depth: sensitive data is removed at the filter layer, |
|
401
|
|
|
|
|
|
|
regardless of what happens downstream. |
|
402
|
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head1 CLOSURE INTERFACE (Maximum Performance) |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
The closure interface provides B through specialized, |
|
406
|
|
|
|
|
|
|
pre-compiled closures. This is the most important performance feature of |
|
407
|
|
|
|
|
|
|
Params::Filter and can be faster than hand-written Perl filtering code. |
|
408
|
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
B |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=over 4 |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=item * **Fastest interface** - Pre-computed exclusions, specialized variants |
|
414
|
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=item * **Hashref input only** - No input parsing overhead (unlike functional/OO interfaces) |
|
416
|
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=item * **Immutable** - Filter cannot be modified after creation (unlike OO interface) |
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=item * **No error messages** - Returns C on failure (unlike functional/OO interfaces) |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=item * **No debug mode** - Minimal overhead for maximum speed |
|
422
|
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=back |
|
424
|
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
B |
|
426
|
|
|
|
|
|
|
filtering operations, or you're processing large datasets. |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=head2 make_filter |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
use Params::Filter qw/make_filter/; |
|
431
|
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# Create a reusable filter closure |
|
433
|
|
|
|
|
|
|
my $filter = make_filter( |
|
434
|
|
|
|
|
|
|
\@required, # Arrayref of required field names |
|
435
|
|
|
|
|
|
|
\@accepted, # Arrayref of optional field names (default: []) |
|
436
|
|
|
|
|
|
|
\@excluded, # Arrayref of names of fields to remove (default: []) |
|
437
|
|
|
|
|
|
|
); |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# Apply filter to data (must be hashref) |
|
440
|
|
|
|
|
|
|
my $result = $filter->($input_hashref); |
|
441
|
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
Creates a fast, reusable closure that filters hashrefs according to field |
|
443
|
|
|
|
|
|
|
specifications. The closure checks only for presence/absence of fields, not |
|
444
|
|
|
|
|
|
|
field values. |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head3 Parameters |
|
447
|
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=over 4 |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=item * C<\@required> - Arrayref of names of fields that B be present |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=item * C<\@accepted> - Arrayref of optional names of fields to accept (default: []) |
|
453
|
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=item * C<\@excluded> - Arrayref of names of fields to remove even if accepted (default: []) |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=back |
|
457
|
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=head3 Returns |
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
A code reference that accepts a single hashref argument and returns a filtered |
|
461
|
|
|
|
|
|
|
hashref, or C if required fields are missing. |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
B No error message is returned. The closure only returns the filtered |
|
464
|
|
|
|
|
|
|
hashref or C. Use the functional or OO interfaces if you need error messages. |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=head3 Specialized Closure Variants |
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
The closure is optimized based on your configuration: |
|
469
|
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=over 4 |
|
471
|
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=item * **Required-only** - When C<@accepted> is empty, returns only required fields |
|
473
|
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=item * **Wildcard** - When C<@accepted> contains C<'*'>, accepts all input fields except exclusions |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=item * **Accepted-specific** - When C<@accepted> has specific fields, returns required plus those accepted fields (minus exclusions) |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=back |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=head3 Example |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# Create filter for user registration |
|
483
|
|
|
|
|
|
|
my $user_filter = make_filter( |
|
484
|
|
|
|
|
|
|
[qw(username email)], # required |
|
485
|
|
|
|
|
|
|
[qw(full_name bio)], # accepted |
|
486
|
|
|
|
|
|
|
[qw(password confirm)], # excluded |
|
487
|
|
|
|
|
|
|
); |
|
488
|
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
# Apply to multiple records - very fast |
|
490
|
|
|
|
|
|
|
for my $record (@records) { |
|
491
|
|
|
|
|
|
|
my $filtered = $user_filter->($record); |
|
492
|
|
|
|
|
|
|
next unless $filtered; # Skip if required fields missing |
|
493
|
|
|
|
|
|
|
process_user($filtered); |
|
494
|
|
|
|
|
|
|
} |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
# Wildcard example - accept everything except sensitive fields |
|
497
|
|
|
|
|
|
|
my $safe_filter = make_filter( |
|
498
|
|
|
|
|
|
|
[qw(id type)], |
|
499
|
|
|
|
|
|
|
['*'], # accept all other fields |
|
500
|
|
|
|
|
|
|
[qw(password token ssn)], # but exclude these |
|
501
|
|
|
|
|
|
|
); |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=head3 Performance Characteristics |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=over 4 |
|
506
|
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=item * Non-destructive - Original hashref is never modified |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item * Pre-computed - Exclusion hash built once at filter creation |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=item * Specialized - No runtime conditionals, closure is tailored during construction |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=item * Can be faster than raw Perl - Up to 20-25% faster than hand-written filtering code in many cases |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=item * No overhead for multiple uses - Create once, apply many times |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=back |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=head3 Trade-offs Compared to Other Interfaces |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=over 4 |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=item * **Advantages**: Maximum speed, lightweight, no feature overhead, fastest option available |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=item * **Limitations**: No error messages, no debug mode, no modifier methods, no input parsing (only accepts hashrefs), immutable after creation |
|
526
|
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=item * **When to use**: High-frequency filtering, performance-critical code, hot code paths, large dataset processing |
|
528
|
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
=item * **When to use OO/functional instead**: When you need error messages, debug mode, input format flexibility (arrayrefs/scalars), or dynamic reconfiguration |
|
530
|
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
=back |
|
532
|
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=head1 FUNCTIONAL INTERFACE |
|
534
|
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
The functional interface provides direct parameter filtering through the C function. |
|
536
|
|
|
|
|
|
|
This interface supports flexible input parsing (hashrefs, arrayrefs, scalars) and returns |
|
537
|
|
|
|
|
|
|
detailed error messages. |
|
538
|
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
B |
|
540
|
|
|
|
|
|
|
or one-off filtering operations. |
|
541
|
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head2 filter |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
my ($filtered, $status) = filter( |
|
545
|
|
|
|
|
|
|
$input_data, # Hashref, arrayref, or scalar |
|
546
|
|
|
|
|
|
|
\@required, # Arrayref of required field names |
|
547
|
|
|
|
|
|
|
\@accepted, # Arrayref of optional field names (default: []) |
|
548
|
|
|
|
|
|
|
\@excluded, # Arrayref of names of fields to remove (default: []) |
|
549
|
|
|
|
|
|
|
$debug_mode, # Boolean: enable warnings (default: 0) |
|
550
|
|
|
|
|
|
|
); |
|
551
|
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# Scalar context - returns filtered hashref or undef on failure |
|
553
|
|
|
|
|
|
|
my $result = filter($input, \@required, \@accepted); |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
Filters input data according to field specifications. Only checks for |
|
556
|
|
|
|
|
|
|
presence/absence of fields, not field values. |
|
557
|
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=head3 Parameters |
|
559
|
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=over 4 |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=item * C<$input_data> - Input parameters (hashref, arrayref, or scalar) |
|
563
|
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
=item * C<\@required> - Arrayref of names of fields that B be present |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=item * C<\@accepted> - Arrayref of optional names of fields to accept (default: []) |
|
567
|
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=item * C<\@excluded> - Arrayref of names of fields to remove even if accepted (default: []) |
|
569
|
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=item * C<$debug_mode> - Boolean to enable warnings (default: 0) |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=back |
|
573
|
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=head3 Returns |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
In list context: C<(hashref, status_message)> or C<(undef, error_message)> |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
In scalar context: Hashref with filtered parameters, or C on failure |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
=head3 Example |
|
581
|
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
# Define filter rules (could be from config file) |
|
583
|
|
|
|
|
|
|
my @required = qw(username email); |
|
584
|
|
|
|
|
|
|
my @accepted = qw(full_name phone); |
|
585
|
|
|
|
|
|
|
my @excluded = qw(password ssn); |
|
586
|
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
# Apply to incoming data from web form |
|
588
|
|
|
|
|
|
|
my ($user_data, $msg) = filter( |
|
589
|
|
|
|
|
|
|
$form_submission, |
|
590
|
|
|
|
|
|
|
\@required, |
|
591
|
|
|
|
|
|
|
\@accepted, |
|
592
|
|
|
|
|
|
|
\@excluded, |
|
593
|
|
|
|
|
|
|
); |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
if ($user_data) { |
|
596
|
|
|
|
|
|
|
create_user($user_data); |
|
597
|
|
|
|
|
|
|
} else { |
|
598
|
|
|
|
|
|
|
log_error($msg); |
|
599
|
|
|
|
|
|
|
} |
|
600
|
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=head1 OBJECT-ORIENTED INTERFACE |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
The OO interface provides reusable filter objects that can be configured once and applied to multiple datasets. This interface includes the most features, including modifier methods for dynamic configuration. |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=head2 new_filter |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
my $filter = Params::Filter->new_filter({ |
|
608
|
|
|
|
|
|
|
required => ['field1', 'field2'], |
|
609
|
|
|
|
|
|
|
accepted => ['field3', 'field4', 'field5'], |
|
610
|
|
|
|
|
|
|
excluded => ['forbidden_field'], |
|
611
|
|
|
|
|
|
|
DEBUG => 1, # Optional debug mode |
|
612
|
|
|
|
|
|
|
}); |
|
613
|
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
# Empty constructor - rejects all fields by default |
|
615
|
|
|
|
|
|
|
my $strict_filter = Params::Filter->new_filter(); |
|
616
|
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
Creates a reusable filter object with predefined field rules. The filter |
|
618
|
|
|
|
|
|
|
can then be applied to multiple datasets using the L method. |
|
619
|
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=head3 Parameters |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=over 4 |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
=item * C - Arrayref of names of required fields (default: []) |
|
625
|
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=item * C - Arrayref of names of optional fields (default: []) |
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
=item * C - Arrayref of names of fields to always remove (default: []) |
|
629
|
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
=item * C - Boolean to enable debug warnings (default: 0) |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=back |
|
633
|
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
=head3 Returns |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
A C object |
|
637
|
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=head3 Example |
|
639
|
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
# Create filter for user registration data |
|
641
|
|
|
|
|
|
|
my $user_filter = Params::Filter->new_filter({ |
|
642
|
|
|
|
|
|
|
required => ['username', 'email'], |
|
643
|
|
|
|
|
|
|
accepted => ['first_name', 'last_name', 'phone', 'bio'], |
|
644
|
|
|
|
|
|
|
excluded => ['password', 'ssn', 'credit_card'], |
|
645
|
|
|
|
|
|
|
}); |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# Apply to multiple incoming datasets |
|
648
|
|
|
|
|
|
|
my ($user1, $msg1) = $user_filter->apply($web_form_data); |
|
649
|
|
|
|
|
|
|
my ($user2, $msg2) = $user_filter->apply($api_request_data); |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=head2 apply |
|
652
|
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
my ($filtered, $status) = $filter->apply($input_data); |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
Applies the filter's predefined rules to input data. This is the OO |
|
656
|
|
|
|
|
|
|
equivalent of the L function. |
|
657
|
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=head3 Parameters |
|
659
|
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=over 4 |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=item * C<$input_data> - Hashref, arrayref, or scalar to filter |
|
663
|
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=back |
|
665
|
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head3 Returns |
|
667
|
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
In list context: C<(hashref, status_message)> or C<(undef, error_message)> |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
In scalar context: Hashref with filtered parameters, or C on failure |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=head3 Example |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
my $filter = Params::Filter->new_filter({ |
|
675
|
|
|
|
|
|
|
required => ['id', 'type'], |
|
676
|
|
|
|
|
|
|
accepted => ['name', 'value'], |
|
677
|
|
|
|
|
|
|
}); |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
# Process multiple records from database |
|
680
|
|
|
|
|
|
|
for my $record (@db_records) { |
|
681
|
|
|
|
|
|
|
my ($filtered, $msg) = $filter->apply($record); |
|
682
|
|
|
|
|
|
|
if ($filtered) { |
|
683
|
|
|
|
|
|
|
process_record($filtered); |
|
684
|
|
|
|
|
|
|
} else { |
|
685
|
|
|
|
|
|
|
log_error("Record failed: $msg"); |
|
686
|
|
|
|
|
|
|
} |
|
687
|
|
|
|
|
|
|
} |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
=cut |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
sub set_required { |
|
692
|
22
|
|
|
22
|
1
|
139
|
my ($self, @fields) = @_; |
|
693
|
22
|
100
|
|
|
|
81
|
@fields = ref $fields[0] eq 'ARRAY' ? $fields[0]->@* : @fields; |
|
694
|
22
|
|
|
|
|
66
|
my @required = grep { defined } @fields; |
|
|
28
|
|
|
|
|
87
|
|
|
695
|
22
|
100
|
|
|
|
73
|
$self->{required} = @required ? [ @required ] : []; |
|
696
|
22
|
|
|
|
|
103
|
return $self; |
|
697
|
|
|
|
|
|
|
} |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
sub set_accepted { |
|
700
|
9
|
|
|
9
|
1
|
360
|
my ($self, @fields) = @_; |
|
701
|
9
|
100
|
|
|
|
35
|
@fields = ref $fields[0] eq 'ARRAY' ? $fields[0]->@* : @fields; |
|
702
|
9
|
|
|
|
|
20
|
my @accepted = grep { defined } @fields; |
|
|
17
|
|
|
|
|
40
|
|
|
703
|
9
|
100
|
|
|
|
29
|
$self->{accepted} = @accepted ? [ @accepted ] : []; |
|
704
|
9
|
|
|
|
|
32
|
return $self; |
|
705
|
|
|
|
|
|
|
} |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
sub accept_all { |
|
708
|
9
|
|
|
9
|
1
|
20
|
my ($self) = @_; |
|
709
|
9
|
|
|
|
|
24
|
$self->{accepted} = ['*']; |
|
710
|
9
|
|
|
|
|
43
|
return $self; |
|
711
|
|
|
|
|
|
|
} |
|
712
|
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub accept_none { |
|
714
|
4
|
|
|
4
|
1
|
10
|
my ($self) = @_; |
|
715
|
4
|
|
|
|
|
11
|
$self->{accepted} = []; |
|
716
|
4
|
|
|
|
|
13
|
return $self; |
|
717
|
|
|
|
|
|
|
} |
|
718
|
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
sub set_excluded { |
|
720
|
10
|
|
|
10
|
1
|
1246
|
my ($self, @fields) = @_; |
|
721
|
10
|
100
|
|
|
|
36
|
@fields = ref $fields[0] eq 'ARRAY' ? $fields[0]->@* : @fields; |
|
722
|
10
|
|
|
|
|
32
|
my @excluded = grep { defined } @fields; |
|
|
14
|
|
|
|
|
35
|
|
|
723
|
10
|
100
|
|
|
|
35
|
$self->{excluded} = @excluded ? [ @excluded ] : []; |
|
724
|
10
|
|
|
|
|
31
|
return $self; |
|
725
|
|
|
|
|
|
|
} |
|
726
|
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub apply { |
|
728
|
260040
|
|
|
260040
|
1
|
1235692
|
my ($self,$args) = @_; |
|
729
|
260040
|
|
50
|
|
|
515565
|
my $req = $self->{required} || []; |
|
730
|
260040
|
|
50
|
|
|
463478
|
my $ok = $self->{accepted} || []; |
|
731
|
260040
|
|
50
|
|
|
480746
|
my $no = $self->{excluded} || []; |
|
732
|
260040
|
|
100
|
|
|
640062
|
my $db = $self->{debug} || 0; |
|
733
|
260040
|
|
|
|
|
433307
|
my @result = filter( $args, $req, $ok, $no, $db); |
|
734
|
260040
|
100
|
|
|
|
906813
|
return wantarray ? @result : $result[0]; |
|
735
|
|
|
|
|
|
|
} |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=head1 MODIFIER METHODS |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
The OO interface provides methods to modify a filter's configuration after creation. |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
=head2 Modifier Methods for Dynamic Configuration |
|
742
|
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
The OO interface provides methods to modify a filter's configuration after creation. |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# Start with an empty filter (rejects all by default) |
|
746
|
|
|
|
|
|
|
my $filter = Params::Filter->new_filter(); |
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
# Configure it in steps as needed |
|
749
|
|
|
|
|
|
|
$filter->set_required(['id', 'name']); |
|
750
|
|
|
|
|
|
|
# later: |
|
751
|
|
|
|
|
|
|
$filter->set_accepted(['email', 'phone']) |
|
752
|
|
|
|
|
|
|
$filter->set_excluded(['password']); |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head3 Available Modifier Methods |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=over 4 |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=item * **C** - Set required fields (accepts arrayref or list) |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=item * **C** - Set accepted fields (accepts arrayref or list) |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=item * **C** - Set excluded fields (accepts arrayref or list) |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=item * **C** - Convenience method: sets accepted to C<['*']> (wildcard mode) |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=item * **C** - Convenience method: sets accepted to C<[]> (reject all extras) |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=back |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=head2 Important Behavior Notes |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
B |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
If no fields are provided to C, C, or C, the respective list is set to an empty array C<[]>: |
|
775
|
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
$filter->set_accepted(); # Sets accepted to `[]` |
|
777
|
|
|
|
|
|
|
# Result: Only required fields will be accepted (extras rejected) |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
B |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
All modifier methods return C<$self> for chaining: |
|
782
|
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
$filter->set_required(['id']) |
|
784
|
|
|
|
|
|
|
->set_accepted(['name']) |
|
785
|
|
|
|
|
|
|
->accept_all(); # Overrides set_accepted |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
B |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
A filter may call its modifier methods more than once, and the changes take effect immediately. |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=head2 Meta-Programming Use Cases |
|
792
|
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
These methods enable dynamic configuration for conditional scenarios: |
|
794
|
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
# Environment-based configuration |
|
796
|
|
|
|
|
|
|
my $filter = Params::Filter->new_filter(); |
|
797
|
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
if ($ENV{MODE} eq 'production') { |
|
799
|
|
|
|
|
|
|
$filter->set_required(['api_key', 'endpoint']) |
|
800
|
|
|
|
|
|
|
->set_accepted(['timeout', 'retries']) |
|
801
|
|
|
|
|
|
|
->set_excluded(['debug_info']); |
|
802
|
|
|
|
|
|
|
} |
|
803
|
|
|
|
|
|
|
else { |
|
804
|
|
|
|
|
|
|
$filter->set_required(['debug_mode']) |
|
805
|
|
|
|
|
|
|
->accept_all(); |
|
806
|
|
|
|
|
|
|
} |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
# Dynamic field lists from config |
|
809
|
|
|
|
|
|
|
my $config_fields = load_config('fields.json'); |
|
810
|
|
|
|
|
|
|
$filter->set_required($config_fields->{required}) |
|
811
|
|
|
|
|
|
|
->set_accepted($config_fields->{accepted}) |
|
812
|
|
|
|
|
|
|
->set_excluded($config_fields->{excluded}); |
|
813
|
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=cut |
|
815
|
|
|
|
|
|
|
|
|
816
|
295057
|
|
|
295057
|
1
|
1125440
|
sub filter ($args,$req,$ok=[],$no=[],$db=0) { |
|
|
295057
|
|
|
|
|
374952
|
|
|
|
295057
|
|
|
|
|
360870
|
|
|
|
295057
|
|
|
|
|
374037
|
|
|
|
295057
|
|
|
|
|
369282
|
|
|
|
295057
|
|
|
|
|
373061
|
|
|
|
295057
|
|
|
|
|
346495
|
|
|
817
|
295057
|
|
|
|
|
420591
|
my %args = (); |
|
818
|
295057
|
|
|
|
|
386962
|
my @messages = (); # Parsing messages (always reported) |
|
819
|
295057
|
|
|
|
|
365499
|
my @warnings = (); # Debug warnings (only when $db is true) |
|
820
|
295057
|
|
|
|
|
389947
|
my $wantarray = wantarray; |
|
821
|
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
# ============================================================ |
|
823
|
|
|
|
|
|
|
# PHASE 1: Parse input data to hashref format |
|
824
|
|
|
|
|
|
|
# ============================================================ |
|
825
|
295057
|
100
|
|
|
|
535428
|
if (ref $args eq 'HASH') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
826
|
295050
|
|
|
|
|
1430138
|
%args = $args->%* |
|
827
|
|
|
|
|
|
|
} |
|
828
|
|
|
|
|
|
|
elsif (ref $args eq 'ARRAY') { |
|
829
|
5
|
100
|
|
|
|
19
|
if (ref($args->[0]) eq 'HASH') { |
|
830
|
1
|
|
|
|
|
6
|
%args = $args->[0]->%*; # Ignore the rest |
|
831
|
|
|
|
|
|
|
} |
|
832
|
|
|
|
|
|
|
else { |
|
833
|
4
|
|
|
|
|
13
|
my @args = $args->@*; |
|
834
|
4
|
100
|
|
|
|
22
|
if (@args == 1) { |
|
|
|
100
|
|
|
|
|
|
|
835
|
1
|
|
|
|
|
6
|
%args = ( '_' => $args[0] ); # make it a value with key '_' |
|
836
|
1
|
50
|
|
|
|
6
|
my $preview = length($args[0]) > 20 |
|
837
|
|
|
|
|
|
|
? substr($args[0], 0, 20) . '...' |
|
838
|
|
|
|
|
|
|
: $args[0]; |
|
839
|
1
|
|
|
|
|
5
|
push @messages => "Plain text argument accepted with key '_': '$preview'"; |
|
840
|
|
|
|
|
|
|
} |
|
841
|
|
|
|
|
|
|
elsif ( @args % 2 ) { |
|
842
|
2
|
|
|
|
|
8
|
%args = (@args, 1); # make last arg element a flag |
|
843
|
2
|
|
|
|
|
14
|
push @messages => "Odd number of arguments provided; " . |
|
844
|
|
|
|
|
|
|
"last element '$args[-1]' converted to flag with value 1"; |
|
845
|
|
|
|
|
|
|
} |
|
846
|
|
|
|
|
|
|
else { |
|
847
|
1
|
|
|
|
|
5
|
%args = @args; # turn array into hash pairs |
|
848
|
|
|
|
|
|
|
} |
|
849
|
|
|
|
|
|
|
} |
|
850
|
|
|
|
|
|
|
} |
|
851
|
|
|
|
|
|
|
elsif ( !ref $args ) { |
|
852
|
2
|
|
|
|
|
11
|
%args = ( '_' => $args); # make it a value with key '_' |
|
853
|
2
|
50
|
|
|
|
14
|
my $preview = length($args) > 20 |
|
854
|
|
|
|
|
|
|
? substr($args, 0, 20) . '...' |
|
855
|
|
|
|
|
|
|
: $args; |
|
856
|
2
|
|
|
|
|
9
|
push @messages => "Plain text argument accepted with key '_': '$preview'"; |
|
857
|
|
|
|
|
|
|
} |
|
858
|
|
|
|
|
|
|
|
|
859
|
295057
|
|
|
|
|
643624
|
my @required_flds = $req->@*; |
|
860
|
295057
|
100
|
|
|
|
539498
|
unless ( keys %args ) { |
|
861
|
|
|
|
|
|
|
my $err = "Unable to initialize without required arguments: " . |
|
862
|
1
|
|
|
|
|
4
|
join ', ' => map { "'$_'" } @required_flds; |
|
|
1
|
|
|
|
|
6
|
|
|
863
|
1
|
50
|
|
|
|
6
|
return $wantarray ? (undef, $err) : undef; |
|
864
|
|
|
|
|
|
|
} |
|
865
|
|
|
|
|
|
|
|
|
866
|
295056
|
100
|
|
|
|
556498
|
if ( scalar keys(%args) < @required_flds ) { |
|
867
|
|
|
|
|
|
|
my $err = "Unable to initialize without all required arguments: " . |
|
868
|
25002
|
|
|
|
|
40237
|
join ', ' => map { "'$_'" } @required_flds; |
|
|
50004
|
|
|
|
|
118843
|
|
|
869
|
25002
|
50
|
|
|
|
88394
|
return $wantarray ? (undef, $err) : undef; |
|
870
|
|
|
|
|
|
|
} |
|
871
|
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
# ============================================================ |
|
873
|
|
|
|
|
|
|
# PHASE 2: Pre-compute optimization data structures |
|
874
|
|
|
|
|
|
|
# ============================================================ |
|
875
|
|
|
|
|
|
|
# Pre-compute exclusion hash (once per call, not per field) |
|
876
|
270054
|
|
|
|
|
434616
|
my $exclusions = { map { $_ => 1 } $no->@* }; |
|
|
335020
|
|
|
|
|
666927
|
|
|
877
|
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
# Check for wildcard once (not per iteration) |
|
879
|
270054
|
|
|
|
|
441450
|
my $has_wildcard = grep { $_ eq '*' } $ok->@*; |
|
|
200056
|
|
|
|
|
346472
|
|
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
# ============================================================ |
|
882
|
|
|
|
|
|
|
# PHASE 3: Check required fields and copy to output |
|
883
|
|
|
|
|
|
|
# ============================================================ |
|
884
|
270054
|
|
|
|
|
354138
|
my $filtered = {}; |
|
885
|
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
# Check all required fields exist |
|
887
|
270054
|
|
|
|
|
403947
|
for my $fld (@required_flds) { |
|
888
|
|
|
|
|
|
|
return $wantarray ? (undef, "Unable to initialize without required arguments: '$fld'") : undef |
|
889
|
665060
|
0
|
|
|
|
1316495
|
unless exists $args{$fld}; |
|
|
|
50
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
} |
|
891
|
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
# Copy required fields using hash slice (faster than individual assignments) |
|
893
|
270054
|
|
|
|
|
739276
|
$filtered->@{ $req->@* } = @args{ $req->@* }; |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
# Fast return: no accepted fields (required-only) |
|
896
|
270054
|
100
|
66
|
|
|
668959
|
unless ($ok->@* or $has_wildcard) { |
|
897
|
135013
|
|
|
|
|
182824
|
my @all_msgs = (@messages, @warnings); |
|
898
|
135013
|
50
|
|
|
|
219287
|
my $return_msg = @all_msgs |
|
899
|
|
|
|
|
|
|
? join "\n" => @all_msgs |
|
900
|
|
|
|
|
|
|
: "Admitted"; |
|
901
|
|
|
|
|
|
|
|
|
902
|
135013
|
100
|
|
|
|
534113
|
return $wantarray ? ( $filtered, $return_msg ) : $filtered; |
|
903
|
|
|
|
|
|
|
} |
|
904
|
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
# ============================================================ |
|
906
|
|
|
|
|
|
|
# PHASE 4: Apply accepted/excluded fields (non-destructive) |
|
907
|
|
|
|
|
|
|
# ============================================================ |
|
908
|
135041
|
100
|
|
|
|
290991
|
if ($has_wildcard) { |
|
|
|
50
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
# Wildcard: accept all fields except exclusions |
|
910
|
13
|
|
|
|
|
104
|
for my $fld (keys %args) { |
|
911
|
45
|
100
|
|
|
|
102
|
next if $exclusions->{$fld}; |
|
912
|
35
|
100
|
|
|
|
102
|
next if exists $filtered->{$fld}; # Skip required fields (already copied) |
|
913
|
22
|
|
|
|
|
53
|
$filtered->{$fld} = $args{$fld}; |
|
914
|
|
|
|
|
|
|
} |
|
915
|
|
|
|
|
|
|
} |
|
916
|
|
|
|
|
|
|
elsif ($ok->@*) { |
|
917
|
|
|
|
|
|
|
# Accepted-specific: only copy specified fields (unless excluded) |
|
918
|
135028
|
|
|
|
|
201888
|
for my $fld ($ok->@*) { |
|
919
|
200043
|
50
|
|
|
|
375037
|
next if $exclusions->{$fld}; |
|
920
|
200043
|
100
|
|
|
|
476414
|
$filtered->{$fld} = $args{$fld} if exists $args{$fld}; |
|
921
|
|
|
|
|
|
|
} |
|
922
|
|
|
|
|
|
|
} |
|
923
|
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
# Collect debug info about excluded/unrecognized fields |
|
925
|
135041
|
|
|
|
|
190957
|
my @unrecognized = (); |
|
926
|
135041
|
100
|
|
|
|
236682
|
if ($db) { |
|
927
|
7
|
|
|
|
|
37
|
for my $fld (keys %args) { |
|
928
|
16
|
100
|
|
|
|
42
|
next if exists $filtered->{$fld}; |
|
929
|
7
|
100
|
|
|
|
18
|
next if $exclusions->{$fld}; |
|
930
|
4
|
|
|
|
|
13
|
push @unrecognized, $fld; |
|
931
|
|
|
|
|
|
|
} |
|
932
|
|
|
|
|
|
|
|
|
933
|
7
|
100
|
|
|
|
23
|
if (@unrecognized > 0) { |
|
934
|
|
|
|
|
|
|
push @warnings => "Ignoring unrecognized arguments: " . |
|
935
|
3
|
|
|
|
|
9
|
join ', ' => map { "'$_'" } @unrecognized; |
|
|
4
|
|
|
|
|
21
|
|
|
936
|
|
|
|
|
|
|
} |
|
937
|
|
|
|
|
|
|
|
|
938
|
7
|
|
|
|
|
20
|
my @found_excluded = grep { exists $args{$_} } $no->@*; |
|
|
3
|
|
|
|
|
11
|
|
|
939
|
7
|
100
|
|
|
|
20
|
if (@found_excluded > 0) { |
|
940
|
|
|
|
|
|
|
push @warnings => "Ignoring excluded arguments: " . |
|
941
|
3
|
|
|
|
|
8
|
join ', ' => map { "'$_'" } @found_excluded; |
|
|
3
|
|
|
|
|
17
|
|
|
942
|
|
|
|
|
|
|
} |
|
943
|
|
|
|
|
|
|
} |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
# ============================================================ |
|
946
|
|
|
|
|
|
|
# PHASE 5: Build return message |
|
947
|
|
|
|
|
|
|
# ============================================================ |
|
948
|
135041
|
|
|
|
|
187784
|
my @all_msgs = (@messages, @warnings); |
|
949
|
135041
|
100
|
|
|
|
217846
|
my $return_msg = @all_msgs |
|
950
|
|
|
|
|
|
|
? join "\n" => @all_msgs |
|
951
|
|
|
|
|
|
|
: "Admitted"; |
|
952
|
|
|
|
|
|
|
|
|
953
|
135041
|
50
|
|
|
|
626251
|
return $wantarray ? ( $filtered, $return_msg ) : $filtered; |
|
954
|
|
|
|
|
|
|
} |
|
955
|
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
=head1 INPUT PARSING |
|
957
|
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
B This section applies to the L and L only. The L accepts only hashrefs for maximum speed. |
|
959
|
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
The C function parses multiple common input formats into a consistent internal structure. This flexibility allows you to use the module with data from differing sources such as form input, arguments to subroutines/methods, fetched database records, and test input, without pre-processing. |
|
961
|
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head2 Supported Input Formats |
|
963
|
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=head3 1. Hashref (Most Common) |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
##### Uses the hashref's key-value pairs as provided |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
# External data source (e.g., from web form, API, or database) |
|
969
|
|
|
|
|
|
|
my $incoming_user = { name => 'Alice', email => 'alice@example.com', phone => '555-1234' }; |
|
970
|
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
# Apply filter with rules defined inline |
|
972
|
|
|
|
|
|
|
my ($result, $msg) = filter( |
|
973
|
|
|
|
|
|
|
$incoming_user, |
|
974
|
|
|
|
|
|
|
['name', 'email'], |
|
975
|
|
|
|
|
|
|
['phone'], |
|
976
|
|
|
|
|
|
|
); |
|
977
|
|
|
|
|
|
|
# Result: { name => 'Alice', email => 'alice@example.com', phone => '555-1234' } |
|
978
|
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=head3 2. Arrayref with Even Number of Elements |
|
980
|
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
##### Makes key-value pairs from arrayref elements, reading left to right |
|
982
|
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
# Pre-defined filter rules (typically defined at package level or in config) |
|
984
|
|
|
|
|
|
|
my @required_fields = qw(name email); |
|
985
|
|
|
|
|
|
|
my @accepted_fields = qw(age); |
|
986
|
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
# External data from command-line arguments or similar list source |
|
988
|
|
|
|
|
|
|
my @cli_args = ('name', 'Bob', 'email', 'bob@example.com', 'age', 30); |
|
989
|
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
my ($result, $msg) = filter( |
|
991
|
|
|
|
|
|
|
\@cli_args, |
|
992
|
|
|
|
|
|
|
\@required_fields, |
|
993
|
|
|
|
|
|
|
\@accepted_fields, |
|
994
|
|
|
|
|
|
|
); |
|
995
|
|
|
|
|
|
|
# Result: { name => 'Bob', email => 'bob@example.com', age => 30 } |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=head3 3. Arrayref with Odd Number of Elements |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
##### Makes key-value pairs from arrayref elements, reading left to right, but when an array has an odd number of elements, the last element (right-most) becomes a flag assigned the value C<1>: |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# Pre-defined filter configuration |
|
1002
|
|
|
|
|
|
|
my @required = qw(name); |
|
1003
|
|
|
|
|
|
|
my @accepted = qw(verbose force); |
|
1004
|
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
# External data with odd number of elements (e.g., CLI args with flags) |
|
1006
|
|
|
|
|
|
|
my $command_args = ['name', 'Charlie', 'verbose', 'debug', 'force']; |
|
1007
|
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
my ($result, $msg) = filter( |
|
1009
|
|
|
|
|
|
|
$command_args, |
|
1010
|
|
|
|
|
|
|
\@required, |
|
1011
|
|
|
|
|
|
|
\@accepted, |
|
1012
|
|
|
|
|
|
|
[], 1, # Debug mode to see warning |
|
1013
|
|
|
|
|
|
|
); |
|
1014
|
|
|
|
|
|
|
# Result: { name => 'Charlie', verbose => 'debug', force => 1 } |
|
1015
|
|
|
|
|
|
|
# Message includes: "Odd number of arguments provided; last element 'force' treated as flag" |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=head3 4. Arrayref with Hashref as First Element |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
##### Uses the hashref's key-value pairs as provided, ignores rest of arrayref |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# Pre-configured filter |
|
1022
|
|
|
|
|
|
|
my @required = qw(name); |
|
1023
|
|
|
|
|
|
|
my @accepted = qw(age title); |
|
1024
|
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
# External data source with hashref wrapped in array |
|
1026
|
|
|
|
|
|
|
my $arg0 = { name => 'Diana', age => 25, hire_date => 2026-01-09, title => 'CTO' }; |
|
1027
|
|
|
|
|
|
|
my $arg1 = $something; |
|
1028
|
|
|
|
|
|
|
my $arg2 = $something_else; |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
my $api_response = [ $arg0, $arg1, $arg2, ]; |
|
1031
|
|
|
|
|
|
|
my ($result, $msg) = filter( |
|
1032
|
|
|
|
|
|
|
$api_response, |
|
1033
|
|
|
|
|
|
|
\@required, |
|
1034
|
|
|
|
|
|
|
\@accepted, |
|
1035
|
|
|
|
|
|
|
); |
|
1036
|
|
|
|
|
|
|
# Result: { name => 'Diana', age => 25, title => 'CTO' } |
|
1037
|
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=head3 5. Single-Element Arrayref |
|
1039
|
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
##### Creates a hashref with the element as the value and '_' as its key. |
|
1041
|
|
|
|
|
|
|
To make use of this feature, C<'_'> or the wildcard C<'*'> must be included in the appropriate filter lists. |
|
1042
|
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
# Filter configuration accepting special '_' key |
|
1044
|
|
|
|
|
|
|
my @required = (); |
|
1045
|
|
|
|
|
|
|
my @accepted = qw(_); |
|
1046
|
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
# External data: single-element array |
|
1048
|
|
|
|
|
|
|
my $single_value = ['search_query']; |
|
1049
|
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
my ($result, $msg) = filter( |
|
1051
|
|
|
|
|
|
|
$single_value, |
|
1052
|
|
|
|
|
|
|
\@required, |
|
1053
|
|
|
|
|
|
|
\@accepted, |
|
1054
|
|
|
|
|
|
|
); |
|
1055
|
|
|
|
|
|
|
# Result: { _ => 'search_query' } |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=head3 6. Plain Scalar (String) |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
##### Creates a hashref with the scalar as the value and '_' as its key. |
|
1060
|
|
|
|
|
|
|
To make use of this feature, C<'_'> or the wildcard C<'*'> must be included in the appropriate filter lists. |
|
1061
|
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
Note: No attempt is made to parse strings into data. |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
# Pre-configured filter setup |
|
1065
|
|
|
|
|
|
|
my @required = (); |
|
1066
|
|
|
|
|
|
|
my @accepted = qw(_); |
|
1067
|
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
# External scalar data (e.g., raw input from file or stream) |
|
1069
|
|
|
|
|
|
|
my $raw_input = 'plain text string'; |
|
1070
|
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
my ($result, $msg) = filter( |
|
1072
|
|
|
|
|
|
|
$raw_input, |
|
1073
|
|
|
|
|
|
|
\@required, |
|
1074
|
|
|
|
|
|
|
\@accepted, |
|
1075
|
|
|
|
|
|
|
[], 1, # Debug mode to see warning |
|
1076
|
|
|
|
|
|
|
); |
|
1077
|
|
|
|
|
|
|
# Result: { _ => 'plain text string' } |
|
1078
|
|
|
|
|
|
|
# Message includes: "Plain text argument accepted with key '_': 'plain text string'" |
|
1079
|
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
=head3 7. List Passed as Arrayref |
|
1081
|
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
##### Flattened key-value lists must be wrapped in an arrayref |
|
1083
|
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
# Filter rules defined once, reused |
|
1085
|
|
|
|
|
|
|
my @req_fields = qw(name email); |
|
1086
|
|
|
|
|
|
|
my @acc_fields = qw(city); |
|
1087
|
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
# External key-value list data must be wrapped in arrayref |
|
1089
|
|
|
|
|
|
|
my ($result, $msg) = filter( |
|
1090
|
|
|
|
|
|
|
[name => 'Eve', email => 'eve@example.com', city => 'Boston'], |
|
1091
|
|
|
|
|
|
|
\@req_fields, |
|
1092
|
|
|
|
|
|
|
\@acc_fields, |
|
1093
|
|
|
|
|
|
|
); |
|
1094
|
|
|
|
|
|
|
# Result: { name => 'Eve', email => 'eve@example.com', city => 'Boston' } |
|
1095
|
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
=head2 Special Parsing Keys |
|
1097
|
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
=head3 The C<'_'> Key |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
- Used for scalar input and single-element arrays |
|
1101
|
|
|
|
|
|
|
- Must be in accepted list or use wildcard C<['*']> |
|
1102
|
|
|
|
|
|
|
- Stores non-reference data that doesn't fit the hashref pattern |
|
1103
|
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
=head2 Parsing Status Messages (Always Provided) |
|
1105
|
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
These messages appear in the status message to inform you about structural transformations: |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=over 4 |
|
1109
|
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=item * **Odd array elements**: C<"Odd number of arguments provided; last element 'X' treated as flag"> |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
=item * **Scalar input**: C<"Plain text argument accepted with key '_': 'preview...'"> |
|
1113
|
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
=item * **Single array element**: C<"Plain text argument accepted with key '_': 'preview...'"> |
|
1115
|
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
=back |
|
1117
|
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
These messages help you understand when your input format differs from the standard hashref. |
|
1119
|
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
=head1 RETURN VALUES |
|
1121
|
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
Both L and L return data in a consistent format, regardless |
|
1123
|
|
|
|
|
|
|
of how the input was provided. The returned result's structure depends on context. |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
=head2 Return Structure |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=head3 Scalar Context |
|
1128
|
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
# Pre-defined filter rules |
|
1130
|
|
|
|
|
|
|
my @required = qw(name); |
|
1131
|
|
|
|
|
|
|
my @accepted = qw(email); |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
# External input data |
|
1134
|
|
|
|
|
|
|
my $input = { name => 'Alice', email => 'alice@example.com' }; |
|
1135
|
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
my $result = filter($input, \@required, \@accepted); |
|
1137
|
|
|
|
|
|
|
# Returns: hashref or undef on failure |
|
1138
|
|
|
|
|
|
|
if ($result) { |
|
1139
|
|
|
|
|
|
|
say $result->{name}; |
|
1140
|
|
|
|
|
|
|
} |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=head3 List Context (Recommended) |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
# Filter configuration |
|
1145
|
|
|
|
|
|
|
my @required = qw(name email); |
|
1146
|
|
|
|
|
|
|
my @accepted = qw(phone); |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
# External data source |
|
1149
|
|
|
|
|
|
|
my $input = get_external_data(); # e.g., from API, web form, etc. |
|
1150
|
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
my ($data, $message) = filter($input, \@required, \@accepted); |
|
1152
|
|
|
|
|
|
|
# Returns: (hashref, status_message) or (undef, error_message) |
|
1153
|
|
|
|
|
|
|
if ($data) { |
|
1154
|
|
|
|
|
|
|
say $data->{name}; |
|
1155
|
|
|
|
|
|
|
} else { |
|
1156
|
|
|
|
|
|
|
say "Error: $message"; |
|
1157
|
|
|
|
|
|
|
} |
|
1158
|
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
=head2 Success |
|
1160
|
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
On success, returns a hashref containing only the fields that passed filtering: |
|
1162
|
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
# Pre-configured filter rules |
|
1164
|
|
|
|
|
|
|
my @required_fields = qw(name email); |
|
1165
|
|
|
|
|
|
|
my @accepted_fields = qw(phone); |
|
1166
|
|
|
|
|
|
|
my @excluded_fields = qw(password spam); |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
# External data source (e.g., web form submission) |
|
1169
|
|
|
|
|
|
|
my $web_form_data = { |
|
1170
|
|
|
|
|
|
|
name => 'Alice', |
|
1171
|
|
|
|
|
|
|
email => 'alice@example.com', |
|
1172
|
|
|
|
|
|
|
password => 'secret', |
|
1173
|
|
|
|
|
|
|
spam => 'yes' |
|
1174
|
|
|
|
|
|
|
}; |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
my ($user, $msg) = filter( |
|
1177
|
|
|
|
|
|
|
$web_form_data, |
|
1178
|
|
|
|
|
|
|
\@required_fields, |
|
1179
|
|
|
|
|
|
|
\@accepted_fields, |
|
1180
|
|
|
|
|
|
|
\@excluded_fields, |
|
1181
|
|
|
|
|
|
|
); |
|
1182
|
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
# $user = { name => 'Alice', email => 'alice@example.com' } |
|
1184
|
|
|
|
|
|
|
# $msg = "Admitted" |
|
1185
|
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
# Notes: |
|
1187
|
|
|
|
|
|
|
# - 'name' and 'email' included (required and present) |
|
1188
|
|
|
|
|
|
|
# - 'password' and 'spam' excluded (removed even if present) |
|
1189
|
|
|
|
|
|
|
# - 'phone' not in input, so not included |
|
1190
|
|
|
|
|
|
|
# - 'spam' not in required/accepted, so ignored |
|
1191
|
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
=head2 Failure |
|
1193
|
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
On failure (missing required fields), returns C and an error message: |
|
1195
|
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
# Filter rules defined once, reused |
|
1197
|
|
|
|
|
|
|
my @required = qw(name email); |
|
1198
|
|
|
|
|
|
|
my @accepted = qw(phone); |
|
1199
|
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
# Incomplete external data |
|
1201
|
|
|
|
|
|
|
my $incomplete_data = { name => 'Bob' }; # email missing! |
|
1202
|
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
my ($data, $msg) = filter( |
|
1204
|
|
|
|
|
|
|
$incomplete_data, |
|
1205
|
|
|
|
|
|
|
\@required, |
|
1206
|
|
|
|
|
|
|
\@accepted, |
|
1207
|
|
|
|
|
|
|
); |
|
1208
|
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
# $data = undef |
|
1210
|
|
|
|
|
|
|
# $msg = "Unable to initialize without required arguments: 'email'" |
|
1211
|
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
=head2 Status Message Types |
|
1213
|
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
The status message provides feedback about the filtering operation: |
|
1215
|
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
=over 4 |
|
1217
|
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
=item * 1. **"Admitted"** - Success, all required fields present |
|
1219
|
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
=item * 2. **"Unable to initialize without required arguments: 'field1', 'field2'"** - Failure, missing required fields |
|
1221
|
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
=item * 3. **Parsing messages** - Information about input format transformations (always provided) |
|
1223
|
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
=item * 4. **Debug warnings** - Information about excluded/unrecognized fields (provided in debug mode only) |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
=back |
|
1227
|
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=head2 Consistent Output Format |
|
1229
|
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
B |
|
1231
|
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
# Filter rules (could be pre-defined constants) |
|
1233
|
|
|
|
|
|
|
my @req1 = qw(name); |
|
1234
|
|
|
|
|
|
|
my @acc1 = qw(); |
|
1235
|
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
# Hashref input → hashref output |
|
1237
|
|
|
|
|
|
|
my $hash_input = { name => 'Alice' }; |
|
1238
|
|
|
|
|
|
|
my $result1 = filter($hash_input, \@req1, \@acc1); |
|
1239
|
|
|
|
|
|
|
# → { name => 'Alice' } |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
# Arrayref input → hashref output |
|
1242
|
|
|
|
|
|
|
my @req2 = qw(name); |
|
1243
|
|
|
|
|
|
|
my @acc2 = qw(age); |
|
1244
|
|
|
|
|
|
|
my $array_input = ['name', 'Bob', 'age', 30]; |
|
1245
|
|
|
|
|
|
|
my $result2 = filter($array_input, \@req2, \@acc2); |
|
1246
|
|
|
|
|
|
|
# → { name => 'Bob', age => 30 } |
|
1247
|
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
# Scalar input → hashref output with '_' key |
|
1249
|
|
|
|
|
|
|
my @req3 = qw(); |
|
1250
|
|
|
|
|
|
|
my @acc3 = qw(_); |
|
1251
|
|
|
|
|
|
|
my $scalar_input = 'text'; |
|
1252
|
|
|
|
|
|
|
my $result3 = filter($scalar_input, \@req3, \@acc3); |
|
1253
|
|
|
|
|
|
|
# → { _ => 'text' } |
|
1254
|
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
This consistency makes the filtered data easy to use in downstream code without worrying about the original input format. |
|
1256
|
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=head1 DEBUG MODE |
|
1258
|
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
B This feature applies to the L and L only. The L does not support debug mode for maximum speed. |
|
1260
|
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
Debug mode provides additional information about field filtering during development: |
|
1262
|
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
my ($filtered, $msg) = filter( |
|
1264
|
|
|
|
|
|
|
$input, |
|
1265
|
|
|
|
|
|
|
['name'], |
|
1266
|
|
|
|
|
|
|
['email'], |
|
1267
|
|
|
|
|
|
|
['password'], |
|
1268
|
|
|
|
|
|
|
1, # Enable debug mode |
|
1269
|
|
|
|
|
|
|
); |
|
1270
|
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
Debug warnings (only shown when debug mode is enabled): |
|
1272
|
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
=over 4 |
|
1274
|
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
=item * Excluded fields that were removed |
|
1276
|
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
=item * Unrecognized fields that were ignored |
|
1278
|
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
=back |
|
1280
|
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
Parsing messages (always shown, regardless of debug mode): |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
=over 4 |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
=item * Plain text arguments accepted with key '_' |
|
1286
|
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
=item * Odd number of array elements converted to flags |
|
1288
|
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
=back |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
Parsing messages inform you about transformations the filter made to your input format. |
|
1292
|
|
|
|
|
|
|
These are always reported because they affect the structure of the returned data. |
|
1293
|
|
|
|
|
|
|
Debug warnings help you understand which fields were filtered out during development. |
|
1294
|
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
=head1 WILDCARD SUPPORT |
|
1296
|
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
=head2 Wildcard for Accepting Fields |
|
1298
|
|
|
|
|
|
|
|
|
1299
|
|
|
|
|
|
|
# Accept all fields |
|
1300
|
|
|
|
|
|
|
filter($input, [], ['*']); |
|
1301
|
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
# Accept all fields except specific exclusions |
|
1303
|
|
|
|
|
|
|
filter($input, [], ['*'], ['password', 'ssn']); |
|
1304
|
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
# Required + all other fields |
|
1306
|
|
|
|
|
|
|
filter($input, ['id', 'name'], ['*']); |
|
1307
|
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
# Wildcard can appear anywhere in accepted list |
|
1309
|
|
|
|
|
|
|
filter($input, [], ['name', 'email', '*']); # debugging: add '*' to see everything |
|
1310
|
|
|
|
|
|
|
filter($input, [], ['*', 'phone', 'address']); |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
=head2 Important Notes |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
=over 4 |
|
1315
|
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
=item * C<'*'> is B parameter> |
|
1317
|
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
=item * In C or C, C<'*'> is treated as a literal field name |
|
1319
|
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
=item * Empty C<[]> for accepted means "accept none beyond required" |
|
1321
|
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
=item * Multiple wildcards are redundant but harmless |
|
1323
|
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
=item * Exclusions are always removed before acceptance is processed |
|
1325
|
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
=back |
|
1327
|
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
=head2 Debugging Pattern |
|
1329
|
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
A common debugging pattern is to add C<'*'> to an existing accepted list: |
|
1331
|
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
# Normal operation |
|
1333
|
|
|
|
|
|
|
filter($input, ['id'], ['name', 'email']); |
|
1334
|
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
# Debugging - see all inputs |
|
1336
|
|
|
|
|
|
|
filter($input, ['id'], ['name', 'email', '*']); |
|
1337
|
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=head1 EXAMPLES |
|
1340
|
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
=head2 Form Field Filtering |
|
1342
|
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
use Params::Filter qw/filter/; # import filter() subroutine |
|
1344
|
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
# Define filtering rules (could be from config file) |
|
1346
|
|
|
|
|
|
|
my @required = qw(name email); |
|
1347
|
|
|
|
|
|
|
my @accepted = qw(phone city state zip); |
|
1348
|
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
# Apply to incoming web form data |
|
1350
|
|
|
|
|
|
|
my ($user_data, $status) = filter( |
|
1351
|
|
|
|
|
|
|
$form_submission, # Data from web form |
|
1352
|
|
|
|
|
|
|
\@required, |
|
1353
|
|
|
|
|
|
|
\@accepted, |
|
1354
|
|
|
|
|
|
|
); |
|
1355
|
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
if ($user_data) { |
|
1357
|
|
|
|
|
|
|
register_user($user_data); |
|
1358
|
|
|
|
|
|
|
} else { |
|
1359
|
|
|
|
|
|
|
show_error($status); |
|
1360
|
|
|
|
|
|
|
} |
|
1361
|
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
=head2 Reusable Filter for Multiple Data Sources |
|
1363
|
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
# Create filter once |
|
1365
|
|
|
|
|
|
|
my $user_filter = Params::Filter->new_filter({ |
|
1366
|
|
|
|
|
|
|
required => ['username', 'email'], |
|
1367
|
|
|
|
|
|
|
accepted => ['full_name', 'phone', 'bio'], |
|
1368
|
|
|
|
|
|
|
excluded => ['password', 'ssn', 'credit_card'], |
|
1369
|
|
|
|
|
|
|
}); |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
# Apply to multiple incoming datasets |
|
1372
|
|
|
|
|
|
|
my ($user1, $msg1) = $user_filter->apply($web_form_data); |
|
1373
|
|
|
|
|
|
|
my ($user2, $msg2) = $user_filter->apply($api_request_data); |
|
1374
|
|
|
|
|
|
|
my ($user3, $msg3) = $user_filter->apply($csv_import_data); |
|
1375
|
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
=head2 Environment-Specific Filtering |
|
1377
|
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
my $filter = Params::Filter->new_filter(); |
|
1379
|
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
if ($ENV{APP_MODE} eq 'production') { |
|
1381
|
|
|
|
|
|
|
# Strict: only specific fields allowed |
|
1382
|
|
|
|
|
|
|
$filter->set_required(['api_key']) |
|
1383
|
|
|
|
|
|
|
->set_accepted(['timeout', 'retries']) |
|
1384
|
|
|
|
|
|
|
->set_excluded(['debug_info', 'verbose']); |
|
1385
|
|
|
|
|
|
|
} else { |
|
1386
|
|
|
|
|
|
|
# Development: allow everything |
|
1387
|
|
|
|
|
|
|
$filter->set_required(['debug_mode']) |
|
1388
|
|
|
|
|
|
|
->accept_all(); |
|
1389
|
|
|
|
|
|
|
} |
|
1390
|
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
my ($config, $msg) = $filter->apply($incoming_config); |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
=head2 Security Filtering |
|
1394
|
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
# Remove sensitive fields from user input |
|
1396
|
|
|
|
|
|
|
my ($safe_data, $msg) = filter( |
|
1397
|
|
|
|
|
|
|
$user_input, |
|
1398
|
|
|
|
|
|
|
['username', 'email'], # required |
|
1399
|
|
|
|
|
|
|
['full_name', 'phone', 'bio'], # accepted |
|
1400
|
|
|
|
|
|
|
['password', 'ssn', 'api_key'], # excluded |
|
1401
|
|
|
|
|
|
|
); |
|
1402
|
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
# Result contains only safe fields |
|
1404
|
|
|
|
|
|
|
# password, ssn, api_key are removed even if provided |
|
1405
|
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
=head2 Dynamic Configuration from File |
|
1407
|
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
# Load filter rules from config file |
|
1409
|
|
|
|
|
|
|
my $config = decode_json(`cat filters.json`); |
|
1410
|
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
my $filter = Params::Filter->new_filter() |
|
1412
|
|
|
|
|
|
|
->set_required($config->{user_create}{required}) |
|
1413
|
|
|
|
|
|
|
->set_accepted($config->{user_create}{accepted}) |
|
1414
|
|
|
|
|
|
|
->set_excluded($config->{user_create}{excluded}); |
|
1415
|
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
# Apply to incoming data |
|
1417
|
|
|
|
|
|
|
my ($filtered, $msg) = $filter->apply($api_data); |
|
1418
|
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
=head2 Data Segregation for Multiple Subsystems |
|
1420
|
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
B |
|
1422
|
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
An application may need to handle incoming data from varying sources and prepare it for the same downstream processing. Filtering rules can be tailored to assure that only usable data is passed on. |
|
1424
|
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
An application may need to split incoming data into subsets for different handlers or storage locations. Multiple filters may be applied to a given input, and each filter extracts only the fields needed for its specific purpose, simplifying next steps and improving security through compartmentalization. |
|
1426
|
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
This example demonstrates how Params::Filter can integrate incoming data and segregate the yielded data for multiple outputs. |
|
1428
|
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
# Three different Subscription forms collect overlapping data: |
|
1430
|
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
# Main subscription signup form collects: |
|
1432
|
|
|
|
|
|
|
# name, email, zip, |
|
1433
|
|
|
|
|
|
|
# user_id, password, credit_card_number, subscription_term |
|
1434
|
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
# Subscription form with full profile collects: |
|
1436
|
|
|
|
|
|
|
# name, email, address, city, state, zip, |
|
1437
|
|
|
|
|
|
|
# user_id, password, credit_card_number, subscription_term, |
|
1438
|
|
|
|
|
|
|
# phone, occupation, position, education |
|
1439
|
|
|
|
|
|
|
# alt_card_number, billing_address, billing_zip |
|
1440
|
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
# Promo subscription form collects: |
|
1442
|
|
|
|
|
|
|
# name, email, zip, subscription_term, |
|
1443
|
|
|
|
|
|
|
# user_id, password, credit_card_number, promo_code |
|
1444
|
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
my $data = $webform->input(); # From any of the above |
|
1446
|
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
# Three different uses for the data: |
|
1448
|
|
|
|
|
|
|
# Personal contact info to be stored |
|
1449
|
|
|
|
|
|
|
# Subscription business to be transacted |
|
1450
|
|
|
|
|
|
|
# Authentication credentials to be encrypted and stored |
|
1451
|
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
# Personal data filter - general user info (no sensitive data) |
|
1453
|
|
|
|
|
|
|
my $person_filter = Params::Filter->new_filter({ |
|
1454
|
|
|
|
|
|
|
required => ['name', 'user_id', 'email'], |
|
1455
|
|
|
|
|
|
|
accepted => ['address', 'city', 'state', 'zip', 'phone', |
|
1456
|
|
|
|
|
|
|
'occupation', 'position', 'education'], |
|
1457
|
|
|
|
|
|
|
excluded => ['password', 'credit_card_number'], |
|
1458
|
|
|
|
|
|
|
}); |
|
1459
|
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
# Business data filter - subscription and billing info |
|
1461
|
|
|
|
|
|
|
my $biz_filter = Params::Filter->new_filter({ |
|
1462
|
|
|
|
|
|
|
required => ['user_id', 'name', 'subscription_term', 'credit_card_number', 'zip'], |
|
1463
|
|
|
|
|
|
|
accepted => ['alt_card_number', 'billing_address', 'billing_zip', 'promo_code'], |
|
1464
|
|
|
|
|
|
|
excluded => ['password'], |
|
1465
|
|
|
|
|
|
|
}); |
|
1466
|
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
# Authentication data filter - only credentials |
|
1468
|
|
|
|
|
|
|
my $auth_filter = Params::Filter->new_filter({ |
|
1469
|
|
|
|
|
|
|
required => ['user_id', 'password'], |
|
1470
|
|
|
|
|
|
|
accepted => [], |
|
1471
|
|
|
|
|
|
|
excluded => [], |
|
1472
|
|
|
|
|
|
|
}); |
|
1473
|
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
# Apply all filters to the same web form submission |
|
1475
|
|
|
|
|
|
|
my ($person_data, $pmsg) = $person_filter->apply($data); |
|
1476
|
|
|
|
|
|
|
my ($biz_data, $bmsg) = $biz_filter->apply($data); |
|
1477
|
|
|
|
|
|
|
my ($auth_data, $amsg) = $auth_filter->apply($data); |
|
1478
|
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
# One way to use the filter results: |
|
1480
|
|
|
|
|
|
|
# Set the requirement that all filtering requirements must be met |
|
1481
|
|
|
|
|
|
|
# with data provided by any of the three webform sources: |
|
1482
|
|
|
|
|
|
|
unless ($person_data && $biz_data && $auth_data) { |
|
1483
|
|
|
|
|
|
|
return "Unable to add user: " . |
|
1484
|
|
|
|
|
|
|
join ' ' => grep { $_ ne 'Admitted' } ($pmsg, $bmsg, $amsg); |
|
1485
|
|
|
|
|
|
|
} |
|
1486
|
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
# Route each filtered data subset to appropriate handler |
|
1488
|
|
|
|
|
|
|
$self->add_user( $person_data ); # User profile |
|
1489
|
|
|
|
|
|
|
$self->set_subscription( $biz_data ); # Billing system |
|
1490
|
|
|
|
|
|
|
$self->set_password( $auth_data ); # Auth system |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
B: The original C<$data> is not modified during filtering, so the same data can be safely processed by multiple filters. |
|
1493
|
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
1495
|
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
=over 4 |
|
1497
|
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
=item * L - Full-featured parameter validation |
|
1499
|
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
=item * L - Data structure validation |
|
1501
|
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
=item * L - JSON Schema validation |
|
1503
|
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
=back |
|
1505
|
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1507
|
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
Bruce Van Allen |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
=head1 LICENSE |
|
1511
|
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
This module is licensed under the same terms as Perl itself. |
|
1513
|
|
|
|
|
|
|
See L. |
|
1514
|
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
1516
|
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
Copyright (C) 2026, Bruce Van Allen |
|
1518
|
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
=cut |
|
1520
|
|
|
|
|
|
|
|
|
1521
|
|
|
|
|
|
|
1; |