File Coverage

blib/lib/Declare/Constraints/Simple/Library/OO.pm

Criterion	Covered	Total	%
statement	15	15	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	20	20	100.0

=head1 NAME

Declare::Constraints::Simple::Library::OO - OO Constraints

=cut

package Declare::Constraints::Simple::Library::OO;
use warnings;
use strict;

use Declare::Constraints::Simple-Library;

use Class::Inspector;
use Scalar::Util ();

=head1 SYNOPSIS

  # accept objects or classes
  my $object_or_class = Or( IsObject, IsClass );

  # valid on objects with all methods
  my $proper_object = And( IsObject,
                           HasMethods( qw(foo bar) ));

  # validate against date objects
  my $is_date_object = IsA('DateTime');

=head1 DESCRIPTION

This library contains the constraints for validating parameters in an
object oriented manner.

=head1 CONSTRAINTS

=head2 HasMethods(@methods)

Returns true if the value is an object or class that C
all the specified C<@methods>.

The stack or path part of C looks like C
where C<$method> is the first found missing method.

=cut

constraint 'HasMethods',
    sub {
        my (@methods) = @_;
        return sub {
            return _false('Undefined Value') unless defined $_[0];
            return _false('Not a Class or Object')
                unless Scalar::Util::blessed($_[0])
                    or Class::Inspector->loaded($_[0]);

            for (@methods) {
                unless ($_[0]->can($_)) {
                    _info($_);
                    return _false("Method $_ not implemented");
                }
            }

            return _true;
        };
    };

=head2 IsA(@classes)

Is true if the passed object or class is a subclass of one
of the classes mentioned in C<@classes>.

=cut

constraint 'IsA',
    sub {
        my (@classes) = @_;
        return sub {
            return _false('Undefined Value') unless defined $_[0];
            for (@classes) {
                return _true if eval { $_[0]->isa($_) };
            }
            return _false('No matching Class');
        };
    };

=head2 IsClass()

Valid if value is a loaded class.

=cut

constraint 'IsClass',
    sub {
        return sub {
            return _false('Undefined Value') unless defined $_[0];
            return _result(Class::Inspector->loaded($_[0]),
                'Not a loaded Class');
        };
    };

=head2 IsObject()

True if the value is blessed.

=cut

constraint 'IsObject',
    sub {
        return sub {
            return _false('Undefined Value') unless defined $_[0];
            return _result(Scalar::Util::blessed($_[0]),
                'Not an Object');
        };
    };

=head1 SEE ALSO

L, L

=head1 AUTHOR

Robert 'phaylon' Sedlacek [e-mail]>

=head1 LICENSE AND COPYRIGHT

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

=cut

1;