Initial Commit
This commit is contained in:
57
database/perl/vendor/lib/MooseX/Role/Parameterized/Meta/Role/Parameterized.pm
vendored
Normal file
57
database/perl/vendor/lib/MooseX/Role/Parameterized/Meta/Role/Parameterized.pm
vendored
Normal file
@@ -0,0 +1,57 @@
|
||||
package MooseX::Role::Parameterized::Meta::Role::Parameterized;
|
||||
# ABSTRACT: metaclass for parameterized roles
|
||||
|
||||
our $VERSION = '1.11';
|
||||
|
||||
use Moose;
|
||||
extends 'Moose::Meta::Role';
|
||||
with 'MooseX::Role::Parameterized::Meta::Trait::Parameterized';
|
||||
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
no Moose;
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterized::Meta::Role::Parameterized - metaclass for parameterized roles
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is the metaclass for parameterized roles; that is, parameterizable roles
|
||||
with their parameters bound. See
|
||||
L<MooseX::Role::Parameterized::Meta::Trait::Parameterized> which has all the guts.
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Role-Parameterized>
|
||||
(or L<bug-MooseX-Role-Parameterized@rt.cpan.org|mailto:bug-MooseX-Role-Parameterized@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 AUTHOR
|
||||
|
||||
Shawn M Moore <code@sartak.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Shawn M Moore.
|
||||
|
||||
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
|
||||
262
database/perl/vendor/lib/MooseX/Role/Parameterized/Meta/Trait/Parameterizable.pm
vendored
Normal file
262
database/perl/vendor/lib/MooseX/Role/Parameterized/Meta/Trait/Parameterizable.pm
vendored
Normal file
@@ -0,0 +1,262 @@
|
||||
package MooseX::Role::Parameterized::Meta::Trait::Parameterizable;
|
||||
# ABSTRACT: trait for parameterizable roles
|
||||
|
||||
our $VERSION = '1.11';
|
||||
|
||||
use Moose::Role;
|
||||
use MooseX::Role::Parameterized::Meta::Role::Parameterized;
|
||||
use MooseX::Role::Parameterized::Parameters;
|
||||
use Module::Runtime 'use_module';
|
||||
use namespace::autoclean;
|
||||
|
||||
has parameterized_role_metaclass => (
|
||||
is => 'ro',
|
||||
isa => 'ClassName',
|
||||
default => 'MooseX::Role::Parameterized::Meta::Role::Parameterized',
|
||||
);
|
||||
|
||||
has parameters_class => (
|
||||
is => 'ro',
|
||||
isa => 'ClassName',
|
||||
default => 'MooseX::Role::Parameterized::Parameters',
|
||||
);
|
||||
|
||||
has parameters_metaclass => (
|
||||
is => 'rw',
|
||||
isa => 'Moose::Meta::Class',
|
||||
lazy => 1,
|
||||
builder => '_build_parameters_metaclass',
|
||||
handles => {
|
||||
has_parameter => 'has_attribute',
|
||||
add_parameter => 'add_attribute',
|
||||
construct_parameters => 'new_object',
|
||||
},
|
||||
predicate => '_has_parameters_metaclass',
|
||||
);
|
||||
|
||||
has role_generator => (
|
||||
is => 'rw',
|
||||
isa => 'CodeRef',
|
||||
predicate => 'has_role_generator',
|
||||
);
|
||||
|
||||
sub _build_parameters_metaclass {
|
||||
my $self = shift;
|
||||
|
||||
return $self->parameters_class->meta->create_anon_class(
|
||||
superclasses => [$self->parameters_class],
|
||||
);
|
||||
}
|
||||
|
||||
my $package_counter = 0;
|
||||
sub generate_role {
|
||||
my $self = shift;
|
||||
my %args = @_;
|
||||
|
||||
my $parameters = blessed($args{parameters})
|
||||
? $args{parameters}
|
||||
: $self->construct_parameters(%{ $args{parameters} });
|
||||
|
||||
confess "A role generator is required to apply parameterized roles (did you forget the 'role { ... }' block in your parameterized role '".$self->name."'?)"
|
||||
unless $self->has_role_generator;
|
||||
|
||||
my $parameterized_role_metaclass = $self->parameterized_role_metaclass;
|
||||
use_module($parameterized_role_metaclass);
|
||||
|
||||
my $package = $args{package};
|
||||
unless ($package) {
|
||||
$package_counter++;
|
||||
$package = $self->name . '::__ANON__::SERIAL::' . $package_counter;
|
||||
}
|
||||
my $role = $parameterized_role_metaclass->create(
|
||||
$package,
|
||||
genitor => $self,
|
||||
parameters => $parameters,
|
||||
);
|
||||
|
||||
local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
|
||||
|
||||
# The generate_role method is being called directly by things like
|
||||
# MooseX::ClassCompositor. We don't want to force such modules to pass
|
||||
# this arg so we default to something sane.
|
||||
my $orig_apply = $args{orig_apply} || Moose::Meta::Role->can('apply');
|
||||
$self->$orig_apply($role);
|
||||
|
||||
$self->role_generator->($parameters,
|
||||
operating_on => $role,
|
||||
consumer => $args{consumer},
|
||||
);
|
||||
|
||||
# don't just return $role here, because it might have been changed when
|
||||
# metaroles are applied
|
||||
return $MooseX::Role::Parameterized::CURRENT_METACLASS;
|
||||
}
|
||||
|
||||
sub _role_for_combination {
|
||||
my $self = shift;
|
||||
my $parameters = shift;
|
||||
|
||||
return $self->generate_role(
|
||||
parameters => $parameters,
|
||||
);
|
||||
}
|
||||
|
||||
around apply => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
my $consumer = shift;
|
||||
my %args = @_;
|
||||
|
||||
my $role = $self->generate_role(
|
||||
consumer => $consumer,
|
||||
parameters => \%args,
|
||||
orig_apply => $orig,
|
||||
);
|
||||
|
||||
$role->apply($consumer, %args);
|
||||
};
|
||||
|
||||
around reinitialize => sub {
|
||||
my $orig = shift;
|
||||
my $class = shift;
|
||||
my ($pkg) = @_;
|
||||
my $meta = blessed($pkg) ? $pkg : find_meta($pkg);
|
||||
|
||||
my $meta_meta = $meta->meta;
|
||||
|
||||
my %p;
|
||||
if ( $meta_meta->can('does_role') && $meta_meta->does_role(__PACKAGE__) ) {
|
||||
%p = map { $_ => $meta->$_ }
|
||||
qw( parameterized_role_metaclass parameters_class );
|
||||
$p{parameters_metaclass} = $meta->parameters_metaclass
|
||||
if $meta->_has_parameters_metaclass;
|
||||
$p{role_generator} = $meta->role_generator
|
||||
if $meta->has_role_generator;
|
||||
}
|
||||
|
||||
my $new = $class->$orig(
|
||||
@_,
|
||||
%p,
|
||||
);
|
||||
|
||||
return $new;
|
||||
};
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterized::Meta::Trait::Parameterizable - trait for parameterizable roles
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is the trait that is applied to the metaclass for parameterizable roles,
|
||||
roles that have their parameters currently unbound. These are the roles that
|
||||
you use L<Moose/with>, but instead of composing the parameterizable role, we
|
||||
construct a new parameterized role
|
||||
(L<MooseX::Role::Parameterized::Meta::Role::Parameterized>) and use that new
|
||||
parameterized role instead.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=head2 parameterized_role_metaclass
|
||||
|
||||
The name of the class that will be used to construct the parameterized role.
|
||||
|
||||
=head2 parameters_class
|
||||
|
||||
The name of the class that will be used to construct the parameters object.
|
||||
|
||||
=head2 parameters_metaclass
|
||||
|
||||
A metaclass representing this role's parameters. It will be an anonymous
|
||||
subclass of L</parameters_class>. Each call to
|
||||
L<MooseX::Role::Parameters/parameter> adds an attribute to this metaclass.
|
||||
|
||||
When this role is consumed, the parameters object will be instantiated using
|
||||
this metaclass.
|
||||
|
||||
=head2 role_generator
|
||||
|
||||
A code reference that is used to generate a role based on the parameters
|
||||
provided by the consumer. The user usually specifies it using the
|
||||
L<MooseX::Role::Parameterized/role> keyword.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 add_parameter $name, %options
|
||||
|
||||
Delegates to L<Moose::Meta::Class/add_attribute> on the
|
||||
L</parameters_metaclass> object.
|
||||
|
||||
=head2 construct_parameters %arguments
|
||||
|
||||
Creates a new L<MooseX::Role::Parameterized::Parameters> object using metaclass
|
||||
L</parameters_metaclass>.
|
||||
|
||||
The arguments are those specified by the consumer as parameter values.
|
||||
|
||||
=head2 generate_role %arguments
|
||||
|
||||
This method generates and returns a new instance of
|
||||
L</parameterized_role_metaclass>. It can take any combination of
|
||||
three named arguments:
|
||||
|
||||
=over 4
|
||||
|
||||
=item parameters
|
||||
|
||||
A hashref of parameters for the role, same as would be passed in at a "with"
|
||||
statement.
|
||||
|
||||
=item package
|
||||
|
||||
A package name that, if present, we will use for the generated role; if not,
|
||||
we generate an anonymous role.
|
||||
|
||||
=item consumer
|
||||
|
||||
=for stopwords metaobject
|
||||
|
||||
A consumer metaobject, if available.
|
||||
|
||||
=back
|
||||
|
||||
=head2 apply
|
||||
|
||||
Overrides L<Moose::Meta::Role/apply> to automatically generate the
|
||||
parameterized role.
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Role-Parameterized>
|
||||
(or L<bug-MooseX-Role-Parameterized@rt.cpan.org|mailto:bug-MooseX-Role-Parameterized@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 AUTHOR
|
||||
|
||||
Shawn M Moore <code@sartak.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Shawn M Moore.
|
||||
|
||||
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
|
||||
101
database/perl/vendor/lib/MooseX/Role/Parameterized/Meta/Trait/Parameterized.pm
vendored
Normal file
101
database/perl/vendor/lib/MooseX/Role/Parameterized/Meta/Trait/Parameterized.pm
vendored
Normal file
@@ -0,0 +1,101 @@
|
||||
package MooseX::Role::Parameterized::Meta::Trait::Parameterized;
|
||||
# ABSTRACT: trait for parameterized roles
|
||||
|
||||
our $VERSION = '1.11';
|
||||
|
||||
use Moose::Role;
|
||||
use MooseX::Role::Parameterized::Parameters;
|
||||
use Moose::Util 'find_meta';
|
||||
use namespace::autoclean;
|
||||
|
||||
has genitor => (
|
||||
is => 'ro',
|
||||
does => 'MooseX::Role::Parameterized::Meta::Trait::Parameterizable',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has parameters => (
|
||||
is => 'rw',
|
||||
isa => 'MooseX::Role::Parameterized::Parameters',
|
||||
);
|
||||
|
||||
around reinitialize => sub {
|
||||
my $orig = shift;
|
||||
my $class = shift;
|
||||
my ($pkg) = @_;
|
||||
my $meta = blessed($pkg) ? $pkg : find_meta($pkg);
|
||||
|
||||
my $genitor = $meta->genitor;
|
||||
my $parameters = $meta->parameters;
|
||||
|
||||
my $new = $class->$orig(
|
||||
@_,
|
||||
(defined($genitor) ? (genitor => $genitor) : ()),
|
||||
(defined($parameters) ? (parameters => $parameters) : ()),
|
||||
);
|
||||
# in case the role metaclass was reinitialized
|
||||
$MooseX::Role::Parameterized::CURRENT_METACLASS = $new;
|
||||
return $new;
|
||||
};
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterized::Meta::Trait::Parameterized - trait for parameterized roles
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is the trait for parameterized roles; that is, parameterizable roles with
|
||||
their parameters bound. All this actually provides is a place to store the
|
||||
L<MooseX::Role::Parameterized::Parameters> object as well as the
|
||||
L<MooseX::Role::Parameterized::Meta::Role::Parameterizable> object that
|
||||
generated this role object.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=for stopwords genitor metaobject
|
||||
|
||||
=head2 genitor
|
||||
|
||||
Returns the L<MooseX::Role::Parameterized::Meta::Role::Parameterizable>
|
||||
metaobject that generated this role.
|
||||
|
||||
=head2 parameters
|
||||
|
||||
Returns the L<MooseX::Role::Parameterized::Parameters> object that represents
|
||||
the specific parameter values for this parameterized role.
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Role-Parameterized>
|
||||
(or L<bug-MooseX-Role-Parameterized@rt.cpan.org|mailto:bug-MooseX-Role-Parameterized@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 AUTHOR
|
||||
|
||||
Shawn M Moore <code@sartak.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Shawn M Moore.
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user