File Coverage

blib/lib/Venus/Constraint.pm

Criterion	Covered	Total	%
statement	49	52	94.2
branch	12	16	75.0
condition	2	3	66.6
subroutine	13	14	92.8
pod	7	9	77.7
total	83	94	88.3

package Venus::Constraint;

use 5.018;

use strict;
use warnings;

use Venus::Class 'attr', 'base', 'with';

use Venus::Check;

base 'Venus::Kind::Utility';

with 'Venus::Role::Buildable';

# ATTRIBUTES

attr 'on_eval';

# BUILDERS

sub build_arg {
  my ($self, $data) = @_;

  return {
    on_eval => ref $data eq 'ARRAY' ? $data : [$data],
  };
}

sub build_args {
  my ($self, $data) = @_;

  $data->{on_eval} = [] if !$data->{on_eval};

  return $data;
}

# METHODS

sub accept {
  my ($self, $name, @args) = @_;

  if (!$name) {
    return $self;
  }
  if ($self->check->can($name)) {
    $self->check->accept($name, @args);
  }
  else {
    $self->check->identity($name, @args);
  }
  return $self;
}

sub check {
  my ($self, @args) = @_;

  $self->{check} = $args[0] if @args;

  return $self->{check} ||= Venus::Check->new;
}

sub clear {
  my ($self) = @_;

  @{$self->on_eval} = ();

  $self->check->clear;

  return $self;
}

sub ensure {
  my ($self, @code) = @_;

  push @{$self->on_eval}, @code;

  return $self;
}

sub eval {
  my ($self, $data) = @_;

  my $result = false;

  if (!($result = $self->check->eval($data))) {
    return $result;
  }

  for my $callback (@{$self->on_eval}) {
    local $_ = $data;
    $result = $self->$callback($data) ? true : false;
    last if !$result;
  }

  return $result;
}

sub evaler {
  my ($self) = @_;

  return $self->defer('eval');
}

sub result {
  my ($self, $data) = @_;

  return $self->eval($data);
}

1;



=head1 NAME

Venus::Constraint - Constraint Class

=cut

=head1 ABSTRACT

Constraint Class for Perl 5

=cut

=head1 SYNOPSIS

  package main;

  use Venus::Constraint;

  my $constraint = Venus::Constraint->new;

  # $constraint->accept('float');

  # $constraint->ensure(sub{$_ > 1});

  # $constraint->result(1.01);

  # true

=cut

=head1 DESCRIPTION

This package provides a mechanism for evaluating type constraints on data.
Built-in type constraints are handled via L.

=cut

=head1 INHERITS

This package inherits behaviors from:

L

=cut

=head1 INTEGRATES

This package integrates behaviors from:

L

=cut

=head1 METHODS

This package provides the following methods:

=cut

=head2 accept

  accept(string $name, any @args) (Venus::Constraint)

The accept method registers a condition via L based on the arguments
provided. The built-in types are defined as methods in L.

I>

=over 4

=item accept example 1

  # given: synopsis

  package main;

  $constraint = $constraint->accept('float');

  # bless(..., "Venus::Constraint")

  # $constraint->result;

  # false

  # $constraint->result(1.01);

  # true

=back

=over 4

=item accept example 2

  # given: synopsis

  package main;

  $constraint = $constraint->accept('number');

  # bless(..., "Venus::Constraint")

  # $constraint->result(1.01);

  # false

  # $constraint->result(1_01);

  # true

=back

=over 4

=item accept example 3

  # given: synopsis

  package Example1;

  sub new {
    bless {};
  }

  package Example2;

  sub new {
    bless {};
  }

  package main;

  $constraint = $constraint->accept('object');

  # bless(..., "Venus::Constraint")

  # $constraint->result;

  # false

  # $constraint->result(qr//);

  # false

  # $constraint->result(Example1->new);

  # true

  # $constraint->result(Example2->new);

  # true

=back

=over 4

