File Coverage

blib/lib/Tie/Constrained.pm
Criterion Covered Total %
statement 27 46 58.7
branch 7 16 43.7
condition 8 13 61.5
subroutine 11 22 50.0
pod 10 10 100.0
total 63 107 58.8


line stmt bran cond sub pod time code
1             package Tie::Constrained;
2              
3             =head1 NAME
4              
5             Tie::Constrained - Auto pre-validation of changes to variables
6              
7             =cut
8              
9              
10 3     3   73330 use Exporter;
  3         6  
  3         143  
11 3     3   17 use Carp;
  3         6  
  3         266  
12              
13 3         362 use vars qw/
14             $VERSION
15             $VERBOSE
16             $STRICT
17             @ISA
18             @EXPORT
19             @EXPORT_OK
20             %EXPORT_TAGS
21 3     3   16 /;
  3         10  
22              
23 3     3   115 BEGIN { @ISA = qw/Exporter/; }
24              
25 3         1919 use Errno qw/
26             EINVAL
27             EDOM
28             ERANGE
29 3     3   2722 /;
  3         4150  
30              
31             $VERSION = '0.03';
32 0     0 1 0 sub VERSION () {$VERSION}
33              
34             $STRICT = 0;
35              
36             =head1 SYNOPSIS
37              
38             Following the usual convention for optional arguments,
39              
40             use Tie::Constrained
41             [qw/[:all] [:dummy] [:diagnostic] [:error] [subname ...]/];
42              
43             Tie::Constrained aggregates a tied scalar variable with a validation test and a failure handler. The general syntax for the tie is:
44              
45             [$var_ctl =] tie $var, 'Tie::Constrained'[,
46             [ \&validator [, $initval [, \&fail_handler]]]
47             | [ $hashref ]
48             | [ $TC_obj ]];
49              
50             A constructor is available for unbound Tie::Constraint objects
51              
52             my $TC_obj = Tie::Constrained->new (
53             [ \&validator [, $initval [, \&fail_handler]]]
54             | [ $hashref ]
55             | [ $TC_obj ] );
56              
57             There is a concise wrapper for the tie,
58              
59             [$var_ctl =] constrain( $var,
60             [ \&validator [, $initval [, \&fail_handler]]]
61             | [ $hashref ]
62             | [ $TC_obj ] );
63              
64             Validity tests should expect a single argument, the proposed new value for the tied variable. They should return true if the value is to be accepted, false if the failure handler is to be called. The passed value is modifiable.
65              
66             Failure handlers should expect three arguments -- a reference to the validator which failed, the value it failed with, and an error number which is assigned to $!. If they return at all, they should return false if the value is to be rejected, true if it is now to be accepted. The passed value is modifiable.
67              
68             =cut
69              
70             @EXPORT = ();
71              
72             @EXPORT_OK = qw/
73             EINVAL
74             EDOM
75             ERANGE
76             notest
77             deny
78             death
79             warning
80             ignore
81             allow
82             eraser
83             constrain
84             detaint
85             /;
86              
87             %EXPORT_TAGS = (
88             diagnostic => [qw/death warnings/],
89             dummy => [qw/notest deny ignore allow/],
90             all => [@EXPORT_OK],
91             error => [qw/EINVAL EDOM ERANGE/],
92             );
93              
94             =head1 DESCRIPTION
95              
96             C is a simple tie class for constraining the values a variable tied to it may take. The commonest use for that is to validate data. The tied interface provides the unique ability to wedge the validation test into assignment and mutator operations, prior to changing the variable's value. The effect is to ensure that the tied variable is I validated by the associated test.
97              
98             In the tie statement,
99              
100             $foo_ctl = tie $foo, 'Tie::Constrained',
101             \&validator, $initval, \&fail_handler;
102              
103             The C function should be designed to return true on success, false otherwise. It should expect the value to be tested as its first argument.
104             If C<$initval> is given, it will be tested by C before the value is committed.
105             The C is the action to be taken when C returns false. If the failure handler returns, its value should be true if the proposed new value is to be accepted, false if it is to be ignored. Fail handlers are called with three arguments. The first is a coderef to the test which failed. The second is the value it tested. The third is an error number which is assigned to $! in the handler.
106             User tests and handlers may make whatever use thay wish of the arguments, but $! should be set to the third argument. Value arguments are modifiable through their alias in C<@_>, allowing tests and handlers to modify them before committal. That capability should be treated with respect, it is prone to high obfuscation.
107             Avoid setting C<$var_ctl> unless you really need to modify the tie on the fly. Testing the return value for logical truth is sufficient to check for success of the tie.
108             Since a C object may be used as an initializer in the C call, it is convenient to be able to produce them independent of any binding. That is provided by the C class method.
109            
110             =head2 Philosophy
111              
112             C is a low level module, and most of the interface is designed to remind the user of that fact. That design choice is deliberate. It is also designed to be relentlessly Object Oriented, though not in the way that equates library files and modules and classes and types.
113             The C mechanism constructs an object instance which, to the user, is simply a variable. The interface to the object is all the universe of perl operators and functions which may be applied to that variable. The underlying object aggregates the value of the variable, a validity test, and a handler for failure of the test. That is the C object proper.
114             The C and C methods of the C object are sufficient to hook into every use of the tied variable by perl. That allows us to place our own conditions on what uses we will accept. Perl itself does all the rest of the work. To restrict assignment or a mutator operator, we don't need to overload the operators or write code around each use of them. Our tied wedge into perl is sufficient to make it all happen automatically.
115              
116             To use C effectively, you should understand how it works. That is the subject of the next section,
117              
118             =head2 TieGuts
119              
120             The C method of a tied class is called when perl has a value to be stored in the tied variable. C must take care of storing the value where the tied object expects it, and must return a value which perl sees as the value of the operation. That value may be passed along in chained assignments or returned from a sub, among other possibilities.
121              
122             C<&Tie::Constrained::STORE> does not automatically store the value. It first tests the value with its validator function. If that returns true, the value is stored. If it returns false, the object's failure function is called. That function may not return at all if it throws. If it returns true, the value is stored anyway (C may have modified it). If it returns false, no value is stored and the tied variable remains unmodified. In pseudocode,
123              
124             sub STORE {
125             return storage = test or fail ? value : storage;
126             }
127              
128             That simple code is capable of many effects since both C and C are capable of modifying C, and C has enough information to retest.
129              
130             Similarly, perl calls the tied class's C method when it wishes to know the value of the tied variable. By default, C does not test the value in storage. That is so a tie may be left uninitialized and yet accept a value from a mutator (mutators call C first to get the value they are to work on). If you want a more stringent tie, where the value must always pass the test, you may set the C<$STRICT> flag and every C will apply the test or fail before returning the value. In pseudocode, C looks like this:
131              
132             sub FETCH {
133             fail if strict and not test storage;
134             return storage;
135             }
136              
137             The C class method is the constructor for the tie class. After sorting out what kind of arguments it is given, its behavior is similar to C as far as the application of C or C to the initial value is concerned. The C class method for constructing an unbound C is just an alias to C. Unbound objects are used as templates for initializing ties as arguments to C, C, or the C wrapper.
138              
139             C does not make use of C or C. Subclasses should do whatever they need with those.
140              
141              
142             =head2 Subclassing C
143              
144             C is intended as a fully usable class with an interface which is low-level enough to provide a flexible way of highjacking the mutation of variables. If users wish to have a more specialized and restrictive constraint class, Tie::Constrained is constructed to work as a base class, providing the framework for that.
145              
146             The default fail handler dies loud in Tie::Constrained. If by default you would prefer to silently ignore bad mutations, you can subclass C like this:
147              
148             package Tie::Constrained::Quiet;
149             use Tie::Constrained;
150             use vars qw/@ISA/;
151             @ISA = qw/Tie::Constrained/;
152             *failure = \&ignore;
153             1;
154              
155             If you just wish to ensure that your constraints are always strict and can't be subverted without notice by tie object tricks,
156              
157             package Tie::Constrained::Strict;
158             use Tie::Constrained;
159             use vars qw/@ISA/;
160             @ISA = ('Tie::Constrained');
161             *STRICT = \1;
162             1;
163              
164             Similarly, $VERBOSE may be set for a debugging environment.
165              
166             The C or C functions may be overridden with user code to replace the default test or fail handlers.
167              
168             =head2 Tests and Handlers
169              
170             's conventions for tests and fail handlers are as follows.
171              
172             For tests:
173              
174             =over
175              
176             =item *
177              
178             A test is called with one argument, the value to be tested.
179              
180             =item *
181              
182             The value in the argument list is modifiable, an alias to a variable in the caller.
183              
184             =item *
185              
186             Modifications to the value through its alias will be seen in the caller and will be effective throughout the rest of the caller's processing.
187              
188             =item *
189              
190             If C<$STRICT> is set, C calls the test on the stored value, not a copy of it. Tests which modify values take note.
191              
192             =item *
193              
194             If the test returns false, a call to the fail handler follows immediately.
195              
196             =item *
197              
198             If the test returns true, the fail handler is never called and the caller's processing takes the test to have succeeded.
199              
200             =back
201              
202             For C handlers:
203              
204             =over
205              
206             =item *
207              
208             A fail handler is called with three arguments, a code reference to the test which triggered the call, an alias to the value it triggered on, and an error identifier.
209              
210             =item *
211              
212             The test reference is passed as a convenience for advanced fail handlers. It may be ignored, used as an identifier, or called to retest a modified value.
213              
214             =item *
215              
216             As with tests, the value alias is modifiable, and modifications will be effective in the caller if the handler returns.
217              
218             =item *
219              
220             The error identifier is, in base C, a number from L. A non-returning handler will typically set C<$!> to this value, though it could also be used to guide a recovery attempt.
221              
222             =item *
223              
224             A fail handler may throw instead of returning. That is the default behavior in Tie::Constrained, where no user handler is specified.
225              
226             =item *
227              
228             If the fail handler returns true, the value (possibly modified) will be accepted by STORE and TIESCALAR as a value for the tied variable and by FETCH as a valid return.
229              
230             =item *
231              
232             If the fail handler returns false, the tied variable remains unchanged.
233              
234             =back
235              
236             Good taste and good sense should prevail in designing a constrained variable. Simple handlers of the kind shown below in the examples are robust and predictable. Clearly, this mechanism has room for plenty of exotic behaviors, though. There is lots of room to experiment.
237              
238             =head2 Included Tests and Handlers
239              
240             There are a few pre-packaged tests and failure handlers available to Tie::Constrained. They are accessible by importing through the arguments to C. The functions are listed in the L section, and the export tags in L
241              
242             =head1 FUNCTIONS
243              
244             =head2 Class Methods
245              
246             =over
247              
248             =item C
249              
250             Reports the version number of C.
251              
252             =item C
253              
254             Constructor for an unbound Tie::Constructor object. The arguments follow the same syntax as those following the package name in the C call. Typical usage,
255              
256             my $all_vowels =
257             Tie::Constrained->new(sub {$_[0] !~ /[^aeiouy]/});
258              
259             The returned C object may be used to initialize multiple vowel strings. The constructors perform a deep copy of the object, so subsequent changes are not reflected in earlier uses.
260              
261             =item C
262              
263             A convenience function which wraps a C binding. Ties C<$var> to the C object. Given a bound or unbound C object, C admits the nice syntax,
264              
265             constrain( my $word, $all_vowels) or die $!;
266              
267             =back
268              
269             =head2 Stock Validators
270              
271             Validators take one argument and return true if the argument is to be committed to the tied variable. A false return triggers the fail handler. Values written to C<$_[0]> will be seen and used by the caller. Treat that with delicacy, forget it, or have fun with it.
272             C includes two dummy validators described below.
273              
274             =over
275              
276             =item C
277              
278             Null validator. Every modification is accepted. The fail handler is never called. This is the default test.
279              
280             =cut
281              
282             # dummy validators
283 0     0 1 0 sub notest { 1 }
284              
285              
286             =item C
287              
288             No modification is accepted with this validator. The fail handler is always called.
289              
290             =cut
291              
292 0     0 1 0 sub deny { 0 }
293              
294             =item C
295              
296             This is not a validator itself, but is included as a useful componemt of validators. Called on the caller's argument list, it will detaint the first argument. C always returns true. Example validator for an http URI from a tainted source:
297              
298             use Regexp::Common 'URI';
299             sub is_http { $_[0] =~ /^$RE{URI}{HTTP}$/ and &detaint, 1 }
300              
301             =back
302              
303             =cut
304              
305             sub detaint {
306 0     0 1 0 $_[0] = () = $_[0] =~ /^(.*)$/s;
307 0         0 1;
308             }
309              
310             =head2 Stock Fail Handlers
311              
312             Fail handlers are called with three arguments. The first is a reference to the test which triggered the failure. It may be used to test repair attempts, select actions, or whatever else your imagination can devise.
313             The second argument is the value which failed. As with tests, and with the same caveats, that value is modifiable through C<$_[1]> and changes to it will be effective in the caller.
314             The third argument is an error number. The convention is to take them by name from Errno.pm, and assign them to C<$!> in the handler.
315             C is equipped with four stock fail handlers. The default, C, dies loudly through C<&Carp::croak> or C<&Carp::confess>. That is intended to support an exception style of error handling.
316              
317             =over
318              
319             =item C
320              
321             Croaks with an error message from the lowest level caller. If $VERBOSE is true, the message contains a full stack trace (C). The default fail handler, C, is an alias to C for its effect as an exception with respect to C.
322              
323             =cut
324              
325             sub death {
326 6     6 1 93 (my ($try, $val), $!) = @_;
327 6 50       858 ($VERBOSE ? \&confess : \&croak)->('Constraint violation: ');
328             }
329              
330             =item C
331              
332             Issues C with respect to the loweat level caller. If $VERBOSE is true, warns with a full stack trace.
333              
334             =cut
335              
336             sub warning {
337 0     0 1 0 (my ($try, $val), $!) = @_;
338 0 0       0 ($VERBOSE ? \&cluck : \&carp)->('Constraint violation: ');
339 0         0 0;
340             }
341              
342              
343             =item C
344              
345             Any modification passed to this handler is silently ignored. The old value of the tied variable is retained. In chained assignments, the old value will be passed along to the left.
346              
347             =cut
348              
349 0     0 1 0 sub ignore { $! = undef }
350              
351             =item C
352              
353             This handler overrides any validation test and allows the tied variable to take the proposed value.
354              
355             =cut
356              
357             sub allow {
358 0     0 1 0 $! = undef;
359 0         0 1;
360             }
361              
362             =item C
363              
364             Responds to a failed test by clearing error and undefining value of the tied variable.
365              
366             =cut
367              
368 0     0 1 0 sub eraser { not $! = $_[1] = undef; }
369              
370             BEGIN {
371              
372             =item C
373              
374             This is the default validity test for C and those subclasses which honor its tie conventions. In the base class, where it is expected that each tie binding will carry its own test, it is an alias to the C function.
375              
376             =cut
377              
378 3     3   10 *valid = \¬est; # default test
379              
380             =item C
381              
382             The default fail handler for C and its faithful subclasses. In C, it is an alias to C, which throws a loud exception.
383              
384             =cut
385              
386 3         1100 *failure = \&death; # default fail
387             }
388              
389             =back
390              
391             =cut
392              
393             sub TIESCALAR {
394 4     4   724 my $class = shift;
395              
396 0         0 my ($try, $val, $out) =
397             ref $_[0] ne 'CODE' ?
398 4 50       17 @{$_[0]}{qw/test value fail/} :
399             @_;
400              
401 4 50 66     16 $try->($val) or ($out?$out:\&failure)->($try, $val, EINVAL)
    100          
402             if defined $val;
403              
404 3   50     42 bless {
      50        
405             test => $try || \&valid,
406             value => $val,
407             fail => $out || \&failure
408             }, $class;
409             }
410              
411             sub STORE {
412 8     8   4966 my ($self, $value) = @_;
413 8 50 100     23 $self->{value} =
414             $self->{'test'}->($value) ||
415             $self->{'fail'}->($self->{'test'}, $value, EINVAL) ?
416             $value : $self->{'value'};
417             }
418              
419             sub FETCH {
420 8     8   1870 my $self = shift;
421 0         0 &{$self->{'fail'}}($self->{'test'}, $self->{'value'}, EINVAL)
  0         0  
422             if $STRICT
423 8 50 33     25 and ! &{$self->{'test'}}($self->{'value'});
424 8         35 $self->{'value'}
425             }
426              
427 0     0     sub DESTROY {}
428              
429 0     0     sub UNTIE {}
430              
431 3     3   396 BEGIN { *new = \&TIESCALAR }
432              
433             sub constrain {
434 0 0   0 1   return unless $_[1]->isa('Tie::Constrained');
435 0           tie $_[0],
436             ref($_[1]),
437             $_[1];
438             }
439              
440             =head2 EXPORTS
441              
442             All the tests and fail handlers listed above are ordinary functions, not class or instance methods. They may all be imported from C by name. There are no default exports.
443              
444             There are a few export tags which identify groups of functions. They are:
445              
446             =over
447              
448             =item C<:diagnostic>
449              
450             C, C,
451              
452             =item C<:dummy>
453              
454             C, C, C, C
455              
456             =item C<:all>
457              
458             C, C, C, C, C, C, C, C, C, C, C
459              
460             Everything in the @EXPORT_OK list
461              
462             =item C<:error>
463              
464             C, C, C (all imported to C from C)
465              
466             =back
467              
468             =head1 EXAMPLES
469              
470             Here are a few examples of C at work.
471              
472             We'll first look at a few cases where we want a string to contain nothing but vowels.
473              
474             tie my $vowels, Tie::Constrained =>
475             sub { not $_[0] =~ /[^aeiouy]/ },
476             'ioyou'
477             sub { $! = undef };
478              
479             In that example, the fail handler squashes errors and returns false, causing invalid values to be silently ignored. The tied variable C<$vowels> will retain its old value.
480              
481             The argument to a validation function is modifiable, opening the way for something more than validation.
482              
483             tie my $cons_killer, Tie::Constrained =>
484             sub { $_[0] =~ tr/aeiouy//cd; 1 };
485             $cons_killer = "googleplex";
486              
487             which results in C<$cons_killer> taking the value C, much to the confusion of some future maintainer. Increment operators have an interesting effect on $cons_killer. Those tricks may best be left out of unobfuscated code.
488              
489             A case where argument modifiability is more defensible:
490              
491             tie my $pristine, Tie::Constrained =>
492             sub { $_[0] !~ /[^aeiouy]/ and &detaint };
493              
494             There, we modify the taint property of a copy of the data, not the value itself. The C function is exportable from C. Note that the old-style sub call is intended here, though C would have done as well.
495              
496             Fail handlers are also capable of modifying the proposed value for a tied variable:
497              
498             tie my $all_or_nothing, Tie::Consrained =>
499             sub { $_[0] =~ /$re/ },
500             undef,
501             sub { $_[0] = undef; 1 };
502              
503             With that, a failed assignment or mutation will leave the tied variable undefined.
504              
505             Other modules are a rich source of tests. Suppose we obtain what is supposed to be an http URI from an untrusted source. Drawing on C, we say,
506              
507             use Tie::Constrained qw/detaint/;
508             use Regexp::Common qw/URI/;
509             tie my $address, Tie::Constrained =>
510             sub { $_[0] =~ /^$RE{URI}{HTTP}$/ and &detaint }
511             undef,
512             sub { $_[0] = undef; 1 };
513              
514              
515              
516             Tie::Constrained is not limited to the values of ordinary scalars. Here is an example where variable is constrained to be a CGI query object. This usage also does the error handling for the CGI constructor.
517              
518             use CGI;
519             tie my $query, Tie::Constrained =>
520             sub { $_[0]->isa('CGI') },
521             CGI->new;
522              
523             That is error-handling that keeps on protecting. Later assignment to any value not a CGI instance will carry the death penalty.
524              
525             =head1 PREREQUISITES
526              
527             In use, C depends on
528              
529             =over
530              
531             =item C
532              
533             =item C
534              
535             =item C
536              
537             =back
538              
539             All are from the perl core.
540              
541             Pre-installation testing demands:
542              
543             =over
544              
545             =item C
546              
547             =item C
548              
549             =item C
550              
551             =back
552              
553             Some tests use other modules. Those tests will be skipped if the needed modules are not available.
554              
555             =head1 TODO
556              
557             I am uneasy about the design of C under $STRICT. Its current behavior should not be regarded as a stable api yet. The version 1.0 release will not happen until that is resolved.
558              
559             C<$STRICT> should be a property of each object, not a global flag. That is another goal for version 1.0.
560              
561             I would like to expand the L section and split it off to its own cookbook pod, with an accompanying directory of example code..
562              
563             =head1 AUTHOR
564              
565             Zaxo, C<< >>
566              
567             =head1 BUGS
568              
569             Please report any bugs or feature requests to
570             C, or through the web interface at
571             L. I will be notified, and then you'll automatically
572             be notified of progress on your bug as I make changes.
573              
574             =head1 ACKNOWLEDGEMENTS
575              
576             Joshua ben Jore (C<< >>), for the initial packaging and test suite, testing and patches for compatibility with older perl, thanks!
577              
578             The Monks at the Monastery, L, who saw it first.
579              
580             =head1 COPYRIGHT & LICENSE
581              
582             Copyright Zaxo (Tom Leete), 2004,2005, All Rights Reserved.
583              
584             This program is free software; you can redistribute it and/or modify it
585             under the same terms as Perl itself.
586              
587             =cut
588              
589             1;