Initial Commit

database/perl/vendor/lib/Parse/Method/Signatures/Param.pm

@@ -0,0 +1,201 @@
+package Parse::Method::Signatures::Param;
+
+use Moose;
+use MooseX::Types::Structured qw/Tuple/;
+use MooseX::Types::Moose qw/Bool Str ArrayRef HashRef/;
+
+use namespace::clean -except => 'meta';
+
+with 'MooseX::Traits';
+
+has required => (
+    is       => 'ro',
+    isa      => Bool,
+    required => 1
+);
+
+has sigil => (
+    is       => 'ro',
+    isa      => Str,
+    required => 1,
+);
+
+has type_constraints => (
+    is         => 'ro',
+    isa        => 'Parse::Method::Signatures::TypeConstraint',
+    predicate  => 'has_type_constraints',
+    handles    => {
+        meta_type_constraint => 'tc'
+    },
+);
+
+has default_value => (
+    is        => 'ro',
+    isa       => Str,
+    predicate => 'has_default_value',
+);
+
+has constraints => (
+    is         => 'ro',
+    isa        => ArrayRef[Str],
+    predicate  => 'has_constraints',
+    auto_deref => 1,
+);
+
+has param_traits => (
+    is         => 'ro',
+    isa        => ArrayRef[Tuple[Str, Str]],
+    predicate  => 'has_traits',
+    auto_deref => 1
+);
+
+has '+_trait_namespace' => (
+    default => 'Parse::Method::Signatures::Param',
+);
+
+sub _stringify_type_constraints {
+    my ($self) = @_;
+    return $self->has_type_constraints
+        ? $self->type_constraints->to_string . q{ }
+        : q{};
+}
+
+sub _stringify_default_value {
+    my ($self) = @_;
+    return $self->has_default_value
+        ? q{ = } . $self->default_value
+        : q{};
+}
+
+sub _stringify_constraints {
+    my ($self) = @_;
+    return q{} unless $self->has_constraints;
+    return q{ where } . join(q{ where }, $self->constraints);
+}
+
+sub _stringify_traits {
+    my ($self) = @_;
+    return q{} unless $self->has_traits;
+    return q{ } . join q{ }, map { @{ $_ } } $self->param_traits;
+}
+
+sub to_string {
+    my ($self) = @_;
+    my $ret = q{};
+
+    $ret .= $self->_stringify_type_constraints;
+    $ret .= $self->_stringify_variable_name;
+    $ret .= $self->_stringify_required;
+    $ret .= $self->_stringify_default_value;
+    $ret .= $self->_stringify_constraints;
+    $ret .= $self->_stringify_traits;
+
+    return $ret;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+=head1 NAME
+
+Parse::Method::Signatures::Param - a parsed parameter from a signature
+
+=head1 ATTRIBUTES
+
+All attributes of this class are read-only.
+
+=head2 required
+
+Is this parameter required (true) or optional (false)?
+
+=head2 sigil
+
+The effective sigil ('$', '@' or '%') of this parameter.
+
+=head2 type_constraints
+
+=over
+
+B<Type:> L<Parse::Method::Signatures::TypeConstraint>
+
+B<Predicate:> has_type_constraints
+
+=back
+
+Representation of the type constraint for this parameter. Most commonly you
+will just call L</meta_type_constraint> and not access this attribute directly.
+
+=head2 default_value
+
+=over
+
+B<Type:> Str
+
+B<Predicate:> has_default_value
+
+=back
+
+A string that should be eval'd or injected to get the default value for this
+parameter. For example:
+
+ $name = 'bar'
+
+Would give a default_value of "'bar'".
+
+=head2 constraints
+
+=over
+
+B<Type:> ArrayRef[Str]
+
+B<Predicate:> has_constraints
+
+=back
+
+C<where> constraints for this type. Each member of the array a the string
+(including enclosing braces) of the where constraint block.
+
+=head2 param_traits
+
+=over
+
+B<Type:> ArrayRef[ Tupple[Str,Str] ]
+
+B<Predicate:> has_traits
+
+=back
+
+Traits that this parameter is declared to have. For instance
+
+ $foo does coerce
+
+would have a trait of
+
+ ['does', 'coerce']
+
+=head1 METHODS
+
+=head2 to_string
+
+=head2 meta_type_constraint
+
+Get the L<Moose::Meta::TypeConstraint> for this parameter. Check first that the
+type has a type constraint:
+
+ $tc = $param->meta_type_constraint if $param->has_type_constraints;
+
+=head1 SEE ALSO
+
+L<Parse::Method::Signatures>.
+
+=head1 AUTHORS
+
+Ash Berlin <ash@cpan.org>.
+
+Florian Ragwitz <rafl@debian.org>.
+
+=head1 LICENSE
+
+Licensed under the same terms as Perl itself.
+

database/perl/vendor/lib/Parse/Method/Signatures/Param/Bindable.pm

@@ -0,0 +1,19 @@
+package Parse::Method::Signatures::Param::Bindable;
+
+use Moose::Role;
+use Parse::Method::Signatures::Types qw/VariableName/;
+
+use namespace::clean -except => 'meta';
+
+has variable_name => (
+    is => 'ro',
+    isa => VariableName,
+    required => 1,
+);
+
+sub _stringify_variable_name {
+    my ($self) = @_;
+    return $self->variable_name;
+}
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/Param/Named.pm

@@ -0,0 +1,48 @@
+package Parse::Method::Signatures::Param::Named;
+
+use Moose::Role;
+use MooseX::Types::Moose qw/Str/;
+
+use namespace::clean -except => 'meta';
+
+has label => (
+    is         => 'ro',
+    isa        => Str,
+    lazy_build => 1,
+);
+
+sub _label_from_variable_name {
+    my ($self) = @_;
+    # strip sigil
+    return substr($self->variable_name, 1);
+}
+
+sub _build_label {
+    my ($self) = @_;
+    return $self->_label_from_variable_name;
+}
+
+sub _stringify_required {
+    my ($self) = @_;
+    return $self->required ? q{!} : q{};
+}
+
+around _stringify_variable_name => sub {
+    my $orig = shift;
+    my ($self) = @_;
+    my $ret = q{:};
+    my ($before, $after) = (q{}) x 2;
+
+    my $implicit_label = $self->_label_from_variable_name if $self->can('variable_name');
+
+    if (!$implicit_label || $self->label ne $implicit_label) {
+        $before = $self->label . q{(};
+        $after  = q{)};
+    }
+
+    $ret .= $before . $orig->(@_) . $after;
+
+    return $ret;
+};
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/Param/Placeholder.pm

@@ -0,0 +1,11 @@
+package Parse::Method::Signatures::Param::Placeholder;
+
+use Moose::Role;
+use namespace::clean -except => 'meta';
+
+sub _stringify_variable_name {
+    my ($self) = @_;
+    return $self->sigil;
+}
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/Param/Positional.pm

@@ -0,0 +1,11 @@
+package Parse::Method::Signatures::Param::Positional;
+
+use Moose::Role;
+use namespace::clean -except => 'meta';
+
+sub _stringify_required {
+    my ($self) = @_;
+    return $self->required ? q{} : q{?};
+}
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/Param/Unpacked.pm

@@ -0,0 +1,19 @@
+package Parse::Method::Signatures::Param::Unpacked;
+
+use Moose::Role;
+use Parse::Method::Signatures::Types qw/ParamCollection/;
+
+use namespace::clean -except => 'meta';
+
+has _params => (
+    is => 'ro',
+    isa => ParamCollection,
+    init_arg => 'params',
+    predicate => 'has_params',
+    coerce => 1,
+    handles => {
+        params => 'params',
+    },
+);
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/Param/Unpacked/Array.pm

@@ -0,0 +1,13 @@
+package Parse::Method::Signatures::Param::Unpacked::Array;
+
+use Moose::Role;
+use namespace::clean -except => 'meta';
+
+with 'Parse::Method::Signatures::Param::Unpacked';
+
+sub _stringify_variable_name {
+    my ($self) = @_;
+    return '[' . $self->_params->to_string . ']';
+}
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/Param/Unpacked/Hash.pm

@@ -0,0 +1,13 @@
+package Parse::Method::Signatures::Param::Unpacked::Hash;
+
+use Moose::Role;
+use namespace::clean -except => 'meta';
+
+with 'Parse::Method::Signatures::Param::Unpacked';
+
+sub _stringify_variable_name {
+    my ($self) = @_;
+    return '{' . $self->_params->to_string . '}';
+}
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/ParamCollection.pm

@@ -0,0 +1,21 @@
+package Parse::Method::Signatures::ParamCollection;
+
+use Moose;
+use MooseX::Types::Moose qw/ArrayRef/;
+use Parse::Method::Signatures::Types qw/Param/;
+
+use namespace::clean -except => 'meta';
+
+has params => (
+    is         => 'ro',
+    isa        => ArrayRef[Param],
+    required   => 1,
+    auto_deref => 1,
+);
+
+sub to_string {
+    my ($self) = @_;
+    return join(q{, }, map { $_->to_string } $self->params);
+}
+
+1;

database/perl/vendor/lib/Parse/Method/Signatures/Sig.pm

@@ -0,0 +1,154 @@
+package Parse::Method::Signatures::Sig;
+
+use Moose;
+use MooseX::Types::Moose qw/HashRef/;
+use Parse::Method::Signatures::Types qw/Param ParamCollection NamedParam/;
+use List::MoreUtils qw/part/;
+
+use namespace::clean -except => 'meta';
+
+has invocant => (
+    is        => 'ro',
+    does      => Param,
+    predicate => 'has_invocant',
+);
+
+has _positional_params => (
+    is        => 'ro',
+    isa       => ParamCollection,
+    init_arg  => 'positional_params',
+    predicate => 'has_positional_params',
+    coerce    => 1,
+    handles   => {
+        positional_params => 'params',
+    },
+);
+
+has _named_params => (
+    is        => 'ro',
+    isa       => ParamCollection,
+    init_arg  => 'named_params',
+    predicate => 'has_named_params',
+    coerce    => 1,
+    handles   => {
+        named_params => 'params',
+    },
+);
+
+has _named_map => (
+    is         => 'ro',
+    isa        => HashRef[Param],
+    lazy_build => 1,
+);
+
+override BUILDARGS => sub {
+    my $args = super();
+
+    if (my $params = delete $args->{params}) {
+        my ($positional, $named) = part { NamedParam->check($_) ? 1 : 0 } @{ $params };
+        $args->{positional_params} = $positional if $positional;
+        $args->{named_params} = $named if $named;
+    }
+
+    return $args;
+};
+
+sub _build__named_map {
+    my ($self) = @_;
+    return {} unless $self->has_named_params;
+    return { map { $_->label => $_ } @{ $self->named_params } };
+}
+
+sub named_param {
+    my ($self, $name) = @_;
+    return $self->_named_map->{$name};
+}
+
+around has_positional_params => sub {
+    my $orig = shift;
+    my $ret = $orig->(@_);
+    return unless $ret;
+
+    my ($self) = @_;
+    return scalar @{ $self->positional_params };
+};
+
+around has_named_params => sub {
+    my $orig = shift;
+    my $ret = $orig->(@_);
+    return unless $ret;
+
+    my ($self) = @_;
+    return scalar @{ $self->named_params };
+};
+
+sub to_string {
+    my ($self) = @_;
+    my $ret = q{(};
+
+    if ($self->has_invocant) {
+        $ret .= $self->invocant->to_string;
+        $ret .= q{:};
+
+        if ($self->has_positional_params || $self->has_named_params) {
+            $ret .= q{ };
+        }
+    }
+
+    $ret .= $self->_positional_params->to_string if $self->has_positional_params;
+    $ret .= q{, } if $self->has_positional_params && $self->has_named_params;
+    $ret .= $self->_named_params->to_string if $self->has_named_params;
+
+    $ret .= q{)};
+    return $ret;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Parse::Method::Signatures::Sig - Method Signature
+
+=head1 DESCRIPTION
+
+Represents the parsed method signature.
+
+=head1 ATTRIBUTES
+
+=head2 invocant
+
+=head2 named_params
+
+A ParamCollection representing the name parameters of this signature.
+
+=head2 positional_params
+
+A ParamCollection representing the positional parameters of this signature.
+
+=head1 METHODS
+
+=head2 has_named_params
+
+Predicate returning true if this signature has named parameters.
+
+=head2 has_positional_params
+
+Predicate returning true if this signature has positional parameters.
+
+=head2 named_param
+
+Returns the Param with the specified name.
+
+=head2 to_string
+
+Returns a string representation of this signature.
+
+=head1 LICENSE
+
+Licensed under the same terms as Perl itself.
+
+=cut

database/perl/vendor/lib/Parse/Method/Signatures/TypeConstraint.pm

@@ -0,0 +1,218 @@
+package Parse::Method::Signatures::TypeConstraint;
+
+use Carp qw/croak carp/;
+use Moose;
+use MooseX::Types::Util qw/has_available_type_export/;
+use MooseX::Types::Moose qw/Str HashRef CodeRef ClassName/;
+use Parse::Method::Signatures::Types qw/TypeConstraint/;
+
+use namespace::clean -except => 'meta';
+
+has ppi => (
+  is       => 'ro',
+  isa      => 'PPI::Element',
+  required => 1,
+  handles => {
+    'to_string' => 'content'
+  }
+);
+
+has tc => (
+    is => 'ro',
+    isa => TypeConstraint,
+    lazy => 1,
+    builder => '_build_tc',
+);
+
+has from_namespace => (
+    is => 'ro',
+    isa => ClassName,
+    predicate => 'has_from_namespace'
+);
+
+has tc_callback => (
+    is       => 'ro',
+    isa      => CodeRef,
+    default  => sub { \&find_registered_constraint },
+);
+
+sub find_registered_constraint {
+    my ($self, $name) = @_;
+
+    my $type;
+    if ($self->has_from_namespace) {
+        my $pkg = $self->from_namespace;
+
+        if ($type = has_available_type_export($pkg, $name)) {
+            croak "The type '$name' was found in $pkg " .
+                  "but it hasn't yet been defined. Perhaps you need to move the " .
+                  "definition into a type library or a BEGIN block.\n"
+                if $type && $type->isa('MooseX::Types::UndefinedType');
+        }
+        elsif ($name !~ /::/) {
+            my $meta  = Class::MOP::class_of($pkg) || Class::MOP::Class->initialize($pkg);
+            my $func  = $meta->get_package_symbol('&' . $name);
+            my $proto = prototype $func if $func;
+
+            $name = $func->()
+                if $func && defined $proto && !length $proto;
+        }
+    }
+
+    my $registry = Moose::Util::TypeConstraints->get_type_constraint_registry;
+    return $type || $registry->find_type_constraint($name) || $name;
+}
+
+
+sub _build_tc {
+    my ($self) = @_;
+    my $tc = $self->_walk_data($self->ppi);
+
+    # This makes the error appear from the right place
+    local $Carp::Internal{'Class::MOP::Method::Generated'} = 1
+      unless exists $Carp::Internal{'Class::MOP::Method::Generated'};
+
+    croak "'@{[$self->ppi]}' could not be parsed to a type constraint - maybe you need to "
+        . "pre-declare the type with class_type"
+      unless blessed $tc;
+    return $tc;
+}
+
+sub _walk_data {
+    my ($self, $data) = @_;
+
+    my $res = $self->_union_node($data)
+           || $self->_params_node($data)
+           || $self->_str_node($data)
+           || $self->_leaf($data)
+      or confess 'failed to visit tc';
+    return $res->();
+}
+
+sub _leaf {
+    my ($self, $data) = @_;
+
+    sub { $self->_invoke_callback($data->content) };
+}
+
+sub _union_node {
+    my ($self, $data) = @_;
+    return unless $data->isa('PPI::Statement::Expression::TCUnion');
+
+    my @types = map { $self->_walk_data($_) } $data->children;
+    sub {
+      scalar @types == 1 ? @types
+        : Moose::Meta::TypeConstraint::Union->new(type_constraints => \@types)
+    };
+}
+
+sub _params_node {
+    my ($self, $data) = @_;
+    return unless $data->isa('PPI::Statement::Expression::TCParams');
+
+    my @params = map { $self->_walk_data($_) } @{$data->params};
+    my $type = $self->_invoke_callback($data->type);
+    sub { $type->parameterize(@params) }
+}
+
+
+sub _str_node {
+    my ($self, $data) = @_;
+    return unless $data->isa('PPI::Token::StringifiedWord')
+               || $data->isa('PPI::Token::Number')
+               || $data->isa('PPI::Token::Quote');
+
+    sub {
+      $data->isa('PPI::Token::Number')
+          ? $data->content
+          : $data->string
+    };
+}
+
+sub _invoke_callback {
+    my $self = shift;
+    $self->tc_callback->($self, @_);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Parse::Method::Signatures::TypeConstraint - turn parsed TC data into Moose TC object
+
+=head1 DESCRIPTION
+
+Class used to turn PPI elements into L<Moose::Meta::TypeConstraint> objects.
+
+=head1 ATTRIBUTES
+
+=head2 tc
+
+=over
+
+B<Lazy Build.>
+
+=back
+
+The L<Moose::Meta::TypeConstraint> object for this type constraint, built when
+requested. L</tc_callback> will be called for each individual component type in
+turn.
+
+=head2 tc_callback
+
+=over
+
+B<Type:> CodeRef
+
+B<Default:> L</find_registered_constraint>
+
+=back
+
+Callback used to turn type names into type objects. See
+L<Parse::Method::Signatures/type_constraint_callback> for more details and an
+example.
+
+=head2 from_namespace
+
+=over
+
+B<Type:> ClassName
+
+=back
+
+If provided, then the default C<tc_callback> will search for L<MooseX::Types>
+in this package.
+
+=head1 METHODS
+
+=head2 find_registered_constraint
+
+Will search for an imported L<MooseX::Types> in L</from_namespace> (if
+provided). Failing that it will ask the L<Moose::Meta::TypeConstraint::Registry>
+for a type with the given name.
+
+If all else fails, it will simple return the type as a string, so that Moose's
+auto-vivification of classnames to type will work.
+
+=head2 to_string
+
+String representation of the type constraint, approximately as parsed.
+
+=head1 SEE ALSO
+
+L<Parse::Method::Signatures>, L<MooseX::Types>, L<MooseX::Types::Util>.
+
+=head1 AUTHORS
+
+Florian Ragwitz <rafl@debian.org>.
+
+Ash Berlin <ash@cpan.org>.
+
+=head1 LICENSE
+
+Licensed under the same terms as Perl itself.
+

database/perl/vendor/lib/Parse/Method/Signatures/Types.pm

@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+
+package Parse::Method::Signatures::Types;
+
+use Moose::Util::TypeConstraints;
+use MooseX::Types::Moose qw/Str ArrayRef/;
+use namespace::clean;
+
+use MooseX::Types -declare => [qw/
+    VariableName
+    TypeConstraint
+    Param
+    ParamCollection
+    PositionalParam
+    NamedParam
+    UnpackedParam
+/];
+
+subtype VariableName,
+    as Str,
+    where { /^[\$@%](?:[a-z_][a-z_\d]*)?$/i },
+    message { 'not a valid variable name' };
+
+subtype TypeConstraint,
+    as 'Moose::Meta::TypeConstraint';
+
+class_type Param, { class => 'Parse::Method::Signatures::Param' };
+
+class_type ParamCollection, { class => 'Parse::Method::Signatures::ParamCollection' };
+
+coerce ParamCollection,
+    from ArrayRef,
+    via { Parse::Method::Signatures::ParamCollection->new(params => $_) };
+
+role_type PositionalParam, { role => 'Parse::Method::Signatures::Param::Positional' };
+role_type NamedParam,      { role => 'Parse::Method::Signatures::Param::Named'      };
+role_type UnpackedParam,   { role => 'Parse::Method::Signatures::Param::Unpacked'   };
+
+1;