=item accept example 4

  # given: synopsis

  package Example1;

  sub new {
    bless {};
  }

  package Example2;

  sub new {
    bless {};
  }

  package main;

  $constraint = $constraint->accept('Example1');

  # bless(..., "Venus::Constraint")

  # $constraint->result;

  # false

  # $constraint->result(qr//);

  # false

  # $constraint->result(Example1->new);

  # true

  # $constraint->result(Example2->new);

  # false

=back

=cut

=head2 check

  check(Venus::Check $data) (Venus::Check)

The check method gets or sets the L object used for performing
runtime data type validation.

I>

=over 4

=item check example 1

  # given: synopsis

  package main;

  my $check = $constraint->check(Venus::Check->new);

  # bless(..., 'Venus::Check')

=back

=over 4

=item check example 2

  # given: synopsis

  package main;

  $constraint->check(Venus::Check->new);

  my $check = $constraint->check;

  # bless(..., 'Venus::Check')

=back

=cut

=head2 clear

  clear() (Venus::Constraint)

The clear method resets the L attributes and returns the invocant.

I>

=over 4

=item clear example 1

  # given: synopsis

  package main;

  $constraint->accept('string');

  $constraint = $constraint->clear;

  # bless(..., "Venus::Constraint")

=back

=cut

=head2 ensure

  ensure(coderef $code) (Venus::Constraint)

The ensure method registers a custom (not built-in) constraint condition and
returns the invocant.

I>

=over 4

=item ensure example 1

  # given: synopsis

  package main;

  $constraint->accept('number');

  my $ensure = $constraint->ensure(sub {
    $_ >= 0
  });

  # bless(.., "Venus::Constraint")

=back

=over 4

=item ensure example 2

  # given: synopsis

  package main;

  $constraint->accept('number');

  my $ensure = $constraint->ensure(sub {
    my ($source, $value) = @_;

    if ($value >= 0) {
      return 1;
    }
    else {
      return 0;
    }
  });

  # bless(..., "Venus::Constraint")

=back

=cut

=head2 eval

  eval(any $data) (boolean)

The eval method dispatches to the L object as well as evaluating any
custom conditions, and returns true if all conditions pass, and false if any
condition fails.

I>

=over 4

=item eval example 1

  # given: synopsis

  package main;

  $constraint->accept('float');

  $constraint->ensure(sub{$_ >= 1});

  my $eval = $constraint->eval('1.00');

  # true

=back

=over 4

=item eval example 2

  # given: synopsis

  package main;

  $constraint->accept('float');

  $constraint->ensure(sub{$_ >= 1});

  my $eval = $constraint->eval('0.99');

  # false

=back

=cut

=head2 evaler

  evaler(any @args) (coderef)

The evaler method returns a coderef which calls the L method with the
invocant when called.

I>

=over 4

=item evaler example 1

  # given: synopsis

  package main;

  my $evaler = $constraint->evaler;

  # sub{...}

  # my $result = $evaler->();

  # false

=back

=over 4

=item evaler example 2

  # given: synopsis

  package main;

  my $evaler = $constraint->accept('any')->evaler;

  # sub{...}

  # my $result = $evaler->();

  # true

=back

=cut

=head2 result

  result(any $data) (boolean)

The result method dispatches to the L method and returns the result.

I>

=over 4

=item result example 1

  # given: synopsis

  package main;

  $constraint->accept('float');

  $constraint->ensure(sub{$_ >= 1});

  my $result = $constraint->result('1.00');

  # true

=back

=over 4

=item result example 2

  # given: synopsis

  package main;

  $constraint->accept('float');

  $constraint->ensure(sub{$_ >= 1});

  my $result = $constraint->result('0.99');

  # false

=back

=cut

=head1 AUTHORS

Awncorp, C

=cut

=head1 LICENSE

Copyright (C) 2000, Awncorp, C.

This program is free software, you can redistribute it and/or modify it under
the terms of the Apache license version 2.0.

=cut