Initial Commit

database/perl/vendor/lib/MooseX/Meta/TypeCoercion/Structured.pm

@@ -0,0 +1,15 @@
+package ## Hide from PAUSE
+ MooseX::Meta::TypeCoercion::Structured;
+
+our $VERSION = '0.36';
+
+use Moose;
+extends 'Moose::Meta::TypeCoercion';
+
+# We need to make sure we can properly coerce the structure elements inside a
+# structured type constraint.  However requirements for the best way to allow
+# this are still in flux.  For now this class is a placeholder.
+# see also Moose::Meta::TypeCoercion.
+
+no Moose;
+__PACKAGE__->meta->make_immutable(inline_constructor => 0);

database/perl/vendor/lib/MooseX/Meta/TypeCoercion/Structured/Optional.pm

@@ -0,0 +1,29 @@
+package ## Hide from PAUSE
+  MooseX::Meta::TypeCoercion::Structured::Optional;
+
+our $VERSION = '0.36';
+
+use Moose;
+extends 'Moose::Meta::TypeCoercion';
+
+sub compile_type_coercion {
+    my ($self) = @_;
+    my $constraint = $self->type_constraint->type_parameter;
+
+    $self->_compiled_type_coercion(sub {
+        my ($value) = @_;
+        return unless $constraint->has_coercion;
+        return $constraint->coerce($value);
+    });
+}
+
+sub has_coercion_for_type { 0 }
+
+sub add_type_coercions {
+    Moose->throw_error("Cannot add additional type coercions to Optional types");
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable(inline_constructor => 0);
+
+1;

database/perl/vendor/lib/MooseX/Meta/TypeConstraint/ForceCoercion.pm

@@ -0,0 +1,145 @@
+package MooseX::Meta::TypeConstraint::ForceCoercion;
+our $VERSION = '0.01';
+
+# ABSTRACT: Force coercion when validating type constraints
+
+use Moose;
+use namespace::autoclean;
+
+
+
+has _type_constraint => (
+    is       => 'ro',
+    isa      => 'Moose::Meta::TypeConstraint',
+    init_arg => 'type_constraint',
+    required => 1,
+);
+
+
+sub check {
+    my ($self, $value) = @_;
+    my $coerced = $self->_type_constraint->coerce($value);
+    return undef if $coerced == $value;
+    return $self->_type_constraint->check($coerced);
+}
+
+
+sub validate {
+    my ($self, $value, $coerced_ref) = @_;
+    my $coerced = $self->_type_constraint->coerce($value);
+    return 'Coercion failed' if $coerced == $value;
+    ${ $coerced_ref } = $coerced if $coerced_ref;
+    return $self->_type_constraint->validate($coerced);
+}
+
+my $meta = __PACKAGE__->meta;
+
+for my $meth (qw/isa can meta/) {
+    my $orig = __PACKAGE__->can($meth);
+    $meta->add_method($meth => sub {
+        my ($self) = shift;
+        return $self->$orig(@_) unless blessed $self;
+
+        my $tc = $self->_type_constraint;
+        # this might happen during global destruction
+        return $self->$orig(@_) unless $tc;
+
+        return $tc->$meth(@_);
+    });
+}
+
+sub AUTOLOAD {
+    my $self = shift;
+    my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
+    return unless blessed $self;
+
+    my $tc = $self->_type_constraint;
+    return unless $tc;
+
+    return $tc->$meth(@_);
+}
+
+$meta->make_immutable;
+
+1;
+
+__END__
+=head1 NAME
+
+MooseX::Meta::TypeConstraint::ForceCoercion - Force coercion when validating type constraints
+
+=head1 VERSION
+
+version 0.01
+
+=head1 SYNOPSIS
+
+    use MooseX::Types:::Moose qw/Str Any/;
+    use Moose::Util::TypeConstraints;
+    use MooseX::Meta::TypeConstraint::ForceCoercion;
+
+    # get any type constraint
+    my $tc = Str;
+
+    # declare one or more coercions for it
+    coerce $tc,
+        from Any,
+        via { ... };
+
+    # wrap the $tc to force coercion
+    my $coercing_tc = MooseX::Meta::TypeConstraint::ForceCoercion->new(
+        type_constraint => $tc,
+    );
+
+    # check a value against new type constraint. this will run the type
+    # coercions for the wrapped type, even if the value already passes
+    # validation before coercion. it will fail if the value couldn't be
+    # coerced
+    $coercing_tc->check('Affe');
+
+=head1 DESCRIPTION
+
+This class allows to wrap any C<Moose::Meta::TypeConstraint> in a way that will
+force coercion of the value when checking or validating a value against it.
+
+
+
+=head1 ATTRIBUTES
+
+=head2 type_constraint
+
+The type constraint to wrap. All methods except for C<validate> and C<check>
+are delegated to the value of this attribute.
+
+
+
+=head1 METHODS
+
+=head2 check ($value)
+
+Same as C<Moose::Meta::TypeConstraint::check>, except it will always try to
+coerce C<$value> before checking it against the actual type constraint. If
+coercing fails the check will fail, too.
+
+
+
+=head2 validate ($value, $coerced_ref?)
+
+Same as C<Moose::Meta::TypeConstraint::validate>, except it will always try to
+coerce C<$value> before validating it against the actual type constraint. If
+coercing fails the validation will fail, too.
+
+If coercion was successful and a C<$coerced_ref> references was passed, the
+coerced value will be stored in that.
+
+=head1 AUTHOR
+
+  Florian Ragwitz <rafl@debian.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2009 by Florian Ragwitz.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
+

database/perl/vendor/lib/MooseX/Meta/TypeConstraint/Structured.pm

@@ -0,0 +1,500 @@
+package ## Hide from PAUSE
+ MooseX::Meta::TypeConstraint::Structured;
+# ABSTRACT: Structured type constraints
+
+our $VERSION = '0.36';
+
+use Moose;
+use Devel::PartialDump;
+use MooseX::Meta::TypeCoercion::Structured;
+extends 'Moose::Meta::TypeConstraint';
+
+
+#pod =head1 DESCRIPTION
+#pod
+#pod A structure is a set of L<Moose::Meta::TypeConstraint> that are 'aggregated' in
+#pod such a way as that they are all applied to an incoming list of arguments.  The
+#pod idea here is that a Type Constraint could be something like, "An C<Int> followed by
+#pod an C<Int> and then a C<Str>" and that this could be done so with a declaration like:
+#pod
+#pod     Tuple[Int,Int,Str]; ## Example syntax
+#pod
+#pod So a structure is a list of type constraints (the C<Int,Int,Str> in the above
+#pod example) which are intended to function together.
+#pod
+#pod =attr type_constraints
+#pod
+#pod A list of L<Moose::Meta::TypeConstraint> objects.
+#pod
+#pod =cut
+
+has 'type_constraints' => (
+    is=>'ro',
+    isa=>'Ref',
+    predicate=>'has_type_constraints',
+);
+
+#pod =attr constraint_generator
+#pod
+#pod =for stopwords subref
+#pod
+#pod A subref or closure that contains the way we validate incoming values against
+#pod a set of type constraints.
+#pod
+#pod =cut
+
+has 'constraint_generator' => (
+    is=>'ro',
+    isa=>'CodeRef',
+    predicate=>'has_constraint_generator',
+);
+
+has coercion => (
+    is      => 'ro',
+    isa     => 'Object',
+    builder => '_build_coercion',
+);
+
+sub _build_coercion {
+    my ($self) = @_;
+    return MooseX::Meta::TypeCoercion::Structured->new(
+        type_constraint => $self,
+    );
+}
+
+#pod =method validate
+#pod
+#pod Messing with validate so that we can support nicer error messages.
+#pod
+#pod =cut
+
+sub _clean_message {
+    my $message = shift @_;
+    $message =~s/MooseX::Types::Structured:://g;
+    return $message;
+}
+
+override 'validate' => sub {
+    my ($self, $value, $message_stack) = @_;
+    unless ($message_stack) {
+        $message_stack = MooseX::Types::Structured::MessageStack->new();
+    }
+
+    $message_stack->inc_level;
+
+    if ($self->_compiled_type_constraint->($value, $message_stack)) {
+        ## Everything is good, no error message to return
+        return undef;
+    } else {
+        ## Whoops, need to figure out the right error message
+        my $args = Devel::PartialDump::dump($value);
+        $message_stack->dec_level;
+        if($message_stack->has_messages) {
+            if($message_stack->level) {
+                ## we are inside a deeply structured constraint
+                return $self->get_message($args);
+            } else {
+                my $message_str = $message_stack->as_string;
+                return _clean_message($self->get_message("$args, Internal Validation Error is: $message_str"));
+            }
+        } else {
+            return $self->get_message($args);
+        }
+    }
+};
+
+#pod =method generate_constraint_for ($type_constraints)
+#pod
+#pod Given some type constraints, use them to generate validation rules for an ref
+#pod of values (to be passed at check time)
+#pod
+#pod =cut
+
+sub generate_constraint_for {
+    my ($self, $type_constraints) = @_;
+    return $self->constraint_generator->($self, $type_constraints);
+}
+
+#pod =for :prelude
+#pod =for stopwords parameterize
+#pod
+#pod =method parameterize (@type_constraints)
+#pod
+#pod Given a ref of type constraints, create a structured type.
+#pod
+#pod =cut
+
+sub parameterize {
+    my ($self, @type_constraints) = @_;
+    my $class = ref $self;
+    my $name = $self->name .'['. join(',', map {"$_"} @type_constraints) .']';
+    my $constraint_generator = $self->__infer_constraint_generator;
+
+    return $class->new(
+        name => $name,
+        parent => $self,
+        type_constraints => \@type_constraints,
+        constraint_generator => $constraint_generator,
+    );
+}
+
+#pod =method __infer_constraint_generator
+#pod
+#pod =for stopwords servicable
+#pod
+#pod This returns a CODEREF which generates a suitable constraint generator.  Not
+#pod user servicable, you'll never call this directly.
+#pod
+#pod =cut
+
+sub __infer_constraint_generator {
+    my ($self) = @_;
+    if($self->has_constraint_generator) {
+        return $self->constraint_generator;
+    } else {
+        return sub {
+            ## I'm not sure about this stuff but everything seems to work
+            my $tc = shift @_;
+            my $merged_tc = [@$tc, @{$self->parent->type_constraints}];
+            $self->constraint->($merged_tc, @_);
+        };
+    }
+}
+
+#pod =method compile_type_constraint
+#pod
+#pod hook into compile_type_constraint so we can set the correct validation rules.
+#pod
+#pod =cut
+
+around 'compile_type_constraint' => sub {
+    my ($compile_type_constraint, $self, @args) = @_;
+
+    if($self->has_type_constraints) {
+        my $type_constraints = $self->type_constraints;
+        my $constraint = $self->generate_constraint_for($type_constraints);
+        $self->_set_constraint($constraint);
+    }
+
+    return $self->$compile_type_constraint(@args);
+};
+
+#pod =method create_child_type
+#pod
+#pod modifier to make sure we get the constraint_generator
+#pod
+#pod =cut
+
+around 'create_child_type' => sub {
+    my ($create_child_type, $self, %opts) = @_;
+    return $self->$create_child_type(
+        %opts,
+        constraint_generator => $self->__infer_constraint_generator,
+    );
+};
+
+#pod =method is_a_type_of
+#pod
+#pod =method is_subtype_of
+#pod
+#pod =method equals
+#pod
+#pod Override the base class behavior.
+#pod
+#pod =cut
+
+sub equals {
+    my ( $self, $type_or_name ) = @_;
+    my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+      or return;
+
+    return unless $other->isa(__PACKAGE__);
+
+    return (
+        $self->parent->equals($other->parent)
+            and
+        $self->type_constraints_equals($other)
+    );
+}
+
+sub is_a_type_of {
+    my ( $self, $type_or_name ) = @_;
+    my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+      or return;
+
+    if ( $other->isa(__PACKAGE__) and @{ $other->type_constraints || [] }) {
+        if ( $self->parent->is_a_type_of($other->parent) ) {
+            return $self->_type_constraints_op_all($other, "is_a_type_of");
+        } elsif ( $self->parent->is_a_type_of($other) ) {
+            return 1;
+            # FIXME compare?
+        } else {
+            return 0;
+        }
+    } else {
+        return $self->SUPER::is_a_type_of($other);
+    }
+}
+
+sub is_subtype_of {
+    my ( $self, $type_or_name ) = @_;
+    my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+      or return;
+    if ( $other->isa(__PACKAGE__) ) {
+        if ( $other->type_constraints and $self->type_constraints ) {
+            if ( $self->parent->is_a_type_of($other->parent) ) {
+                return (
+                    $self->_type_constraints_op_all($other, "is_a_type_of")
+                      and
+                    $self->_type_constraints_op_any($other, "is_subtype_of")
+                );
+            } elsif ( $self->parent->is_a_type_of($other) ) {
+                return 1;
+                # FIXME compare?
+            } else {
+                return 0;
+            }
+        } else {
+            if ( $self->type_constraints ) {
+                if ( $self->SUPER::is_subtype_of($other) ) {
+                    return 1;
+                } else {
+                    return;
+                }
+            } else {
+                return $self->parent->is_subtype_of($other->parent);
+            }
+        }
+    } else {
+        return $self->SUPER::is_subtype_of($other);
+    }
+}
+
+#pod =method type_constraints_equals
+#pod
+#pod Checks to see if the internal type constraints are equal.
+#pod
+#pod =cut
+
+sub type_constraints_equals {
+    my ( $self, $other ) = @_;
+    $self->_type_constraints_op_all($other, "equals");
+}
+
+sub _type_constraints_op_all {
+    my ($self, $other, $op) = @_;
+
+    return unless $other->isa(__PACKAGE__);
+
+    my @self_type_constraints = @{$self->type_constraints||[]};
+    my @other_type_constraints = @{$other->type_constraints||[]};
+
+    return unless @self_type_constraints == @other_type_constraints;
+
+    ## Incoming ay be either arrayref or hashref, need top compare both
+    while(@self_type_constraints) {
+        my $self_type_constraint = shift @self_type_constraints;
+        my $other_type_constraint = shift @other_type_constraints;
+
+        $_ = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_)
+          for $self_type_constraint, $other_type_constraint;
+
+        my $result = $self_type_constraint->$op($other_type_constraint);
+        return unless $result;
+    }
+
+    return 1; ##If we get this far, everything is good.
+}
+
+sub _type_constraints_op_any {
+    my ($self, $other, $op) = @_;
+
+    return unless $other->isa(__PACKAGE__);
+
+    my @self_type_constraints = @{$self->type_constraints||[]};
+    my @other_type_constraints = @{$other->type_constraints||[]};
+
+    return unless @self_type_constraints == @other_type_constraints;
+
+    ## Incoming ay be either arrayref or hashref, need top compare both
+    while(@self_type_constraints) {
+        my $self_type_constraint = shift @self_type_constraints;
+        my $other_type_constraint = shift @other_type_constraints;
+
+        $_ = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_)
+          for $self_type_constraint, $other_type_constraint;
+
+        return 1 if $self_type_constraint->$op($other_type_constraint);
+    }
+
+    return 0;
+}
+
+#pod =method get_message
+#pod
+#pod Give you a better peek into what's causing the error.  For now we stringify the
+#pod incoming deep value with L<Devel::PartialDump> and pass that on to either your
+#pod custom error message or the default one.  In the future we'll try to provide a
+#pod more complete stack trace of the actual offending elements
+#pod
+#pod =cut
+
+around 'get_message' => sub {
+    my ($get_message, $self, $value) = @_;
+    $value = Devel::PartialDump::dump($value)
+     if ref $value;
+    return $self->$get_message($value);
+};
+
+#pod =head1 SEE ALSO
+#pod
+#pod The following modules or resources may be of interest.
+#pod
+#pod L<Moose>, L<Moose::Meta::TypeConstraint>
+#pod
+#pod =cut
+
+no Moose;
+__PACKAGE__->meta->make_immutable(inline_constructor => 0);
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+MooseX::Meta::TypeConstraint::Structured - Structured type constraints
+
+=head1 VERSION
+
+version 0.36
+
+=for stopwords parameterize
+
+=head1 DESCRIPTION
+
+A structure is a set of L<Moose::Meta::TypeConstraint> that are 'aggregated' in
+such a way as that they are all applied to an incoming list of arguments.  The
+idea here is that a Type Constraint could be something like, "An C<Int> followed by
+an C<Int> and then a C<Str>" and that this could be done so with a declaration like:
+
+    Tuple[Int,Int,Str]; ## Example syntax
+
+So a structure is a list of type constraints (the C<Int,Int,Str> in the above
+example) which are intended to function together.
+
+=head1 ATTRIBUTES
+
+=head2 type_constraints
+
+A list of L<Moose::Meta::TypeConstraint> objects.
+
+=head2 constraint_generator
+
+=head1 METHODS
+
+=head2 validate
+
+Messing with validate so that we can support nicer error messages.
+
+=head2 generate_constraint_for ($type_constraints)
+
+Given some type constraints, use them to generate validation rules for an ref
+of values (to be passed at check time)
+
+=head2 parameterize (@type_constraints)
+
+Given a ref of type constraints, create a structured type.
+
+=head2 __infer_constraint_generator
+
+=head2 compile_type_constraint
+
+hook into compile_type_constraint so we can set the correct validation rules.
+
+=head2 create_child_type
+
+modifier to make sure we get the constraint_generator
+
+=head2 is_a_type_of
+
+=head2 is_subtype_of
+
+=head2 equals
+
+Override the base class behavior.
+
+=head2 type_constraints_equals
+
+Checks to see if the internal type constraints are equal.
+
+=head2 get_message
+
+Give you a better peek into what's causing the error.  For now we stringify the
+incoming deep value with L<Devel::PartialDump> and pass that on to either your
+custom error message or the default one.  In the future we'll try to provide a
+more complete stack trace of the actual offending elements
+
+=for stopwords subref
+
+A subref or closure that contains the way we validate incoming values against
+a set of type constraints.
+
+=for stopwords servicable
+
+This returns a CODEREF which generates a suitable constraint generator.  Not
+user servicable, you'll never call this directly.
+
+=head1 SEE ALSO
+
+The following modules or resources may be of interest.
+
+L<Moose>, L<Moose::Meta::TypeConstraint>
+
+=head1 SUPPORT
+
+Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types-Structured>
+(or L<bug-MooseX-Types-Structured@rt.cpan.org|mailto:bug-MooseX-Types-Structured@rt.cpan.org>).
+
+There is also a mailing list available for users of this distribution, at
+L<http://lists.perl.org/list/moose.html>.
+
+There is also an irc channel available for users of this distribution, at
+L<C<#moose> on C<irc.perl.org>|irc://irc.perl.org/#moose>.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+John Napiorkowski <jjnapiork@cpan.org>
+
+=item *
+
+Florian Ragwitz <rafl@debian.org>
+
+=item *
+
+יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
+
+=item *
+
+Tomas (t0m) Doran <bobtfish@bobtfish.net>
+
+=item *
+
+Robert Sedlacek <rs@474.at>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2008 by John Napiorkowski.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

database/perl/vendor/lib/MooseX/Meta/TypeConstraint/Structured/Optional.pm

@@ -0,0 +1,25 @@
+package ## Hide from PAUSE
+  MooseX::Meta::TypeConstraint::Structured::Optional;
+
+our $VERSION = '0.36';
+
+use Moose;
+use MooseX::Meta::TypeCoercion::Structured::Optional;
+
+extends 'Moose::Meta::TypeConstraint::Parameterizable';
+
+around parameterize => sub {
+    my $orig = shift;
+    my $self = shift;
+
+    my $ret = $self->$orig(@_);
+
+    $ret->coercion(MooseX::Meta::TypeCoercion::Structured::Optional->new(type_constraint => $ret));
+
+    return $ret;
+};
+
+no Moose;
+__PACKAGE__->meta->make_immutable(inline_constructor => 0);
+
+1;