use 5.008;

package Data::Constraint;
use strict;

use warnings;
no warnings;

=encoding utf8

=head1 NAME

Data::Constraint - prototypical value checking


	use Data::Constraint;

	my $constraint = Data::Constraint->add_constraint(
		run         => sub { $_[1] =~ /Perl/ },
		description => "String should have 'Perl' in it";

	if( $constraint->check( 'Java' ) )


A constraint is some sort of condition on a datum.  This module checks
one condition against one value at a time, and I call the thing that
checks that condition the "constraint".  A constraint returns true or
false, and that's it.  It should have no side effects, it should not
change program flow, and it should mind its own business. Let the
thing that calls the constraint figure out what to do with it. I want
something that says "yes" or "no" (and I discuss why this needs a
fancy module later).

For instance, the constraint may state that the value has to be a
number.  The condition may be something that ensures the value does
not have non-digits.

	$value =~ /^\d+\z/

The value may have additional constraints, such as a lower limit.

	$value > $minimum

Although I designed constraints to be a single condition, you
may want to create contraints that check more than one thing.

	$value > $minimum and $value < $maximum

In the previous examples, we could tell what was wrong with the value
if the return value was false: the value didn't satisfy it's single
condition.  If it was supposed to be all digits and wasn't, then it
had non-digits.  If it was supposed to be greater than the minimum
value, but wasn't, it was less than (or equal to) the minimal value.
With more than one condition, like the last example, I cannot tell
which one failed. I might be able to say that a value of out of range,
but I think it is nicer to know if the value should have been larger
or smaller so I can pass that on to the user.  Having said that, I
give you enough rope to do what you wish.

=head2 Why I need a fancy, high-falutin' module

This module is a sub-class of C<Class::Prototyped>.  In brief, that
means constraints are class-objects even if they don't look like they
are.  Each constraint is a self-contained class, and I can modify
a constraint by adding data and behaviour without affecting any of
the other constraints.  I can also make a list of constraints that
I store for later use (also known as "delayed" execution).

Several data may need the same conditions, so they can share the same
constraint.  Other data that need different constraints can get
their own, or modify copies of ones that exist.

I can also associate several constraints with some data, and each
one has its own constraint.  In the compelling case for this module,
I needed to generate different warnings for different failures.

=head2 Interacting with a constraint

I can get a constraint object by asking for it.

	my $constraint = Data::Constraint->get_by_name( $name );

If no constraint has that name, I get back the default constraint which
always returns true. Or should it be false?  I guess that depends on
what you are doing.

If I don't know which constraints exist, I can get all the
names. The names are just simple strings, so they have no
magic.  Maybe this should be a hash so you can immediately use
the value of the key you want.

	my @names = Data::Constraint->get_all_names;

Once I have the constraint, I give it a value to check if

	$constraint->check( $value );

I can do this all in one step.

	Data::Constraint->get_by_name( $name )->check( $value );

=head2 Predefined constraints

I previously had some pre-loaded contraints (C<defined>, C<ordinal>,
and C<test>) but that got in the way of things that didn't want them.
You can still find them defined in the test files though.

=head2 Adding a new constraint

Add a new constraint with the class method C<add_constraint>. The
first argument is the name you want to give the constraint.  The
rest of the arguments are optional, although I need to add a
C<run> key if I want the constraint to do anything useful: its
value should be something that returns true when the value
satisfies the condition (so a constant is probably not what
you want).  An anonymous subroutine is probably what you want.

		'run' => sub {...},
		[ @optional_arguments ],

Once I create the constraint, it exists forever (for now).  I get
back the constraint object:

	my $constraint = Data::Constraint->add_constraint( ... );

The object sticks around after C<$constraint> goes out of scope.
The C<$constraint> is just a reference to the object.  I can get
another reference to it through C<get_by_name()>.  See L<"Deleting
a constraint"> if you want to get rid of them.

=head2 Modifying a constraint

Um, don't do that yet unless you know what you are doing.

=head2 Deleting a constraint

	Data::Constraint->delete_by_name( $name );


=head2 Doing anything you want

You wish!  This module can't help you there.

=head1 METHODS


our $VERSION = '1.202';

use base qw(Class::Prototyped);

=over 4

=item check( VALUE )

Apply the constraint to the VALUE.

=item add_constraint( NAME, KEY-VALUES )

Added a constraint with name NAME. Possible keys and values:

	run            reference to subroutine to run
	description    string that decribes the constraint


		'run'       => sub {...},
		description => 'This is what I do",

=item get_all_names

Return a list of all the defined constraints.

=item get_by_name( CONSTRAINT_NAME )

Return the constraint with name CONSTRAINT_NAME. This is

=item delete_by_name( CONSTRAINT_NAME )

Delete the constraint with name CONSTRAINT_NAME. It's no longer available.

=item delete_all()

Delete all the constraints, even the default ones.

=item description

Return the description. The default description is the empty string. You
should supply your own description with C<add_constraint>.

=item run

Return the description. The default description is the empty string. You
should supply your own description with C<add_constraint>.



	check            => sub {
		$_[0]->run( $_[1] ) ? 1 : 0;

	# the list of added constraints
	constraints    => {},

	add_constraint => sub {
		my $class = shift;
		my $name  = shift;

		my $constraint = $class->new(
			'name'   => $name,
			'class*' => $class,

		$class->constraints->{$name} = $constraint;

	get_all_names => sub {
		return sort keys %{ $_[0]->constraints };

	get_by_name => sub {
		$_[0]->constraints->{ $_[1] };

	delete_by_name => sub {
		delete $_[0]->constraints->{ $_[1] };

	delete_all => sub {
		$_[0]->constraints( {} );

	description => sub { "" },
	run         => sub { 1  },


This source is in Github:

=head1 AUTHOR

brian d foy, C<< <> >>


Copyright © 2004-2021, brian d foy <>. All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License 2.0.