File Coverage

blib/lib/MooseX/Attribute/Dependency.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	2	2	100.0
condition			n/a
subroutine	14	14	100.0
pod	0	2	0.0
total	42	44	95.4

#
# This file is part of MooseX-Attribute-Dependent
#
# This software is Copyright (c) 2011 by Moritz Onken.
#
# This is free software, licensed under:
#
#   The (three-clause) BSD License
#
package MooseX::Attribute::Dependency;
{
  $MooseX::Attribute::Dependency::VERSION = '1.1.2';
}
use Moose;
has [qw(parameters message constraint name)] => ( is => 'ro' );

sub get_message {
    my ($self) = @_;
    sprintf( $self->message, join( ', ', @{ $self->parameters } ) );
}

use overload( bool => sub {1} );

my $meta = Class::MOP::Class->initialize('MooseX::Attribute::Dependencies');

sub register {
    my ($args) = @_;
    no strict 'refs';
    my $name = 'MooseX::Attribute::Dependencies::' . $args->{name};
    my $code = sub {
        my $params = shift;
        my $dep = MooseX::Attribute::Dependency->new(
            %$args,
            name       => $name,
            parameters => $params
        );
        return @_ ? ($dep, @_) : $dep;
    };
    $meta->add_method( $args->{name}, $code );
}

__PACKAGE__->meta->make_immutable;

package MooseX::Attribute::Dependencies;
{
  $MooseX::Attribute::Dependencies::VERSION = '1.1.2';
}
use strict;
use warnings;

MooseX::Attribute::Dependency::register(
    {   name       => 'All',
        message    => 'The following attributes are required: %s',
        constraint => sub {
            my ( $attr_name, $params, @related ) = @_;
            return List::MoreUtils::all { exists $params->{$_} } @related;
            }
    }
);

MooseX::Attribute::Dependency::register(
    {   name    => 'Any',
        message => 'At least one of the following attributes is required: %s',
        constraint => sub {
            my ( $attr_name, $params, @related ) = @_;
            return List::MoreUtils::any { exists $params->{$_} } @related;
            }
    }
);

MooseX::Attribute::Dependency::register(
    {   name       => 'None',
        message    => 'None of the following attributes can have a value: %s',
        constraint => sub {
            my ( $attr_name, $params, @related ) = @_;
            return List::MoreUtils::none { exists $params->{$_} } @related;
            }
    }
);

MooseX::Attribute::Dependency::register(
    {   name => 'NotAll',
        message =>
            'At least one of the following attributes cannot have a value: %s',
        constraint => sub {
            my ( $attr_name, $params, @related ) = @_;
            return List::MoreUtils::notall { exists $params->{$_} } @related;
            }
    }
);

1;

__END__
=pod

=head1 NAME

MooseX::Attribute::Dependency

=head1 VERSION

version 1.1.2

=head1 AUTHOR

Moritz Onken

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2011 by Moritz Onken.

This is free software, licensed under:

  The (three-clause) BSD License

=cut