Declare::Constraints::Simple::Library::Operators - Operators

Declare-Constraints-Simple documentation Contained in the Declare-Constraints-Simple distribution.

Index

Code Index:

NAME

Top

Declare::Constraints::Simple::Library::Operators - Operators

SYNOPSIS

Top

  # all hast to be valid
  my $and_constraint = And( IsInt,
                            Matches(qr/0$/) );

  # at least one has to be valid
  my $or_constraint = Or( IsInt, HasLength );

  # only one can be valid
  my $xor_constraint = XOr( IsClass, IsObject );

  # reverse validity
  my $not_an_integer = Not( IsInt );

  # case valid, validate 'bar' key depending on 'foo' keys value
  my $struct_prof = 
    And( IsHashRef,
         CaseValid( OnHashKeys(foo => IsEq("FooArray")),
                      OnHashKeys(bar => IsArrayRef),
                    OnHashKeys(foo => IsEq("FooHash")),
                      OnHashKeys(bar => IsHashRef) ));

DESCRIPTION

Top

This module contains the frameworks operators. These constraint like elements act on the validity of passed constraints.

OPERATORS

Top

And(@constraints)

Is true if all passed @constraints are true on the value. Returns the result of the first failing constraint.

Or(@constraints)

Is true if at least one of the passed @contraints is true. Returns the last failing constraint's result if false.

XOr(@constraints)

Valid only if a single one of the passed @constraints is valid. Returns the last failing constraint's result if false.

Not($constraint)

This is valid if the passed $constraint is false. The main purpose of this operator is to allow the easy reversion of a constraint's trueness.

CaseValid($test, $conseq, $test2, $conseq2, ...)

This runs every given $test argument on the value, until it finds one that returns true. If none is found, false is returned. On a true result, howver, the corresponding $conseq constraint is applied to the value and it's result returned. This allows validation depending on other properties of the value:

  my $flexible = CaseValid( IsArrayRef,
                              And( HasArraySize(1,5), 
                                   OnArrayElements(0 => IsInt) ),
                            IsHashRef,
                              And( HasHashElements(qw( head tail )),
                                   OnHashKeys(head => IsInt) ));

Of course, you could model most of it probably with the other operators, but this is a bit more readable. For default cases use ReturnTrue from Declare::Constraints::Simple::Library::General as test.

SEE ALSO

Top

Declare::Constraints::Simple, Declare::Constraints::Simple::Library

AUTHOR

Top

Robert 'phaylon' Sedlacek <phaylon@dunkelheit.at>

LICENSE AND COPYRIGHT

Top

This module is free software, you can redistribute it and/or modify it under the same terms as perl itself.

Declare-Constraints-Simple documentation Contained in the Declare-Constraints-Simple distribution. 
package Declare::Constraints::Simple::Library::Operators;
use warnings;
use strict;

use Declare::Constraints::Simple-Library;

use Carp::Clan qw(^Declare::Constraints::Simple);


constraint 'And',
    sub {
        my @vc = @_;
        return sub {
            for (@vc) {
                my $r = $_->($_[0]);
                return $r unless $r->is_valid;
            }
            return _true;
        };
    };


constraint 'Or',
    sub {
        my @vc = @_;
        return sub {
            my $last_r;
            for (0 .. $#vc) {
                my $v = $vc[$_];
                my $r = $v->($_[0]);
                return _true if $r->is_valid;
                return $r if $_ == $#vc;
            }
            return _false('No constraints');
        };
    };


constraint 'XOr',
    sub {
        my @vc = @_;
        return sub {
            my $m = 0;
            for (@vc) {
                my $r = $_->($_[0]);
                $m++ if $r->is_valid;
            }
            return _result(($m == 1), sprintf 'Got %d true returns', $m);
        };
    };


constraint 'Not',
    sub {
        my ($c) = @_;
        croak '\'Not\' only accepts only a constraint as argument'
            if defined $c and not ref($c) eq 'CODE';
        return sub {
            return _true unless $c;
            my $r = $c->($_[0]);
            return _false('Constraint returned true') if $r->is_valid;
            return _true;
        };
    };


constraint 'CaseValid',
    sub {
        my @defs = @_;
        my ($c, @cases);
        while (my $test = shift @defs) {
            $c++;
            croak "CaseValid test nr $c is not a constraint"
                unless ref($test) eq 'CODE';

            my $conseq = shift @defs;
            croak "CaseValid consequence nr $c is not a constraint"
                unless ref($test) eq 'CODE';

            push @cases, [$test, $conseq];
        }

        return sub {
            for my $case (@cases) {
                my ($test, $conseq) = @$case;
                next unless $test->($_[0])->is_valid;
                return $conseq->($_[0]);
            }
            _false('No matching case');
        };
    };


1;