Initial Commit
This commit is contained in:
204
database/perl/vendor/lib/MooseX/ClassAttribute.pm
vendored
Normal file
204
database/perl/vendor/lib/MooseX/ClassAttribute.pm
vendored
Normal file
@@ -0,0 +1,204 @@
|
||||
package MooseX::ClassAttribute;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
# This module doesn't really need these pragmas - this is just for the benefit
|
||||
# of prereq scanning.
|
||||
use namespace::clean 0.20 ();
|
||||
use namespace::autoclean 0.11 ();
|
||||
|
||||
use Moose 2.00 ();
|
||||
use Moose::Exporter;
|
||||
use Moose::Util;
|
||||
use MooseX::ClassAttribute::Trait::Class;
|
||||
use MooseX::ClassAttribute::Trait::Role;
|
||||
use MooseX::ClassAttribute::Trait::Application::ToClass;
|
||||
use MooseX::ClassAttribute::Trait::Application::ToRole;
|
||||
|
||||
Moose::Exporter->setup_import_methods(
|
||||
with_meta => ['class_has'],
|
||||
class_metaroles => {
|
||||
class => ['MooseX::ClassAttribute::Trait::Class'],
|
||||
},
|
||||
role_metaroles => {
|
||||
role => ['MooseX::ClassAttribute::Trait::Role'],
|
||||
application_to_class =>
|
||||
['MooseX::ClassAttribute::Trait::Application::ToClass'],
|
||||
application_to_role =>
|
||||
['MooseX::ClassAttribute::Trait::Application::ToRole'],
|
||||
},
|
||||
);
|
||||
|
||||
sub class_has {
|
||||
my $meta = shift;
|
||||
my $name = shift;
|
||||
|
||||
my $attrs = ref $name eq 'ARRAY' ? $name : [$name];
|
||||
|
||||
my %options = ( definition_context => _caller_info(), @_ );
|
||||
|
||||
$meta->add_class_attribute( $_, %options ) for @{$attrs};
|
||||
}
|
||||
|
||||
# Copied from Moose::Util in 2.06
|
||||
sub _caller_info {
|
||||
my $level = @_ ? ( $_[0] + 1 ) : 2;
|
||||
my %info;
|
||||
@info{qw(package file line)} = caller($level);
|
||||
return \%info;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: Declare class attributes Moose-style
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute - Declare class attributes Moose-style
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package My::Class;
|
||||
|
||||
use Moose;
|
||||
use MooseX::ClassAttribute;
|
||||
|
||||
class_has 'Cache' =>
|
||||
( is => 'rw',
|
||||
isa => 'HashRef',
|
||||
default => sub { {} },
|
||||
);
|
||||
|
||||
__PACKAGE__->meta()->make_immutable();
|
||||
|
||||
no Moose;
|
||||
no MooseX::ClassAttribute;
|
||||
|
||||
# then later ...
|
||||
|
||||
My::Class->Cache()->{thing} = ...;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module allows you to declare class attributes in exactly the same
|
||||
way as object attributes, using C<class_has()> instead of C<has()>.
|
||||
|
||||
You can use any feature of Moose's attribute declarations, including
|
||||
overriding a parent's attributes, delegation (C<handles>), attribute traits,
|
||||
etc. All features should just work. The one exception is the "required" flag,
|
||||
which is not allowed for class attributes.
|
||||
|
||||
The accessor methods for class attribute may be called on the class
|
||||
directly, or on objects of that class. Passing a class attribute to
|
||||
the constructor will not set that attribute.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
This class exports one function when you use it, C<class_has()>. This
|
||||
works exactly like Moose's C<has()>, but it declares class attributes.
|
||||
|
||||
One little nit is that if you include C<no Moose> in your class, you won't
|
||||
remove the C<class_has()> function. To do that you must include C<no
|
||||
MooseX::ClassAttribute> as well. Or you can just use L<namespace::autoclean>
|
||||
instead.
|
||||
|
||||
=head2 Implementation and Immutability
|
||||
|
||||
This module will add a role to your class's metaclass, See
|
||||
L<MooseX::ClassAttribute::Trait::Class> for details. This role
|
||||
provides introspection methods for class attributes.
|
||||
|
||||
Class attributes themselves do the
|
||||
L<MooseX::ClassAttribute::Trait::Attribute> role.
|
||||
|
||||
=head2 Cooperation with Metaclasses and Traits
|
||||
|
||||
This module should work with most attribute metaclasses and traits,
|
||||
but it's possible that conflicts could occur. This module has been
|
||||
tested to work with Moose's native traits.
|
||||
|
||||
=head2 Class Attributes in Roles
|
||||
|
||||
You can add a class attribute to a role. When that role is applied to a class,
|
||||
the class will have the relevant class attributes added. Note that attribute
|
||||
defaults will be calculated when the class attribute is composed into the
|
||||
class.
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 DONATIONS
|
||||
|
||||
If you'd like to thank me for the work I've done on this module, please
|
||||
consider making a "donation" to me via PayPal. I spend a lot of free time
|
||||
creating free software, and would appreciate any support you'd care to offer.
|
||||
|
||||
Please note that B<I am not suggesting that you must do this> in order for me
|
||||
to continue working on this particular software. I will continue to do so,
|
||||
inasmuch as I have in the past, for as long as it interests me.
|
||||
|
||||
Similarly, a donation made in this way will probably not make me work on this
|
||||
software much more, unless I get so many donations that I can consider working
|
||||
on free software full time (let's all have a chuckle at that together).
|
||||
|
||||
To donate, log into PayPal and send money to autarch@urth.org, or use the
|
||||
button at L<http://www.urth.org/~autarch/fs-donation.html>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 CONTRIBUTORS
|
||||
|
||||
=for stopwords Andrew Rodland Karen Etheridge Rafael Kitover Robert Buels Shawn M Moore
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Andrew Rodland <andrew@cleverdomain.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Rafael Kitover <rkitover@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Robert Buels <rmb32@cornell.edu>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@gmail.com>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
69
database/perl/vendor/lib/MooseX/ClassAttribute/Meta/Role/Attribute.pm
vendored
Normal file
69
database/perl/vendor/lib/MooseX/ClassAttribute/Meta/Role/Attribute.pm
vendored
Normal file
@@ -0,0 +1,69 @@
|
||||
package MooseX::ClassAttribute::Meta::Role::Attribute;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose;
|
||||
use List::Util 1.45 'uniq';
|
||||
|
||||
extends 'Moose::Meta::Role::Attribute';
|
||||
|
||||
sub new {
|
||||
my ( $class, $name, %options ) = @_;
|
||||
|
||||
$options{traits} = [
|
||||
uniq( @{ $options{traits} || [] } ),
|
||||
'MooseX::ClassAttribute::Trait::Attribute'
|
||||
];
|
||||
|
||||
return $class->SUPER::new( $name, %options );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: An attribute metaclass for class attributes in roles
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Meta::Role::Attribute - An attribute metaclass for class attributes in roles
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This class overrides L<Moose::Meta::Role::Attribute> to support class
|
||||
attribute declaration in roles.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
59
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Application.pm
vendored
Normal file
59
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Application.pm
vendored
Normal file
@@ -0,0 +1,59 @@
|
||||
package MooseX::ClassAttribute::Trait::Application;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
after apply_attributes => sub {
|
||||
shift->_apply_class_attributes(@_);
|
||||
};
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A trait that supports role application for roles with class attributes
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Application - A trait that supports role application for roles with class attributes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This trait is used to allow the application of roles containing class
|
||||
attributes.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
94
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Application/ToClass.pm
vendored
Normal file
94
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Application/ToClass.pm
vendored
Normal file
@@ -0,0 +1,94 @@
|
||||
package MooseX::ClassAttribute::Trait::Application::ToClass;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
with 'MooseX::ClassAttribute::Trait::Application';
|
||||
|
||||
around apply => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
my $role = shift;
|
||||
my $class = shift;
|
||||
|
||||
$class = Moose::Util::MetaRole::apply_metaroles(
|
||||
for => $class,
|
||||
class_metaroles => {
|
||||
class => ['MooseX::ClassAttribute::Trait::Class'],
|
||||
},
|
||||
);
|
||||
|
||||
$self->$orig( $role, $class );
|
||||
};
|
||||
|
||||
sub _apply_class_attributes {
|
||||
my $self = shift;
|
||||
my $role = shift;
|
||||
my $class = shift;
|
||||
|
||||
my $attr_metaclass = $class->attribute_metaclass();
|
||||
|
||||
foreach my $attribute_name ( $role->get_class_attribute_list() ) {
|
||||
if ( $class->has_class_attribute($attribute_name)
|
||||
&& $class->get_class_attribute($attribute_name)
|
||||
!= $role->get_class_attribute($attribute_name) ) {
|
||||
next;
|
||||
}
|
||||
else {
|
||||
$class->add_class_attribute(
|
||||
$role->get_class_attribute($attribute_name)
|
||||
->attribute_for_class($attr_metaclass) );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A trait that supports applying class attributes to classes
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Application::ToClass - A trait that supports applying class attributes to classes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This trait is used to allow the application of roles containing class
|
||||
attributes to classes.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
104
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Application/ToRole.pm
vendored
Normal file
104
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Application/ToRole.pm
vendored
Normal file
@@ -0,0 +1,104 @@
|
||||
package MooseX::ClassAttribute::Trait::Application::ToRole;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use Moose::Util::MetaRole;
|
||||
use MooseX::ClassAttribute::Trait::Application::ToClass;
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
with 'MooseX::ClassAttribute::Trait::Application';
|
||||
|
||||
around apply => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
my $role1 = shift;
|
||||
my $role2 = shift;
|
||||
|
||||
$role2 = Moose::Util::MetaRole::apply_metaroles(
|
||||
for => $role2,
|
||||
role_metaroles => {
|
||||
role => ['MooseX::ClassAttribute::Trait::Role'],
|
||||
application_to_class =>
|
||||
['MooseX::ClassAttribute::Trait::Application::ToClass'],
|
||||
application_to_role =>
|
||||
['MooseX::ClassAttribute::Trait::Application::ToRole'],
|
||||
},
|
||||
);
|
||||
|
||||
$self->$orig( $role1, $role2 );
|
||||
};
|
||||
|
||||
sub _apply_class_attributes {
|
||||
my $self = shift;
|
||||
my $role1 = shift;
|
||||
my $role2 = shift;
|
||||
|
||||
foreach my $attribute_name ( $role1->get_class_attribute_list() ) {
|
||||
if ( $role2->has_class_attribute($attribute_name)
|
||||
&& $role2->get_class_attribute($attribute_name)
|
||||
!= $role1->get_class_attribute($attribute_name) ) {
|
||||
|
||||
require Moose;
|
||||
Moose->throw_error( "Role '"
|
||||
. $role1->name()
|
||||
. "' has encountered a class attribute conflict "
|
||||
. "during composition. This is fatal error and cannot be disambiguated."
|
||||
);
|
||||
}
|
||||
else {
|
||||
$role2->add_class_attribute(
|
||||
$role1->get_class_attribute($attribute_name)->clone() );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A trait that supports applying class attributes to roles
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Application::ToRole - A trait that supports applying class attributes to roles
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This trait is used to allow the application of roles containing class
|
||||
attributes to roles.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
268
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Attribute.pm
vendored
Normal file
268
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Attribute.pm
vendored
Normal file
@@ -0,0 +1,268 @@
|
||||
package MooseX::ClassAttribute::Trait::Attribute;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
# This is the worst role evar! Really, this should be a subclass,
|
||||
# because it overrides a lot of behavior. However, as a subclass it
|
||||
# won't cooperate with _other_ subclasses.
|
||||
|
||||
around _process_options => sub {
|
||||
my $orig = shift;
|
||||
my $class = shift;
|
||||
my $name = shift;
|
||||
my $options = shift;
|
||||
|
||||
confess 'A class attribute cannot be required'
|
||||
if $options->{required};
|
||||
|
||||
return $class->$orig( $name, $options );
|
||||
};
|
||||
|
||||
after attach_to_class => sub {
|
||||
my $self = shift;
|
||||
my $meta = shift;
|
||||
|
||||
$self->_initialize($meta)
|
||||
unless $self->is_lazy();
|
||||
};
|
||||
|
||||
before detach_from_class => sub {
|
||||
my $self = shift;
|
||||
my $meta = shift;
|
||||
|
||||
$self->clear_value($meta);
|
||||
};
|
||||
|
||||
sub _initialize {
|
||||
my $self = shift;
|
||||
my $metaclass = shift;
|
||||
|
||||
if ( $self->has_default() ) {
|
||||
$self->set_value(
|
||||
undef,
|
||||
$self->default( $self->associated_class() )
|
||||
);
|
||||
}
|
||||
elsif ( $self->has_builder() ) {
|
||||
$self->set_value( undef, $self->_call_builder( $metaclass->name() ) );
|
||||
}
|
||||
}
|
||||
|
||||
around default => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
|
||||
my $default = $self->$orig();
|
||||
|
||||
if ( $self->is_default_a_coderef() && @_ ) {
|
||||
return $default->(@_);
|
||||
}
|
||||
|
||||
return $default;
|
||||
};
|
||||
|
||||
around _call_builder => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
my $class = shift;
|
||||
|
||||
my $builder = $self->builder();
|
||||
|
||||
return $class->$builder()
|
||||
if $class->can( $self->builder );
|
||||
|
||||
confess( "$class does not support builder method '"
|
||||
. $self->builder
|
||||
. "' for attribute '"
|
||||
. $self->name
|
||||
. "'" );
|
||||
};
|
||||
|
||||
around set_value => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
shift; # ignoring instance or class name
|
||||
my $value = shift;
|
||||
|
||||
$self->associated_class()
|
||||
->set_class_attribute_value( $self->name() => $value );
|
||||
};
|
||||
|
||||
around get_value => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->get_class_attribute_value( $self->name() );
|
||||
};
|
||||
|
||||
around has_value => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->has_class_attribute_value( $self->name() );
|
||||
};
|
||||
|
||||
around clear_value => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->clear_class_attribute_value( $self->name() );
|
||||
};
|
||||
|
||||
if ( $Moose::VERSION < 1.99 ) {
|
||||
around inline_get => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->_inline_get_class_slot_value( $self->slots() );
|
||||
};
|
||||
|
||||
around inline_set => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
shift;
|
||||
my $value = shift;
|
||||
|
||||
my $meta = $self->associated_class();
|
||||
|
||||
my $code
|
||||
= $meta->_inline_set_class_slot_value( $self->slots(), $value )
|
||||
. ";";
|
||||
$code .= $meta->_inline_weaken_class_slot_value(
|
||||
$self->slots(),
|
||||
$value
|
||||
)
|
||||
. " if ref $value;"
|
||||
if $self->is_weak_ref();
|
||||
|
||||
return $code;
|
||||
};
|
||||
|
||||
around inline_has => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->_inline_is_class_slot_initialized( $self->slots() );
|
||||
};
|
||||
|
||||
around inline_clear => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->_inline_deinitialize_class_slot( $self->slots() );
|
||||
};
|
||||
}
|
||||
else {
|
||||
around _inline_instance_get => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->_inline_get_class_slot_value( $self->slots() );
|
||||
};
|
||||
|
||||
around _inline_instance_set => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
shift;
|
||||
my $value = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->_inline_set_class_slot_value( $self->slots(), $value );
|
||||
};
|
||||
|
||||
around _inline_instance_has => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->_inline_is_class_slot_initialized( $self->slots() );
|
||||
};
|
||||
|
||||
around _inline_instance_clear => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->associated_class()
|
||||
->_inline_deinitialize_class_slot( $self->slots() );
|
||||
};
|
||||
|
||||
around _inline_weaken_value => sub {
|
||||
shift;
|
||||
my $self = shift;
|
||||
shift;
|
||||
my $value = shift;
|
||||
|
||||
return unless $self->is_weak_ref();
|
||||
|
||||
return (
|
||||
$self->associated_class->_inline_weaken_class_slot_value(
|
||||
$self->slots(), $value
|
||||
),
|
||||
'if ref ' . $value . ';',
|
||||
);
|
||||
};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A trait for class attributes
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Attribute - A trait for class attributes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role modifies the behavior of class attributes in various
|
||||
ways. It really should be a subclass of C<Moose::Meta::Attribute>, but
|
||||
if it were then it couldn't be combined with other attribute
|
||||
metaclasses, like C<MooseX::AttributeHelpers>.
|
||||
|
||||
There are no new public methods implemented by this role. All it does
|
||||
is change the behavior of a number of existing methods.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
329
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Class.pm
vendored
Normal file
329
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Class.pm
vendored
Normal file
@@ -0,0 +1,329 @@
|
||||
package MooseX::ClassAttribute::Trait::Class;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use MooseX::ClassAttribute::Trait::Attribute;
|
||||
use Scalar::Util qw( blessed );
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
with 'MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes';
|
||||
|
||||
has _class_attribute_values => (
|
||||
traits => ['Hash'],
|
||||
is => 'ro',
|
||||
isa => 'HashRef',
|
||||
handles => {
|
||||
'get_class_attribute_value' => 'get',
|
||||
'set_class_attribute_value' => 'set',
|
||||
'has_class_attribute_value' => 'exists',
|
||||
'clear_class_attribute_value' => 'delete',
|
||||
},
|
||||
lazy => 1,
|
||||
default => sub { $_[0]->_class_attribute_values_hashref() },
|
||||
init_arg => undef,
|
||||
);
|
||||
|
||||
around add_class_attribute => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
my $attr = (
|
||||
blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
|
||||
? $_[0]
|
||||
: $self->_process_class_attribute(@_)
|
||||
);
|
||||
|
||||
$self->$orig($attr);
|
||||
|
||||
return $attr;
|
||||
};
|
||||
|
||||
sub _post_add_class_attribute {
|
||||
my $self = shift;
|
||||
my $attr = shift;
|
||||
|
||||
my $name = $attr->name();
|
||||
|
||||
my $e = do {
|
||||
local $@;
|
||||
eval { $attr->install_accessors() };
|
||||
$@;
|
||||
};
|
||||
|
||||
if ($e) {
|
||||
$self->remove_attribute($name);
|
||||
die $e;
|
||||
}
|
||||
}
|
||||
|
||||
sub _attach_class_attribute {
|
||||
my ( $self, $attribute ) = @_;
|
||||
$attribute->attach_to_class($self);
|
||||
}
|
||||
|
||||
# It'd be nice if I didn't have to replicate this for class
|
||||
# attributes, since it's basically just a copy of
|
||||
# Moose::Meta::Class->_process_attribute
|
||||
sub _process_class_attribute {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my @args = @_;
|
||||
|
||||
@args = %{ $args[0] } if scalar @args == 1 && ref( $args[0] ) eq 'HASH';
|
||||
|
||||
if ( $name =~ /^\+(.*)/ ) {
|
||||
return $self->_process_inherited_class_attribute( $1, @args );
|
||||
}
|
||||
else {
|
||||
return $self->_process_new_class_attribute( $name, @args );
|
||||
}
|
||||
}
|
||||
|
||||
sub _process_new_class_attribute {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my %p = @_;
|
||||
|
||||
if ( $p{traits} ) {
|
||||
push @{ $p{traits} }, 'MooseX::ClassAttribute::Trait::Attribute';
|
||||
}
|
||||
else {
|
||||
$p{traits} = ['MooseX::ClassAttribute::Trait::Attribute'];
|
||||
}
|
||||
|
||||
return Moose::Meta::Attribute->interpolate_class_and_new( $name, %p );
|
||||
}
|
||||
|
||||
sub _process_inherited_class_attribute {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my %p = @_;
|
||||
|
||||
my $inherited_attr = $self->find_class_attribute_by_name($name);
|
||||
|
||||
( defined $inherited_attr )
|
||||
|| confess
|
||||
"Could not find an attribute by the name of '$name' to inherit from";
|
||||
|
||||
return $inherited_attr->clone_and_inherit_options(%p);
|
||||
}
|
||||
|
||||
around remove_class_attribute => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
|
||||
my $removed_attr = $self->$orig(@_)
|
||||
or return;
|
||||
|
||||
$removed_attr->remove_accessors();
|
||||
$removed_attr->detach_from_class();
|
||||
|
||||
return $removed_attr;
|
||||
};
|
||||
|
||||
sub get_all_class_attributes {
|
||||
my $self = shift;
|
||||
|
||||
my %attrs = map {
|
||||
my $meta = Class::MOP::class_of($_);
|
||||
$meta && $meta->can('_class_attribute_map')
|
||||
? %{ $meta->_class_attribute_map() }
|
||||
: ()
|
||||
}
|
||||
reverse $self->linearized_isa;
|
||||
|
||||
return values %attrs;
|
||||
}
|
||||
|
||||
sub compute_all_applicable_class_attributes {
|
||||
warn
|
||||
'The compute_all_applicable_class_attributes method has been deprecated.'
|
||||
. " Use get_all_class_attributes instead.\n";
|
||||
|
||||
shift->compute_all_applicable_class_attributes(@_);
|
||||
}
|
||||
|
||||
sub find_class_attribute_by_name {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
foreach my $class ( $self->linearized_isa() ) {
|
||||
my $meta = Class::MOP::class_of($class)
|
||||
or next;
|
||||
|
||||
return $meta->get_class_attribute($name)
|
||||
if $meta->can('has_class_attribute')
|
||||
&& $meta->has_class_attribute($name);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _class_attribute_values_hashref {
|
||||
my $self = shift;
|
||||
|
||||
no strict 'refs';
|
||||
return \%{ $self->_class_attribute_var_name() };
|
||||
}
|
||||
|
||||
sub _class_attribute_var_name {
|
||||
my $self = shift;
|
||||
|
||||
return $self->name() . q'::__ClassAttributeValues';
|
||||
}
|
||||
|
||||
sub _inline_class_slot_access {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
return
|
||||
'$'
|
||||
. $self->_class_attribute_var_name . '{"'
|
||||
. quotemeta($name) . '"}';
|
||||
}
|
||||
|
||||
sub _inline_get_class_slot_value {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
return $self->_inline_class_slot_access($name);
|
||||
}
|
||||
|
||||
sub _inline_set_class_slot_value {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $val_name = shift;
|
||||
|
||||
return $self->_inline_class_slot_access($name) . ' = ' . $val_name;
|
||||
}
|
||||
|
||||
sub _inline_is_class_slot_initialized {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
return 'exists ' . $self->_inline_class_slot_access($name);
|
||||
}
|
||||
|
||||
sub _inline_deinitialize_class_slot {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
return 'delete ' . $self->_inline_class_slot_access($name);
|
||||
}
|
||||
|
||||
sub _inline_weaken_class_slot_value {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
return
|
||||
'Scalar::Util::weaken( '
|
||||
. $self->_inline_class_slot_access($name) . ')';
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A trait for classes with class attributes
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Class - A trait for classes with class attributes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() )
|
||||
{
|
||||
print $attr->name();
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role adds awareness of class attributes to a metaclass object. It
|
||||
provides a set of introspection methods that largely parallel the
|
||||
existing attribute methods, except they operate on class attributes.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
Every method provided by this role has an analogous method in
|
||||
C<Class::MOP::Class> or C<Moose::Meta::Class> for regular attributes.
|
||||
|
||||
=head2 $meta->has_class_attribute($name)
|
||||
|
||||
=head2 $meta->get_class_attribute($name)
|
||||
|
||||
=head2 $meta->get_class_attribute_list()
|
||||
|
||||
These methods operate on the current metaclass only.
|
||||
|
||||
=head2 $meta->add_class_attribute(...)
|
||||
|
||||
This accepts the same options as the L<Moose::Meta::Attribute>
|
||||
C<add_attribute()> method. However, if an attribute is specified as
|
||||
"required" an error will be thrown.
|
||||
|
||||
=head2 $meta->remove_class_attribute($name)
|
||||
|
||||
If the named class attribute exists, it is removed from the class,
|
||||
along with its accessor methods.
|
||||
|
||||
=head2 $meta->get_all_class_attributes()
|
||||
|
||||
This method returns a list of attribute objects for the class and all
|
||||
its parent classes.
|
||||
|
||||
=head2 $meta->find_class_attribute_by_name($name)
|
||||
|
||||
This method looks at the class and all its parent classes for the
|
||||
named class attribute.
|
||||
|
||||
=head2 $meta->get_class_attribute_value($name)
|
||||
|
||||
=head2 $meta->set_class_attribute_value($name, $value)
|
||||
|
||||
=head2 $meta->set_class_attribute_value($name)
|
||||
|
||||
=head2 $meta->clear_class_attribute_value($name)
|
||||
|
||||
These methods operate on the storage for class attribute values, which
|
||||
is attached to the metaclass object.
|
||||
|
||||
There's really no good reason for you to call these methods unless
|
||||
you're doing some deep hacking. They are named as public methods
|
||||
solely because they are used by other meta roles and classes in this
|
||||
distribution.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
124
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Mixin/HasClassAttributes.pm
vendored
Normal file
124
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Mixin/HasClassAttributes.pm
vendored
Normal file
@@ -0,0 +1,124 @@
|
||||
package MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
has _class_attribute_map => (
|
||||
traits => ['Hash'],
|
||||
is => 'ro',
|
||||
isa => 'HashRef[Class::MOP::Mixin::AttributeCore]',
|
||||
handles => {
|
||||
'_add_class_attribute' => 'set',
|
||||
'has_class_attribute' => 'exists',
|
||||
'get_class_attribute' => 'get',
|
||||
'_remove_class_attribute' => 'delete',
|
||||
'get_class_attribute_list' => 'keys',
|
||||
},
|
||||
default => sub { {} },
|
||||
init_arg => undef,
|
||||
);
|
||||
|
||||
# deprecated
|
||||
sub get_class_attribute_map {
|
||||
return $_[0]->_class_attribute_map();
|
||||
}
|
||||
|
||||
sub add_class_attribute {
|
||||
my $self = shift;
|
||||
my $attribute = shift;
|
||||
|
||||
( $attribute->isa('Class::MOP::Mixin::AttributeCore') )
|
||||
|| confess
|
||||
"Your attribute must be an instance of Class::MOP::Mixin::AttributeCore (or a subclass)";
|
||||
|
||||
$self->_attach_class_attribute($attribute);
|
||||
|
||||
my $attr_name = $attribute->name;
|
||||
|
||||
$self->remove_class_attribute($attr_name)
|
||||
if $self->has_class_attribute($attr_name);
|
||||
|
||||
my $order = ( scalar keys %{ $self->_attribute_map } );
|
||||
$attribute->_set_insertion_order($order);
|
||||
|
||||
$self->_add_class_attribute( $attr_name => $attribute );
|
||||
|
||||
# This method is called to allow for installing accessors. Ideally, we'd
|
||||
# use method overriding, but then the subclass would be responsible for
|
||||
# making the attribute, which would end up with lots of code
|
||||
# duplication. Even more ideally, we'd use augment/inner, but this is
|
||||
# Class::MOP!
|
||||
$self->_post_add_class_attribute($attribute)
|
||||
if $self->can('_post_add_class_attribute');
|
||||
|
||||
return $attribute;
|
||||
}
|
||||
|
||||
sub remove_class_attribute {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
( defined $name && $name )
|
||||
|| confess 'You must provide an attribute name';
|
||||
|
||||
my $removed_attr = $self->get_class_attribute($name);
|
||||
return unless $removed_attr;
|
||||
|
||||
$self->_remove_class_attribute($name);
|
||||
|
||||
return $removed_attr;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A mixin trait for things which have class attributes
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes - A mixin trait for things which have class attributes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This trait is like L<Class::MOP::Mixin::HasAttributes>, except that it works
|
||||
with class attributes instead of object attributes.
|
||||
|
||||
See L<MooseX::ClassAttribute::Trait::Class> and
|
||||
L<MooseX::ClassAttribute::Trait::Role> for API details.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
116
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Role.pm
vendored
Normal file
116
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Role.pm
vendored
Normal file
@@ -0,0 +1,116 @@
|
||||
package MooseX::ClassAttribute::Trait::Role;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use MooseX::ClassAttribute::Meta::Role::Attribute;
|
||||
use Scalar::Util qw( blessed );
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
with 'MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes';
|
||||
|
||||
around add_class_attribute => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
my $attr = (
|
||||
blessed $_[0] && $_[0]->isa('Class::MOP::Mixin::AttributeCore')
|
||||
? $_[0]
|
||||
: MooseX::ClassAttribute::Meta::Role::Attribute->new(@_)
|
||||
);
|
||||
|
||||
$self->$orig($attr);
|
||||
|
||||
return $attr;
|
||||
};
|
||||
|
||||
sub _attach_class_attribute {
|
||||
my ( $self, $attribute ) = @_;
|
||||
|
||||
$attribute->attach_to_role($self);
|
||||
}
|
||||
|
||||
sub composition_class_roles {
|
||||
return 'MooseX::ClassAttribute::Trait::Role::Composite';
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A trait for roles with class attributes
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Role - A trait for roles with class attributes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() )
|
||||
{
|
||||
print $attr->name();
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role adds awareness of class attributes to a role metaclass object. It
|
||||
provides a set of introspection methods that largely parallel the existing
|
||||
attribute methods, except they operate on class attributes.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
Every method provided by this role has an analogous method in
|
||||
C<Class::MOP::Class> or C<Moose::Meta::Class> for regular attributes.
|
||||
|
||||
=head2 $meta->has_class_attribute($name)
|
||||
|
||||
=head2 $meta->get_class_attribute($name)
|
||||
|
||||
=head2 $meta->get_class_attribute_list()
|
||||
|
||||
These methods are exactly like their counterparts in
|
||||
L<MooseX::ClassAttribute::Trait::Class>.
|
||||
|
||||
=head2 $meta->add_class_attribute(...)
|
||||
|
||||
This accepts the same options as the L<Moose::Meta::Attribute>
|
||||
C<add_attribute()> method. However, if an attribute is specified as
|
||||
"required" an error will be thrown.
|
||||
|
||||
=head2 $meta->remove_class_attribute($name)
|
||||
|
||||
If the named class attribute exists, it is removed from the role.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
119
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Role/Composite.pm
vendored
Normal file
119
database/perl/vendor/lib/MooseX/ClassAttribute/Trait/Role/Composite.pm
vendored
Normal file
@@ -0,0 +1,119 @@
|
||||
package MooseX::ClassAttribute::Trait::Role::Composite;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.29';
|
||||
|
||||
use Moose::Util::MetaRole;
|
||||
use Moose::Util qw(does_role);
|
||||
|
||||
use namespace::autoclean;
|
||||
use Moose::Role;
|
||||
|
||||
with 'MooseX::ClassAttribute::Trait::Role';
|
||||
|
||||
sub _merge_class_attributes {
|
||||
my $self = shift;
|
||||
|
||||
my @all_attributes;
|
||||
foreach my $role ( @{ $self->get_roles() } ) {
|
||||
if ( does_role( $role, 'MooseX::ClassAttribute::Trait::Role' ) ) {
|
||||
push @all_attributes,
|
||||
map { $role->get_class_attribute($_) }
|
||||
$role->get_class_attribute_list();
|
||||
}
|
||||
}
|
||||
|
||||
my %seen;
|
||||
|
||||
foreach my $attribute (@all_attributes) {
|
||||
my $name = $attribute->name();
|
||||
|
||||
if ( exists $seen{$name} ) {
|
||||
next if $seen{$name} == $attribute;
|
||||
|
||||
require Moose;
|
||||
Moose->throw_error( "Role '"
|
||||
. $self->name()
|
||||
. "' has encountered a class attribute conflict "
|
||||
. "during composition. This is a fatal error and "
|
||||
. "cannot be disambiguated." );
|
||||
}
|
||||
|
||||
$seen{$name} = $attribute;
|
||||
}
|
||||
|
||||
foreach my $attribute (@all_attributes) {
|
||||
$self->add_class_attribute( $attribute->clone() );
|
||||
}
|
||||
|
||||
return keys %seen;
|
||||
}
|
||||
|
||||
around apply_params => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
|
||||
$self->$orig(@_);
|
||||
|
||||
$self = Moose::Util::MetaRole::apply_metaroles(
|
||||
for => $self,
|
||||
role_metaroles => {
|
||||
application_to_class =>
|
||||
['MooseX::ClassAttribute::Trait::Application::ToClass'],
|
||||
application_to_role =>
|
||||
['MooseX::ClassAttribute::Trait::Application::ToRole'],
|
||||
},
|
||||
);
|
||||
|
||||
$self->_merge_class_attributes();
|
||||
|
||||
return $self;
|
||||
};
|
||||
|
||||
1;
|
||||
|
||||
# ABSTRACT: A trait that supports applying multiple roles at once
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::ClassAttribute::Trait::Role::Composite - A trait that supports applying multiple roles at once
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.29
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This trait is used to allow the application of multiple roles (one
|
||||
or more of which contain class attributes) to a class or role.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<MooseX::ClassAttribute> for details.
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-ClassAttribute>
|
||||
(or L<bug-moosex-classattribute@rt.cpan.org|mailto:bug-moosex-classattribute@rt.cpan.org>).
|
||||
|
||||
I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is Copyright (c) 2016 by Dave Rolsky.
|
||||
|
||||
This is free software, licensed under:
|
||||
|
||||
The Artistic License 2.0 (GPL Compatible)
|
||||
|
||||
=cut
|
||||
640
database/perl/vendor/lib/MooseX/Declare.pm
vendored
Normal file
640
database/perl/vendor/lib/MooseX/Declare.pm
vendored
Normal file
@@ -0,0 +1,640 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package MooseX::Declare; # git description: v0.42-6-gab03158
|
||||
# ABSTRACT: (DEPRECATED) Declarative syntax for Moose
|
||||
# KEYWORDS: moose extension declaration syntax sugar method class deprecated
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use aliased 'MooseX::Declare::Syntax::Keyword::Class', 'ClassKeyword';
|
||||
use aliased 'MooseX::Declare::Syntax::Keyword::Role', 'RoleKeyword';
|
||||
use aliased 'MooseX::Declare::Syntax::Keyword::Namespace', 'NamespaceKeyword';
|
||||
|
||||
use namespace::clean 0.19;
|
||||
|
||||
sub import {
|
||||
my ($class, %args) = @_;
|
||||
|
||||
my $caller = caller();
|
||||
|
||||
strict->import;
|
||||
warnings->import;
|
||||
|
||||
for my $keyword ($class->keywords) {
|
||||
$keyword->setup_for($caller, %args, provided_by => $class);
|
||||
}
|
||||
}
|
||||
|
||||
sub keywords {
|
||||
ClassKeyword->new(identifier => 'class'),
|
||||
RoleKeyword->new(identifier => 'role'),
|
||||
NamespaceKeyword->new(identifier => 'namespace'),
|
||||
}
|
||||
|
||||
#pod =head1 SYNOPSIS
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod
|
||||
#pod class BankAccount {
|
||||
#pod has 'balance' => ( isa => 'Num', is => 'rw', default => 0 );
|
||||
#pod
|
||||
#pod method deposit (Num $amount) {
|
||||
#pod $self->balance( $self->balance + $amount );
|
||||
#pod }
|
||||
#pod
|
||||
#pod method withdraw (Num $amount) {
|
||||
#pod my $current_balance = $self->balance();
|
||||
#pod ( $current_balance >= $amount )
|
||||
#pod || confess "Account overdrawn";
|
||||
#pod $self->balance( $current_balance - $amount );
|
||||
#pod }
|
||||
#pod }
|
||||
#pod
|
||||
#pod class CheckingAccount extends BankAccount {
|
||||
#pod has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );
|
||||
#pod
|
||||
#pod before withdraw (Num $amount) {
|
||||
#pod my $overdraft_amount = $amount - $self->balance();
|
||||
#pod if ( $self->overdraft_account && $overdraft_amount > 0 ) {
|
||||
#pod $self->overdraft_account->withdraw($overdraft_amount);
|
||||
#pod $self->deposit($overdraft_amount);
|
||||
#pod }
|
||||
#pod }
|
||||
#pod }
|
||||
#pod
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This module provides syntactic sugar for Moose, the postmodern object system
|
||||
#pod for Perl 5. When used, it sets up the C<class> and C<role> keywords.
|
||||
#pod
|
||||
#pod B<Note:> Please see the L</WARNING> section below!
|
||||
#pod
|
||||
#pod =head1 KEYWORDS
|
||||
#pod
|
||||
#pod =head2 class
|
||||
#pod
|
||||
#pod class Foo { ... }
|
||||
#pod
|
||||
#pod my $anon_class = class { ... };
|
||||
#pod
|
||||
#pod Declares a new class. The class can be either named or anonymous, depending on
|
||||
#pod whether or not a classname is given. Within the class definition Moose and
|
||||
#pod L<MooseX::Method::Signatures> are set up automatically in addition to the other
|
||||
#pod keywords described in this document. At the end of the definition the class
|
||||
#pod will be made immutable. namespace::autoclean is injected to clean up Moose and
|
||||
#pod other imports for you.
|
||||
#pod
|
||||
#pod Because of the way the options are parsed, you cannot have a class named "is",
|
||||
#pod "with" or "extends".
|
||||
#pod
|
||||
#pod It's possible to specify options for classes:
|
||||
#pod
|
||||
#pod =over 4
|
||||
#pod
|
||||
#pod =item extends
|
||||
#pod
|
||||
#pod class Foo extends Bar { ... }
|
||||
#pod
|
||||
#pod Sets a superclass for the class being declared.
|
||||
#pod
|
||||
#pod =item with
|
||||
#pod
|
||||
#pod class Foo with Role { ... }
|
||||
#pod class Foo with Role1 with Role2 { ... }
|
||||
#pod class Foo with (Role1, Role2) { ... }
|
||||
#pod
|
||||
#pod Applies a role or roles to the class being declared.
|
||||
#pod
|
||||
#pod =item is mutable
|
||||
#pod
|
||||
#pod class Foo is mutable { ... }
|
||||
#pod
|
||||
#pod Causes the class not to be made immutable after its definition.
|
||||
#pod
|
||||
#pod Options can also be provided for anonymous classes using the same syntax:
|
||||
#pod
|
||||
#pod my $meta_class = class with Role;
|
||||
#pod
|
||||
#pod =back
|
||||
#pod
|
||||
#pod =head2 role
|
||||
#pod
|
||||
#pod role Foo { ... }
|
||||
#pod
|
||||
#pod my $anon_role = role { ... };
|
||||
#pod
|
||||
#pod Declares a new role. The role can be either named or anonymous, depending on
|
||||
#pod whether or not a name is given. Within the role definition Moose::Role and
|
||||
#pod MooseX::Method::Signatures are set up automatically in addition to the other
|
||||
#pod keywords described in this document. Again, namespace::autoclean is injected to
|
||||
#pod clean up Moose::Role and other imports for you.
|
||||
#pod
|
||||
#pod It's possible to specify options for roles:
|
||||
#pod
|
||||
#pod =over 4
|
||||
#pod
|
||||
#pod =item with
|
||||
#pod
|
||||
#pod role Foo with Bar { ... }
|
||||
#pod
|
||||
#pod Applies a role to the role being declared.
|
||||
#pod
|
||||
#pod =back
|
||||
#pod
|
||||
#pod =head2 before / after / around / override / augment
|
||||
#pod
|
||||
#pod before foo ($x, $y, $z) { ... }
|
||||
#pod after bar ($x, $y, $z) { ... }
|
||||
#pod around baz ($x, $y, $z) { ... }
|
||||
#pod override moo ($x, $y, $z) { ... }
|
||||
#pod augment kuh ($x, $y, $z) { ... }
|
||||
#pod
|
||||
#pod Add a method modifier. Those work like documented in L<Moose|Moose>, except for
|
||||
#pod the slightly nicer syntax and the method signatures, which work like documented
|
||||
#pod in L<MooseX::Method::Signatures|MooseX::Method::Signatures>.
|
||||
#pod
|
||||
#pod For the C<around> modifier an additional argument called C<$orig> is
|
||||
#pod automatically set up as the invocant for the method.
|
||||
#pod
|
||||
#pod =head2 clean
|
||||
#pod
|
||||
#pod Sometimes you don't want the automatic cleaning the C<class> and C<role>
|
||||
#pod keywords provide using namespace::autoclean. In those cases you can specify the
|
||||
#pod C<dirty> trait for your class or role:
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod class Foo is dirty { ... }
|
||||
#pod
|
||||
#pod This will prevent cleaning of your namespace, except for the keywords imported
|
||||
#pod from C<Moose> or C<Moose::Role>. Additionally, a C<clean> keyword is provided,
|
||||
#pod which allows you to explicitly clean all functions that were defined prior to
|
||||
#pod calling C<clean>. Here's an example:
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod class Foo is dirty {
|
||||
#pod sub helper_function { ... }
|
||||
#pod clean;
|
||||
#pod method foo ($stuff) { ...; return helper_function($stuff); }
|
||||
#pod }
|
||||
#pod
|
||||
#pod With that, the helper function won't be available as a method to a user of your
|
||||
#pod class, but you're still able to use it inside your class.
|
||||
#pod
|
||||
#pod =head1 NOTE ON IMPORTS
|
||||
#pod
|
||||
#pod When creating a class with MooseX::Declare like:
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod class Foo { ... }
|
||||
#pod
|
||||
#pod What actually happens is something like this:
|
||||
#pod
|
||||
#pod {
|
||||
#pod package Foo;
|
||||
#pod use Moose;
|
||||
#pod use namespace::autoclean;
|
||||
#pod ...
|
||||
#pod __PACKAGE__->meta->make_immutable;
|
||||
#pod }
|
||||
#pod
|
||||
#pod So if you declare imports outside the class, the symbols get imported into the
|
||||
#pod C<main::> namespace, not the class' namespace. The symbols then cannot be called
|
||||
#pod from within the class:
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod use Data::Dump qw/dump/;
|
||||
#pod class Foo {
|
||||
#pod method dump($value) { return dump($value) } # Data::Dump::dump IS NOT in Foo::
|
||||
#pod method pp($value) { $self->dump($value) } # an alias for our dump method
|
||||
#pod }
|
||||
#pod
|
||||
#pod To solve this, only import MooseX::Declare outside the class definition
|
||||
#pod (because you have to). Make all other imports inside the class definition.
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod class Foo {
|
||||
#pod use Data::Dump qw/dump/;
|
||||
#pod method dump($value) { return dump($value) } # Data::Dump::dump IS in Foo::
|
||||
#pod method pp($value) { $self->dump($value) } # an alias for our dump method
|
||||
#pod }
|
||||
#pod
|
||||
#pod Foo->new->dump($some_value);
|
||||
#pod Foo->new->pp($some_value);
|
||||
#pod
|
||||
#pod B<NOTE> that the import C<Data::Dump::dump()> and the method C<Foo::dump()>,
|
||||
#pod although having the same name, do not conflict with each other, because the
|
||||
#pod imported C<dump> function will be cleaned during compile time, so only the
|
||||
#pod method remains there at run time. If you want to do more esoteric things with
|
||||
#pod imports, have a look at the C<clean> keyword and the C<dirty> trait.
|
||||
#pod
|
||||
#pod =head1 WARNING
|
||||
#pod
|
||||
#pod =for comment rafl agreed we should have a warning, and mst wrote this:
|
||||
#pod
|
||||
#pod B<Warning:> MooseX::Declare is based on L<Devel::Declare>, a giant bag of crack
|
||||
#pod originally implemented by mst with the goal of upsetting the perl core
|
||||
#pod developers so much by its very existence that they implemented proper
|
||||
#pod keyword handling in the core.
|
||||
#pod
|
||||
#pod As of perl5 version 14, this goal has been achieved, and modules such
|
||||
#pod as L<Devel::CallParser>, L<Function::Parameters>, and L<Keyword::Simple> provide
|
||||
#pod mechanisms to mangle perl syntax that don't require hallucinogenic
|
||||
#pod drugs to interpret the error messages they produce.
|
||||
#pod
|
||||
#pod If you want to use declarative syntax in new code, please for the love
|
||||
#pod of kittens get yourself a recent perl and look at L<Moops> instead.
|
||||
#pod
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<Moose>
|
||||
#pod * L<Moose::Role>
|
||||
#pod * L<MooseX::Method::Signatures>
|
||||
#pod * L<namespace::autoclean>
|
||||
#pod * vim syntax: L<http://www.vim.org/scripts/script.php?script_id=2526>
|
||||
#pod * emacs syntax: L<http://github.com/jrockway/cperl-mode>
|
||||
#pod * Geany syntax + notes: L<http://www.cattlegrid.info/blog/2009/09/moosex-declare-geany-syntax.html>
|
||||
#pod * L<Devel::CallParser>
|
||||
#pod * L<Function::Parameters>
|
||||
#pod * L<Keyword::Simple>
|
||||
#pod * L<Moops>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare - (DEPRECATED) Declarative syntax for Moose
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use MooseX::Declare;
|
||||
|
||||
class BankAccount {
|
||||
has 'balance' => ( isa => 'Num', is => 'rw', default => 0 );
|
||||
|
||||
method deposit (Num $amount) {
|
||||
$self->balance( $self->balance + $amount );
|
||||
}
|
||||
|
||||
method withdraw (Num $amount) {
|
||||
my $current_balance = $self->balance();
|
||||
( $current_balance >= $amount )
|
||||
|| confess "Account overdrawn";
|
||||
$self->balance( $current_balance - $amount );
|
||||
}
|
||||
}
|
||||
|
||||
class CheckingAccount extends BankAccount {
|
||||
has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );
|
||||
|
||||
before withdraw (Num $amount) {
|
||||
my $overdraft_amount = $amount - $self->balance();
|
||||
if ( $self->overdraft_account && $overdraft_amount > 0 ) {
|
||||
$self->overdraft_account->withdraw($overdraft_amount);
|
||||
$self->deposit($overdraft_amount);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides syntactic sugar for Moose, the postmodern object system
|
||||
for Perl 5. When used, it sets up the C<class> and C<role> keywords.
|
||||
|
||||
B<Note:> Please see the L</WARNING> section below!
|
||||
|
||||
=head1 KEYWORDS
|
||||
|
||||
=head2 class
|
||||
|
||||
class Foo { ... }
|
||||
|
||||
my $anon_class = class { ... };
|
||||
|
||||
Declares a new class. The class can be either named or anonymous, depending on
|
||||
whether or not a classname is given. Within the class definition Moose and
|
||||
L<MooseX::Method::Signatures> are set up automatically in addition to the other
|
||||
keywords described in this document. At the end of the definition the class
|
||||
will be made immutable. namespace::autoclean is injected to clean up Moose and
|
||||
other imports for you.
|
||||
|
||||
Because of the way the options are parsed, you cannot have a class named "is",
|
||||
"with" or "extends".
|
||||
|
||||
It's possible to specify options for classes:
|
||||
|
||||
=over 4
|
||||
|
||||
=item extends
|
||||
|
||||
class Foo extends Bar { ... }
|
||||
|
||||
Sets a superclass for the class being declared.
|
||||
|
||||
=item with
|
||||
|
||||
class Foo with Role { ... }
|
||||
class Foo with Role1 with Role2 { ... }
|
||||
class Foo with (Role1, Role2) { ... }
|
||||
|
||||
Applies a role or roles to the class being declared.
|
||||
|
||||
=item is mutable
|
||||
|
||||
class Foo is mutable { ... }
|
||||
|
||||
Causes the class not to be made immutable after its definition.
|
||||
|
||||
Options can also be provided for anonymous classes using the same syntax:
|
||||
|
||||
my $meta_class = class with Role;
|
||||
|
||||
=back
|
||||
|
||||
=head2 role
|
||||
|
||||
role Foo { ... }
|
||||
|
||||
my $anon_role = role { ... };
|
||||
|
||||
Declares a new role. The role can be either named or anonymous, depending on
|
||||
whether or not a name is given. Within the role definition Moose::Role and
|
||||
MooseX::Method::Signatures are set up automatically in addition to the other
|
||||
keywords described in this document. Again, namespace::autoclean is injected to
|
||||
clean up Moose::Role and other imports for you.
|
||||
|
||||
It's possible to specify options for roles:
|
||||
|
||||
=over 4
|
||||
|
||||
=item with
|
||||
|
||||
role Foo with Bar { ... }
|
||||
|
||||
Applies a role to the role being declared.
|
||||
|
||||
=back
|
||||
|
||||
=head2 before / after / around / override / augment
|
||||
|
||||
before foo ($x, $y, $z) { ... }
|
||||
after bar ($x, $y, $z) { ... }
|
||||
around baz ($x, $y, $z) { ... }
|
||||
override moo ($x, $y, $z) { ... }
|
||||
augment kuh ($x, $y, $z) { ... }
|
||||
|
||||
Add a method modifier. Those work like documented in L<Moose|Moose>, except for
|
||||
the slightly nicer syntax and the method signatures, which work like documented
|
||||
in L<MooseX::Method::Signatures|MooseX::Method::Signatures>.
|
||||
|
||||
For the C<around> modifier an additional argument called C<$orig> is
|
||||
automatically set up as the invocant for the method.
|
||||
|
||||
=head2 clean
|
||||
|
||||
Sometimes you don't want the automatic cleaning the C<class> and C<role>
|
||||
keywords provide using namespace::autoclean. In those cases you can specify the
|
||||
C<dirty> trait for your class or role:
|
||||
|
||||
use MooseX::Declare;
|
||||
class Foo is dirty { ... }
|
||||
|
||||
This will prevent cleaning of your namespace, except for the keywords imported
|
||||
from C<Moose> or C<Moose::Role>. Additionally, a C<clean> keyword is provided,
|
||||
which allows you to explicitly clean all functions that were defined prior to
|
||||
calling C<clean>. Here's an example:
|
||||
|
||||
use MooseX::Declare;
|
||||
class Foo is dirty {
|
||||
sub helper_function { ... }
|
||||
clean;
|
||||
method foo ($stuff) { ...; return helper_function($stuff); }
|
||||
}
|
||||
|
||||
With that, the helper function won't be available as a method to a user of your
|
||||
class, but you're still able to use it inside your class.
|
||||
|
||||
=head1 NOTE ON IMPORTS
|
||||
|
||||
When creating a class with MooseX::Declare like:
|
||||
|
||||
use MooseX::Declare;
|
||||
class Foo { ... }
|
||||
|
||||
What actually happens is something like this:
|
||||
|
||||
{
|
||||
package Foo;
|
||||
use Moose;
|
||||
use namespace::autoclean;
|
||||
...
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
}
|
||||
|
||||
So if you declare imports outside the class, the symbols get imported into the
|
||||
C<main::> namespace, not the class' namespace. The symbols then cannot be called
|
||||
from within the class:
|
||||
|
||||
use MooseX::Declare;
|
||||
use Data::Dump qw/dump/;
|
||||
class Foo {
|
||||
method dump($value) { return dump($value) } # Data::Dump::dump IS NOT in Foo::
|
||||
method pp($value) { $self->dump($value) } # an alias for our dump method
|
||||
}
|
||||
|
||||
To solve this, only import MooseX::Declare outside the class definition
|
||||
(because you have to). Make all other imports inside the class definition.
|
||||
|
||||
use MooseX::Declare;
|
||||
class Foo {
|
||||
use Data::Dump qw/dump/;
|
||||
method dump($value) { return dump($value) } # Data::Dump::dump IS in Foo::
|
||||
method pp($value) { $self->dump($value) } # an alias for our dump method
|
||||
}
|
||||
|
||||
Foo->new->dump($some_value);
|
||||
Foo->new->pp($some_value);
|
||||
|
||||
B<NOTE> that the import C<Data::Dump::dump()> and the method C<Foo::dump()>,
|
||||
although having the same name, do not conflict with each other, because the
|
||||
imported C<dump> function will be cleaned during compile time, so only the
|
||||
method remains there at run time. If you want to do more esoteric things with
|
||||
imports, have a look at the C<clean> keyword and the C<dirty> trait.
|
||||
|
||||
=head1 WARNING
|
||||
|
||||
=for comment rafl agreed we should have a warning, and mst wrote this:
|
||||
|
||||
B<Warning:> MooseX::Declare is based on L<Devel::Declare>, a giant bag of crack
|
||||
originally implemented by mst with the goal of upsetting the perl core
|
||||
developers so much by its very existence that they implemented proper
|
||||
keyword handling in the core.
|
||||
|
||||
As of perl5 version 14, this goal has been achieved, and modules such
|
||||
as L<Devel::CallParser>, L<Function::Parameters>, and L<Keyword::Simple> provide
|
||||
mechanisms to mangle perl syntax that don't require hallucinogenic
|
||||
drugs to interpret the error messages they produce.
|
||||
|
||||
If you want to use declarative syntax in new code, please for the love
|
||||
of kittens get yourself a recent perl and look at L<Moops> instead.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<Moose>
|
||||
|
||||
=item *
|
||||
|
||||
L<Moose::Role>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Method::Signatures>
|
||||
|
||||
=item *
|
||||
|
||||
L<namespace::autoclean>
|
||||
|
||||
=item *
|
||||
|
||||
vim syntax: L<http://www.vim.org/scripts/script.php?script_id=2526>
|
||||
|
||||
=item *
|
||||
|
||||
emacs syntax: L<http://github.com/jrockway/cperl-mode>
|
||||
|
||||
=item *
|
||||
|
||||
Geany syntax + notes: L<http://www.cattlegrid.info/blog/2009/09/moosex-declare-geany-syntax.html>
|
||||
|
||||
=item *
|
||||
|
||||
L<Devel::CallParser>
|
||||
|
||||
=item *
|
||||
|
||||
L<Function::Parameters>
|
||||
|
||||
=item *
|
||||
|
||||
L<Keyword::Simple>
|
||||
|
||||
=item *
|
||||
|
||||
L<Moops>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 CONTRIBUTORS
|
||||
|
||||
=for stopwords Karen Etheridge Piers Cawley Robert 'phaylon' Sedlacek Ash Berlin Nick Perez Nelo Onyiah Chas. J. Owens IV leedo Michele Beltrame Frank Wiegand David Steinbrunner Oleg Kostyuk Dave Rolsky Rafael Kitover Chris Prather Stevan Little Tomas Doran Yanick Champoux Justin Hunter
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Piers Cawley <pdcawley@bofh.org.uk>
|
||||
|
||||
=item *
|
||||
|
||||
Robert 'phaylon' Sedlacek <rs@474.at>
|
||||
|
||||
=item *
|
||||
|
||||
Ash Berlin <ash_github@firemirror.com>
|
||||
|
||||
=item *
|
||||
|
||||
Nick Perez <nperez@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Nelo Onyiah <nelo.onyiah@gmail.com>
|
||||
|
||||
=item *
|
||||
|
||||
Chas. J. Owens IV <chas.owens@gmail.com>
|
||||
|
||||
=item *
|
||||
|
||||
leedo <lee@laylward.com>
|
||||
|
||||
=item *
|
||||
|
||||
Michele Beltrame <arthas@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Frank Wiegand <fwie@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
David Steinbrunner <dsteinbrunner@pobox.com>
|
||||
|
||||
=item *
|
||||
|
||||
Oleg Kostyuk <cub.uanic@gmail.com>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Rafael Kitover <rkitover@io.com>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Stevan Little <stevan.little@iinteractive.com>
|
||||
|
||||
=item *
|
||||
|
||||
Tomas Doran <bobtfish@bobtfish.net>
|
||||
|
||||
=item *
|
||||
|
||||
Yanick Champoux <yanick@babyl.dyndns.org>
|
||||
|
||||
=item *
|
||||
|
||||
Justin Hunter <justin.d.hunter@gmail.com>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
510
database/perl/vendor/lib/MooseX/Declare/Context.pm
vendored
Normal file
510
database/perl/vendor/lib/MooseX/Declare/Context.pm
vendored
Normal file
@@ -0,0 +1,510 @@
|
||||
package MooseX::Declare::Context;
|
||||
# ABSTRACT: Per-keyword declaration context
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose 0.90;
|
||||
use Moose::Util::TypeConstraints qw(subtype as where);
|
||||
use Carp qw/croak/;
|
||||
|
||||
use aliased 'Devel::Declare::Context::Simple', 'DDContext';
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This is not a subclass of L<Devel::Declare::Context::Simple>, but it will
|
||||
#pod delegate all default methods and extend it with some attributes and methods
|
||||
#pod of its own.
|
||||
#pod
|
||||
#pod A context object will be instantiated for every keyword that is handled by
|
||||
#pod L<MooseX::Declare>. If handlers want to communicate with other handlers (for
|
||||
#pod example handlers that will only be setup inside a namespace block) it must
|
||||
#pod do this via the generated code.
|
||||
#pod
|
||||
#pod In addition to all the methods documented here, all methods from
|
||||
#pod L<Devel::Declare::Context::Simple> are available and will be delegated to an
|
||||
#pod internally stored instance of it.
|
||||
#pod
|
||||
#pod =type BlockCodePart
|
||||
#pod
|
||||
#pod An C<ArrayRef> with at least one element that stringifies to either C<BEGIN>
|
||||
#pod or C<END>. The other parts will be stringified and used as the body for the
|
||||
#pod generated block. An example would be this compiletime role composition:
|
||||
#pod
|
||||
#pod ['BEGIN', 'with q{ MyRole }']
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
subtype 'MooseX::Declare::BlockCodePart',
|
||||
as 'ArrayRef',
|
||||
where { @$_ > 1 and sub { grep { $_[0] eq $_ } qw( BEGIN END ) } -> ($_->[0]) };
|
||||
|
||||
#pod =type CodePart
|
||||
#pod
|
||||
#pod A part of code represented by either a C<Str> or a L</BlockCodePart>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
subtype 'MooseX::Declare::CodePart',
|
||||
as 'Str|MooseX::Declare::BlockCodePart';
|
||||
|
||||
has _dd_context => (
|
||||
is => 'ro',
|
||||
isa => DDContext,
|
||||
required => 1,
|
||||
builder => '_build_dd_context',
|
||||
lazy => 1,
|
||||
handles => qr/.*/,
|
||||
);
|
||||
|
||||
has _dd_init_args => (
|
||||
is => 'rw',
|
||||
isa => 'HashRef',
|
||||
default => sub { {} },
|
||||
required => 1,
|
||||
);
|
||||
|
||||
|
||||
has provided_by => (
|
||||
is => 'ro',
|
||||
isa => 'ClassName',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
|
||||
#pod =attr caller_file
|
||||
#pod
|
||||
#pod A required C<Str> containing the file the keyword was encountered in.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has caller_file => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
#pod =attr preamble_code_parts
|
||||
#pod
|
||||
#pod An C<ArrayRef> of L</CodePart>s that will be used as preamble. A preamble in
|
||||
#pod this context means the beginning of the generated code.
|
||||
#pod
|
||||
#pod =method add_preamble_code_parts(CodePart @parts)
|
||||
#pod
|
||||
#pod Object->add_preamble_code_parts (CodeRef @parts)
|
||||
#pod
|
||||
#pod See L</add_cleanup_code_parts>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has preamble_code_parts => (
|
||||
traits => ['Array'],
|
||||
is => 'ro',
|
||||
isa => 'ArrayRef[MooseX::Declare::CodePart]',
|
||||
required => 1,
|
||||
default => sub { [] },
|
||||
handles => {
|
||||
add_preamble_code_parts => 'push',
|
||||
},
|
||||
);
|
||||
|
||||
#pod =attr scope_code_parts
|
||||
#pod
|
||||
#pod These parts will come before the actual body and after the
|
||||
#pod L</preamble_code_parts>. It is an C<ArrayRef> of L</CodePart>s.
|
||||
#pod
|
||||
#pod =method add_scope_code_parts(CodePart @parts)
|
||||
#pod
|
||||
#pod Object->add_scope_code_parts (CodeRef @parts)
|
||||
#pod
|
||||
#pod See L</add_cleanup_code_parts>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has scope_code_parts => (
|
||||
traits => ['Array'],
|
||||
is => 'ro',
|
||||
isa => 'ArrayRef[MooseX::Declare::CodePart]',
|
||||
required => 1,
|
||||
default => sub { [] },
|
||||
handles => {
|
||||
add_scope_code_parts => 'push',
|
||||
},
|
||||
);
|
||||
|
||||
#pod =attr cleanup_code_parts
|
||||
#pod
|
||||
#pod An C<ArrayRef> of L</CodePart>s that will not be directly inserted
|
||||
#pod into the code, but instead be installed in a handler that will run at
|
||||
#pod the end of the scope so you can do namespace cleanups and such.
|
||||
#pod
|
||||
#pod =method add_cleanup_code_parts(CodePart @parts)
|
||||
#pod
|
||||
#pod Object->add_cleanup_code_parts (CodeRef @parts)
|
||||
#pod
|
||||
#pod For these three methods please look at the corresponding C<*_code_parts>
|
||||
#pod attribute in the list above. These methods are merely convenience methods
|
||||
#pod that allow adding entries to the code part containers.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has cleanup_code_parts => (
|
||||
traits => ['Array'],
|
||||
is => 'ro',
|
||||
isa => 'ArrayRef[MooseX::Declare::CodePart]',
|
||||
required => 1,
|
||||
default => sub { [] },
|
||||
handles => {
|
||||
add_cleanup_code_parts => 'push',
|
||||
add_early_cleanup_code_parts => 'unshift',
|
||||
},
|
||||
);
|
||||
|
||||
#pod =attr stack
|
||||
#pod
|
||||
#pod An C<ArrayRef> that contains the stack of handlers. A keyword that was
|
||||
#pod only setup inside a scoped block will have the blockhandler be put in
|
||||
#pod the stack.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has stack => (
|
||||
is => 'rw',
|
||||
isa => 'ArrayRef',
|
||||
default => sub { [] },
|
||||
required => 1,
|
||||
);
|
||||
|
||||
#pod =method inject_code_parts_here
|
||||
#pod
|
||||
#pod True Object->inject_code_parts_here (CodePart @parts)
|
||||
#pod
|
||||
#pod Will inject the passed L</CodePart>s at the current position in the code.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub inject_code_parts_here {
|
||||
my ($self, @parts) = @_;
|
||||
|
||||
# get code to inject and rest of line
|
||||
my $inject = $self->_joined_statements(\@parts);
|
||||
my $linestr = $self->get_linestr;
|
||||
|
||||
# add code to inject to current line and inject it
|
||||
substr($linestr, $self->offset, 0, "$inject");
|
||||
$self->set_linestr($linestr);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#pod =method peek_next_char
|
||||
#pod
|
||||
#pod Str Object->peek_next_char ()
|
||||
#pod
|
||||
#pod Will return the next char without stripping it from the stream.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub peek_next_char {
|
||||
my ($self) = @_;
|
||||
|
||||
# return next char in line
|
||||
my $linestr = $self->get_linestr;
|
||||
return substr $linestr, $self->offset, 1;
|
||||
}
|
||||
|
||||
sub peek_next_word {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->skipspace;
|
||||
|
||||
my $len = Devel::Declare::toke_scan_word($self->offset, 1);
|
||||
return unless $len;
|
||||
|
||||
my $linestr = $self->get_linestr;
|
||||
return substr($linestr, $self->offset, $len);
|
||||
}
|
||||
|
||||
#pod =method inject_code_parts
|
||||
#pod
|
||||
#pod Object->inject_code_parts (
|
||||
#pod Bool :$inject_cleanup_code_parts,
|
||||
#pod CodeRef :$missing_block_handler
|
||||
#pod )
|
||||
#pod
|
||||
#pod This will inject the code parts from the attributes above at the current
|
||||
#pod position. The preamble and scope code parts will be inserted first. Then
|
||||
#pod then call to the cleanup code will be injected, unless the options
|
||||
#pod contain a key named C<inject_cleanup_code_parts> with a false value.
|
||||
#pod
|
||||
#pod The C<inject_if_block> method will be called if the next char is a C<{>
|
||||
#pod indicating a following block.
|
||||
#pod
|
||||
#pod If it is not a block, but a semi-colon is found and the options
|
||||
#pod contained a C<missing_block_handler> key was passed, it will be called
|
||||
#pod as method on the context object with the code to inject and the
|
||||
#pod options as arguments. All options that are not recognized are passed
|
||||
#pod through to the C<missing_block_handler>. You are well advised to prefix
|
||||
#pod option names in your extensions.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub inject_code_parts {
|
||||
my ($self, %args) = @_;
|
||||
|
||||
# default to injecting cleanup code
|
||||
$args{inject_cleanup_code_parts} = 1
|
||||
unless exists $args{inject_cleanup_code_parts};
|
||||
|
||||
# add preamble and scope statements to injected code
|
||||
my $inject;
|
||||
$inject .= $self->_joined_statements('preamble');
|
||||
$inject .= ';' . $self->_joined_statements('scope');
|
||||
|
||||
# if we should also inject the cleanup code
|
||||
if ($args{inject_cleanup_code_parts}) {
|
||||
$inject .= ';' . $self->scope_injector_call($self->_joined_statements('cleanup'));
|
||||
}
|
||||
|
||||
$inject .= ';';
|
||||
|
||||
# we have a block
|
||||
if ($self->peek_next_char eq '{') {
|
||||
$self->inject_if_block("$inject");
|
||||
}
|
||||
|
||||
# there was no block to inject into
|
||||
else {
|
||||
# require end of statement
|
||||
croak "block or semi-colon expected after " . $self->declarator . " statement"
|
||||
unless $self->peek_next_char eq ';';
|
||||
|
||||
# if we can't handle non-blocks, we expect one
|
||||
croak "block expected after " . $self->declarator . " statement"
|
||||
unless exists $args{missing_block_handler};
|
||||
|
||||
# delegate the processing of the missing block
|
||||
$args{missing_block_handler}->($self, $inject, %args);
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub _joined_statements {
|
||||
my ($self, $section) = @_;
|
||||
|
||||
# if the section was not an array reference, get the
|
||||
# section contents of that name
|
||||
$section = $self->${\"${section}_code_parts"}
|
||||
unless ref $section;
|
||||
|
||||
# join statements via semicolon
|
||||
# array references are expected to be in the form [FOO => 1, 2, 3]
|
||||
# which would yield BEGIN { 1; 2; 3 }
|
||||
return join '; ', map {
|
||||
not( ref $_ ) ? $_ : do {
|
||||
my ($block, @parts) = @$_;
|
||||
sprintf '%s { %s }', $block, join '; ', @parts;
|
||||
};
|
||||
} @{ $section };
|
||||
}
|
||||
|
||||
sub BUILD {
|
||||
my ($self, $attrs) = @_;
|
||||
|
||||
# remember the constructor arguments for the delegated context
|
||||
$self->_dd_init_args($attrs);
|
||||
}
|
||||
|
||||
sub _build_dd_context {
|
||||
my ($self) = @_;
|
||||
|
||||
# create delegated context with remembered arguments
|
||||
return DDContext->new(%{ $self->_dd_init_args });
|
||||
}
|
||||
|
||||
sub strip_word {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->skipspace;
|
||||
my $linestr = $self->get_linestr;
|
||||
return if substr($linestr, $self->offset, 1) =~ /[{;]/;
|
||||
|
||||
# TODO:
|
||||
# - provide a reserved_words attribute
|
||||
# - allow keywords to consume reserved_words autodiscovery role
|
||||
my $word = $self->peek_next_word;
|
||||
return if !defined $word || $word =~ /^(?:extends|with|is)$/;
|
||||
|
||||
return scalar $self->strip_name;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<Devel::Declare>
|
||||
#pod * L<Devel::Declare::Context::Simple>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Context - Per-keyword declaration context
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is not a subclass of L<Devel::Declare::Context::Simple>, but it will
|
||||
delegate all default methods and extend it with some attributes and methods
|
||||
of its own.
|
||||
|
||||
A context object will be instantiated for every keyword that is handled by
|
||||
L<MooseX::Declare>. If handlers want to communicate with other handlers (for
|
||||
example handlers that will only be setup inside a namespace block) it must
|
||||
do this via the generated code.
|
||||
|
||||
In addition to all the methods documented here, all methods from
|
||||
L<Devel::Declare::Context::Simple> are available and will be delegated to an
|
||||
internally stored instance of it.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=head2 caller_file
|
||||
|
||||
A required C<Str> containing the file the keyword was encountered in.
|
||||
|
||||
=head2 preamble_code_parts
|
||||
|
||||
An C<ArrayRef> of L</CodePart>s that will be used as preamble. A preamble in
|
||||
this context means the beginning of the generated code.
|
||||
|
||||
=head2 scope_code_parts
|
||||
|
||||
These parts will come before the actual body and after the
|
||||
L</preamble_code_parts>. It is an C<ArrayRef> of L</CodePart>s.
|
||||
|
||||
=head2 cleanup_code_parts
|
||||
|
||||
An C<ArrayRef> of L</CodePart>s that will not be directly inserted
|
||||
into the code, but instead be installed in a handler that will run at
|
||||
the end of the scope so you can do namespace cleanups and such.
|
||||
|
||||
=head2 stack
|
||||
|
||||
An C<ArrayRef> that contains the stack of handlers. A keyword that was
|
||||
only setup inside a scoped block will have the blockhandler be put in
|
||||
the stack.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 add_preamble_code_parts(CodePart @parts)
|
||||
|
||||
Object->add_preamble_code_parts (CodeRef @parts)
|
||||
|
||||
See L</add_cleanup_code_parts>.
|
||||
|
||||
=head2 add_scope_code_parts(CodePart @parts)
|
||||
|
||||
Object->add_scope_code_parts (CodeRef @parts)
|
||||
|
||||
See L</add_cleanup_code_parts>.
|
||||
|
||||
=head2 add_cleanup_code_parts(CodePart @parts)
|
||||
|
||||
Object->add_cleanup_code_parts (CodeRef @parts)
|
||||
|
||||
For these three methods please look at the corresponding C<*_code_parts>
|
||||
attribute in the list above. These methods are merely convenience methods
|
||||
that allow adding entries to the code part containers.
|
||||
|
||||
=head2 inject_code_parts_here
|
||||
|
||||
True Object->inject_code_parts_here (CodePart @parts)
|
||||
|
||||
Will inject the passed L</CodePart>s at the current position in the code.
|
||||
|
||||
=head2 peek_next_char
|
||||
|
||||
Str Object->peek_next_char ()
|
||||
|
||||
Will return the next char without stripping it from the stream.
|
||||
|
||||
=head2 inject_code_parts
|
||||
|
||||
Object->inject_code_parts (
|
||||
Bool :$inject_cleanup_code_parts,
|
||||
CodeRef :$missing_block_handler
|
||||
)
|
||||
|
||||
This will inject the code parts from the attributes above at the current
|
||||
position. The preamble and scope code parts will be inserted first. Then
|
||||
then call to the cleanup code will be injected, unless the options
|
||||
contain a key named C<inject_cleanup_code_parts> with a false value.
|
||||
|
||||
The C<inject_if_block> method will be called if the next char is a C<{>
|
||||
indicating a following block.
|
||||
|
||||
If it is not a block, but a semi-colon is found and the options
|
||||
contained a C<missing_block_handler> key was passed, it will be called
|
||||
as method on the context object with the code to inject and the
|
||||
options as arguments. All options that are not recognized are passed
|
||||
through to the C<missing_block_handler>. You are well advised to prefix
|
||||
option names in your extensions.
|
||||
|
||||
=head1 TYPES
|
||||
|
||||
=head2 BlockCodePart
|
||||
|
||||
An C<ArrayRef> with at least one element that stringifies to either C<BEGIN>
|
||||
or C<END>. The other parts will be stringified and used as the body for the
|
||||
generated block. An example would be this compiletime role composition:
|
||||
|
||||
['BEGIN', 'with q{ MyRole }']
|
||||
|
||||
=head2 CodePart
|
||||
|
||||
A part of code represented by either a C<Str> or a L</BlockCodePart>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<Devel::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<Devel::Declare::Context::Simple>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
153
database/perl/vendor/lib/MooseX/Declare/Context/Namespaced.pm
vendored
Normal file
153
database/perl/vendor/lib/MooseX/Declare/Context/Namespaced.pm
vendored
Normal file
@@ -0,0 +1,153 @@
|
||||
package MooseX::Declare::Context::Namespaced;
|
||||
# ABSTRACT: Namespaced context
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use Carp qw( croak );
|
||||
use MooseX::Declare::Util qw( outer_stack_peek );
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This context trait will add namespace functionality to the context.
|
||||
#pod
|
||||
#pod =attr namespace
|
||||
#pod
|
||||
#pod This will be set when the C<strip_namespace> method is called and the
|
||||
#pod namespace wasn't anonymous. It will contain the specified namespace, not
|
||||
#pod the fully qualified one.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has namespace => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
);
|
||||
|
||||
|
||||
#pod =method strip_namespace
|
||||
#pod
|
||||
#pod Maybe[Str] Object->strip_namespace()
|
||||
#pod
|
||||
#pod This method is intended to parse the main namespace of a namespaced keyword.
|
||||
#pod It will use L<Devel::Declare::Context::Simple>s C<strip_word> method and store
|
||||
#pod the result in the L</namespace> attribute if true.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub strip_namespace {
|
||||
my ($self) = @_;
|
||||
|
||||
my $namespace = $self->strip_word;
|
||||
|
||||
$self->namespace($namespace)
|
||||
if defined $namespace and length $namespace;
|
||||
|
||||
return $namespace;
|
||||
}
|
||||
|
||||
#pod =method qualify_namespace
|
||||
#pod
|
||||
#pod Str Object->qualify_namespace(Str $namespace)
|
||||
#pod
|
||||
#pod If the C<$namespace> passed it begins with a C<::>, it will be prefixed with
|
||||
#pod the outer namespace in the file. If there is no outer namespace, an error
|
||||
#pod will be thrown.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub qualify_namespace {
|
||||
my ($self, $namespace) = @_;
|
||||
|
||||
# only qualify namespaces starting with ::
|
||||
return $namespace
|
||||
unless $namespace =~ /^::/;
|
||||
|
||||
# try to find the enclosing package
|
||||
my $outer = outer_stack_peek($self->caller_file)
|
||||
or croak "No outer namespace found to apply relative $namespace to";
|
||||
|
||||
return $outer . $namespace;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Context>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Context::Namespaced - Namespaced context
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This context trait will add namespace functionality to the context.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=head2 namespace
|
||||
|
||||
This will be set when the C<strip_namespace> method is called and the
|
||||
namespace wasn't anonymous. It will contain the specified namespace, not
|
||||
the fully qualified one.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 strip_namespace
|
||||
|
||||
Maybe[Str] Object->strip_namespace()
|
||||
|
||||
This method is intended to parse the main namespace of a namespaced keyword.
|
||||
It will use L<Devel::Declare::Context::Simple>s C<strip_word> method and store
|
||||
the result in the L</namespace> attribute if true.
|
||||
|
||||
=head2 qualify_namespace
|
||||
|
||||
Str Object->qualify_namespace(Str $namespace)
|
||||
|
||||
If the C<$namespace> passed it begins with a C<::>, it will be prefixed with
|
||||
the outer namespace in the file. If there is no outer namespace, an error
|
||||
will be thrown.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Context>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
159
database/perl/vendor/lib/MooseX/Declare/Context/Parameterized.pm
vendored
Normal file
159
database/perl/vendor/lib/MooseX/Declare/Context/Parameterized.pm
vendored
Normal file
@@ -0,0 +1,159 @@
|
||||
package MooseX::Declare::Context::Parameterized;
|
||||
# ABSTRACT: context for parsing optionally parameterized statements
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use MooseX::Types::Moose qw/Str HashRef/;
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This context trait will add optional parameterization functionality to the
|
||||
#pod context.
|
||||
#pod
|
||||
#pod =attr parameter_signature
|
||||
#pod
|
||||
#pod This will be set when the C<strip_parameter_signature> method is called and it
|
||||
#pod was able to extract a list of parameterisations.
|
||||
#pod
|
||||
#pod =method has_parameter_signature
|
||||
#pod
|
||||
#pod Predicate method for the C<parameter_signature> attribute.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has parameter_signature => (
|
||||
is => 'rw',
|
||||
isa => Str,
|
||||
predicate => 'has_parameter_signature',
|
||||
);
|
||||
|
||||
#pod =method add_parameter
|
||||
#pod
|
||||
#pod Allows storing parameters extracted from C<parameter_signature> to be used
|
||||
#pod later on.
|
||||
#pod
|
||||
#pod =method get_parameters
|
||||
#pod
|
||||
#pod Returns all previously added parameters.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has parameters => (
|
||||
traits => ['Hash'],
|
||||
isa => HashRef,
|
||||
default => sub { {} },
|
||||
handles => {
|
||||
add_parameter => 'set',
|
||||
get_parameters => 'kv',
|
||||
},
|
||||
);
|
||||
|
||||
#pod =method strip_parameter_signature
|
||||
#pod
|
||||
#pod Maybe[Str] Object->strip_parameter_signature()
|
||||
#pod
|
||||
#pod This method is intended to parse the main namespace of a namespaced keyword.
|
||||
#pod It will use L<Devel::Declare::Context::Simple>s C<strip_word> method and store
|
||||
#pod the result in the L</namespace> attribute if true.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub strip_parameter_signature {
|
||||
my ($self) = @_;
|
||||
|
||||
my $signature = $self->strip_proto;
|
||||
|
||||
$self->parameter_signature($signature)
|
||||
if defined $signature && length $signature;
|
||||
|
||||
return $signature;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Context>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Context::Parameterized - context for parsing optionally parameterized statements
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This context trait will add optional parameterization functionality to the
|
||||
context.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=head2 parameter_signature
|
||||
|
||||
This will be set when the C<strip_parameter_signature> method is called and it
|
||||
was able to extract a list of parameterisations.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 has_parameter_signature
|
||||
|
||||
Predicate method for the C<parameter_signature> attribute.
|
||||
|
||||
=head2 add_parameter
|
||||
|
||||
Allows storing parameters extracted from C<parameter_signature> to be used
|
||||
later on.
|
||||
|
||||
=head2 get_parameters
|
||||
|
||||
Returns all previously added parameters.
|
||||
|
||||
=head2 strip_parameter_signature
|
||||
|
||||
Maybe[Str] Object->strip_parameter_signature()
|
||||
|
||||
This method is intended to parse the main namespace of a namespaced keyword.
|
||||
It will use L<Devel::Declare::Context::Simple>s C<strip_word> method and store
|
||||
the result in the L</namespace> attribute if true.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Context>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
70
database/perl/vendor/lib/MooseX/Declare/Context/WithOptions.pm
vendored
Normal file
70
database/perl/vendor/lib/MooseX/Declare/Context/WithOptions.pm
vendored
Normal file
@@ -0,0 +1,70 @@
|
||||
package # hide from PAUSE
|
||||
MooseX::Declare::Context::WithOptions;
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use Carp qw/croak/;
|
||||
use MooseX::Types::Moose 0.20 qw/HashRef/;
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
has options => (
|
||||
is => 'rw',
|
||||
isa => HashRef,
|
||||
default => sub { {} },
|
||||
lazy => 1,
|
||||
);
|
||||
|
||||
sub strip_options {
|
||||
my ($self) = @_;
|
||||
my %ret;
|
||||
|
||||
# Make errors get reported from right place in source file
|
||||
local $Carp::Internal{'MooseX::Declare'} = 1;
|
||||
local $Carp::Internal{'Devel::Declare'} = 1;
|
||||
|
||||
$self->skipspace;
|
||||
my $linestr = $self->get_linestr;
|
||||
|
||||
while (substr($linestr, $self->offset, 1) !~ /[{;]/) {
|
||||
my $key = $self->strip_name;
|
||||
if (!defined $key) {
|
||||
croak 'expected option name'
|
||||
if keys %ret;
|
||||
return; # This is the case when { class => 'foo' } happens
|
||||
}
|
||||
|
||||
croak "unknown option name '$key'"
|
||||
unless $key =~ /^(extends|with|is)$/;
|
||||
|
||||
my $val = $self->strip_name;
|
||||
if (!defined $val) {
|
||||
if (defined($val = $self->strip_proto)) {
|
||||
$val = [split /\s*,\s*/, $val];
|
||||
}
|
||||
else {
|
||||
croak "expected option value after $key";
|
||||
}
|
||||
}
|
||||
|
||||
$ret{$key} ||= [];
|
||||
push @{ $ret{$key} }, ref $val ? @{ $val } : $val;
|
||||
} continue {
|
||||
$self->skipspace;
|
||||
$linestr = $self->get_linestr();
|
||||
}
|
||||
|
||||
my $options = { map {
|
||||
my $key = $_;
|
||||
$key eq 'is'
|
||||
? ($key => { map { ($_ => 1) } @{ $ret{$key} } })
|
||||
: ($key => $ret{$key})
|
||||
} keys %ret };
|
||||
|
||||
$self->options($options);
|
||||
|
||||
return $options;
|
||||
}
|
||||
|
||||
1;
|
||||
59
database/perl/vendor/lib/MooseX/Declare/StackItem.pm
vendored
Normal file
59
database/perl/vendor/lib/MooseX/Declare/StackItem.pm
vendored
Normal file
@@ -0,0 +1,59 @@
|
||||
package # hide from PAUSE
|
||||
MooseX::Declare::StackItem;
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
|
||||
use namespace::autoclean;
|
||||
use overload '""' => 'as_string', fallback => 1;
|
||||
|
||||
has identifier => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has handler => (
|
||||
is => 'ro',
|
||||
required => 1,
|
||||
default => '',
|
||||
);
|
||||
|
||||
has is_dirty => (
|
||||
is => 'ro',
|
||||
isa => 'Bool',
|
||||
);
|
||||
|
||||
has is_parameterized => (
|
||||
is => 'ro',
|
||||
isa => 'Bool',
|
||||
);
|
||||
|
||||
has namespace => (
|
||||
is => 'ro',
|
||||
isa => 'Str|Undef',
|
||||
|
||||
);
|
||||
|
||||
sub as_string {
|
||||
my ($self) = @_;
|
||||
return $self->identifier;
|
||||
}
|
||||
|
||||
sub serialize {
|
||||
my ($self) = @_;
|
||||
return sprintf '%s->new(%s)',
|
||||
ref($self),
|
||||
join ', ', map { defined($_) ? "q($_)" : 'undef' }
|
||||
'identifier', $self->identifier,
|
||||
'handler', $self->handler,
|
||||
'is_dirty', ( $self->is_dirty ? 1 : 0 ),
|
||||
'is_parameterized', ( $self->is_parameterized ? 1 : 0 ),
|
||||
'namespace', $self->namespace,
|
||||
;
|
||||
}
|
||||
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
|
||||
1;
|
||||
95
database/perl/vendor/lib/MooseX/Declare/Syntax/EmptyBlockIfMissing.pm
vendored
Normal file
95
database/perl/vendor/lib/MooseX/Declare/Syntax/EmptyBlockIfMissing.pm
vendored
Normal file
@@ -0,0 +1,95 @@
|
||||
package MooseX::Declare::Syntax::EmptyBlockIfMissing;
|
||||
# ABSTRACT: Handle missing blocks after keywords
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod The L<MooseX::Declare::Syntax::NamespaceHandling> role will require that the
|
||||
#pod consumer handles the case of non-existent blocks. This role will inject
|
||||
#pod an empty block with only the generated code parts in it.
|
||||
#pod
|
||||
#pod =method handle_missing_block
|
||||
#pod
|
||||
#pod Object->handle_missing_block (Object $context, Str $body, %args)
|
||||
#pod
|
||||
#pod This will inject the generated code surrounded by C<{ ... }> into the code
|
||||
#pod where the keyword was called.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub handle_missing_block {
|
||||
my ($self, $ctx, $inject, %args) = @_;
|
||||
|
||||
# default to block with nothing more than the default contents
|
||||
$ctx->inject_code_parts_here("{ $inject }");
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::EmptyBlockIfMissing - Handle missing blocks after keywords
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The L<MooseX::Declare::Syntax::NamespaceHandling> role will require that the
|
||||
consumer handles the case of non-existent blocks. This role will inject
|
||||
an empty block with only the generated code parts in it.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 handle_missing_block
|
||||
|
||||
Object->handle_missing_block (Object $context, Str $body, %args)
|
||||
|
||||
This will inject the generated code surrounded by C<{ ... }> into the code
|
||||
where the keyword was called.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
138
database/perl/vendor/lib/MooseX/Declare/Syntax/Extending.pm
vendored
Normal file
138
database/perl/vendor/lib/MooseX/Declare/Syntax/Extending.pm
vendored
Normal file
@@ -0,0 +1,138 @@
|
||||
package MooseX::Declare::Syntax::Extending;
|
||||
# ABSTRACT: Extending with superclasses
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use aliased 'MooseX::Declare::Context::Namespaced';
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod Extends a class by a specified C<extends> option.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::OptionHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::OptionHandling
|
||||
);
|
||||
|
||||
around context_traits => sub { shift->(@_), Namespaced };
|
||||
|
||||
#pod =method add_extends_option_customizations
|
||||
#pod
|
||||
#pod Object->add_extends_option_customizations (
|
||||
#pod Object $ctx,
|
||||
#pod Str $package,
|
||||
#pod ArrayRef $superclasses,
|
||||
#pod HashRef $options
|
||||
#pod )
|
||||
#pod
|
||||
#pod This will add a code part that will call C<extends> with the C<$superclasses>
|
||||
#pod as arguments.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub add_extends_option_customizations {
|
||||
my ($self, $ctx, $package, $superclasses) = @_;
|
||||
|
||||
# add code for extends keyword
|
||||
$ctx->add_scope_code_parts(
|
||||
sprintf 'extends %s',
|
||||
join ', ',
|
||||
map { "'$_'" }
|
||||
map { $ctx->qualify_namespace($_) }
|
||||
@{ $superclasses },
|
||||
);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::Keyword::Class>
|
||||
#pod * L<MooseX::Declare::Syntax::OptionHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Extending - Extending with superclasses
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Extends a class by a specified C<extends> option.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 add_extends_option_customizations
|
||||
|
||||
Object->add_extends_option_customizations (
|
||||
Object $ctx,
|
||||
Str $package,
|
||||
ArrayRef $superclasses,
|
||||
HashRef $options
|
||||
)
|
||||
|
||||
This will add a code part that will call C<extends> with the C<$superclasses>
|
||||
as arguments.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::OptionHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::Keyword::Class>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::OptionHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
174
database/perl/vendor/lib/MooseX/Declare/Syntax/InnerSyntaxHandling.pm
vendored
Normal file
174
database/perl/vendor/lib/MooseX/Declare/Syntax/InnerSyntaxHandling.pm
vendored
Normal file
@@ -0,0 +1,174 @@
|
||||
package MooseX::Declare::Syntax::InnerSyntaxHandling;
|
||||
# ABSTRACT: Keywords inside blocks
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use MooseX::Declare::Util qw( outer_stack_push );
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This role allows you to setup keyword handlers that are only available
|
||||
#pod inside blocks or other scoping environments.
|
||||
#pod
|
||||
#pod =head1 REQUIRED METHODS
|
||||
#pod
|
||||
#pod =head2 get_identifier
|
||||
#pod
|
||||
#pod Str get_identifier ()
|
||||
#pod
|
||||
#pod Required to return the name of the identifier of the current handler.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
requires qw(
|
||||
get_identifier
|
||||
);
|
||||
|
||||
#pod =method default_inner
|
||||
#pod
|
||||
#pod ArrayRef[Object] Object->default_inner ()
|
||||
#pod
|
||||
#pod Returns an empty C<ArrayRef> by default. If you want to setup additional
|
||||
#pod keywords you will have to C<around> this method.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub default_inner { [] }
|
||||
|
||||
#pod =head1 MODIFIED METHODS
|
||||
#pod
|
||||
#pod =head2 setup_for
|
||||
#pod
|
||||
#pod Object->setup_for(ClassName $class, %args)
|
||||
#pod
|
||||
#pod After the keyword is setup inside itself, this will call L</setup_inner_for>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
after setup_for => sub {
|
||||
my ($self, $setup_class, %args) = @_;
|
||||
|
||||
# make sure stack is valid
|
||||
my $stack = $args{stack} || [];
|
||||
|
||||
# setup inner keywords if we're inside ourself
|
||||
if (grep { $_ eq $self->get_identifier } @$stack) {
|
||||
$self->setup_inner_for($setup_class, %args);
|
||||
}
|
||||
};
|
||||
|
||||
#pod =method setup_inner_for
|
||||
#pod
|
||||
#pod Object->setup_inner_for(ClassName $class, %args)
|
||||
#pod
|
||||
#pod Sets up all handlers in the inner class.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub setup_inner_for {
|
||||
my ($self, $setup_class, %args) = @_;
|
||||
|
||||
# setup each keyword in target class
|
||||
for my $inner (@{ $self->default_inner($args{stack}) }) {
|
||||
$inner->setup_for($setup_class, %args);
|
||||
}
|
||||
|
||||
# push package onto stack for namespace management
|
||||
if (exists $args{file}) {
|
||||
outer_stack_push $args{file}, $args{outer_package};
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::InnerSyntaxHandling - Keywords inside blocks
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role allows you to setup keyword handlers that are only available
|
||||
inside blocks or other scoping environments.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 default_inner
|
||||
|
||||
ArrayRef[Object] Object->default_inner ()
|
||||
|
||||
Returns an empty C<ArrayRef> by default. If you want to setup additional
|
||||
keywords you will have to C<around> this method.
|
||||
|
||||
=head2 setup_inner_for
|
||||
|
||||
Object->setup_inner_for(ClassName $class, %args)
|
||||
|
||||
Sets up all handlers in the inner class.
|
||||
|
||||
=head1 REQUIRED METHODS
|
||||
|
||||
=head2 get_identifier
|
||||
|
||||
Str get_identifier ()
|
||||
|
||||
Required to return the name of the identifier of the current handler.
|
||||
|
||||
=head1 MODIFIED METHODS
|
||||
|
||||
=head2 setup_for
|
||||
|
||||
Object->setup_for(ClassName $class, %args)
|
||||
|
||||
After the keyword is setup inside itself, this will call L</setup_inner_for>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
179
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Class.pm
vendored
Normal file
179
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Class.pm
vendored
Normal file
@@ -0,0 +1,179 @@
|
||||
package MooseX::Declare::Syntax::Keyword::Class;
|
||||
# ABSTRACT: Class declarations
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod * L<MooseX::Declare::Syntax::RoleApplication>
|
||||
#pod * L<MooseX::Declare::Syntax::Extending>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::MooseSetup
|
||||
MooseX::Declare::Syntax::RoleApplication
|
||||
MooseX::Declare::Syntax::Extending
|
||||
);
|
||||
|
||||
#pod =head1 MODIFIED METHODS
|
||||
#pod
|
||||
#pod =head2 imported_moose_symbols
|
||||
#pod
|
||||
#pod List Object->imported_moose_symbols ()
|
||||
#pod
|
||||
#pod Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols>
|
||||
#pod with C<extends>, C<has>, C<inner> and C<super>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
around imported_moose_symbols => sub { shift->(@_), qw( extends has inner super ) };
|
||||
|
||||
#pod =method generate_export
|
||||
#pod
|
||||
#pod CodeRef generate_export ()
|
||||
#pod
|
||||
#pod This will return a closure doing a call to L</make_anon_metaclass>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub generate_export { my $self = shift; sub { $self->make_anon_metaclass } }
|
||||
|
||||
|
||||
#pod =head2 auto_make_immutable
|
||||
#pod
|
||||
#pod Bool Object->auto_make_immutable ()
|
||||
#pod
|
||||
#pod Is set to a true value, so classes are made immutable by default.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
around auto_make_immutable => sub { 1 };
|
||||
|
||||
#pod =head2 make_anon_metaclass
|
||||
#pod
|
||||
#pod Object Object->make_anon_metaclass ()
|
||||
#pod
|
||||
#pod Returns an anonymous instance of L<Moose::Meta::Class>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
around make_anon_metaclass => sub { Moose::Meta::Class->create_anon_class };
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::Keyword::Role>
|
||||
#pod * L<MooseX::Declare::Syntax::RoleApplication>
|
||||
#pod * L<MooseX::Declare::Syntax::Extending>
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Keyword::Class - Class declarations
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 generate_export
|
||||
|
||||
CodeRef generate_export ()
|
||||
|
||||
This will return a closure doing a call to L</make_anon_metaclass>.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::RoleApplication>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::Extending>
|
||||
|
||||
=back
|
||||
|
||||
=head1 MODIFIED METHODS
|
||||
|
||||
=head2 imported_moose_symbols
|
||||
|
||||
List Object->imported_moose_symbols ()
|
||||
|
||||
Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols>
|
||||
with C<extends>, C<has>, C<inner> and C<super>.
|
||||
|
||||
=head2 auto_make_immutable
|
||||
|
||||
Bool Object->auto_make_immutable ()
|
||||
|
||||
Is set to a true value, so classes are made immutable by default.
|
||||
|
||||
=head2 make_anon_metaclass
|
||||
|
||||
Object Object->make_anon_metaclass ()
|
||||
|
||||
Returns an anonymous instance of L<Moose::Meta::Class>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::Keyword::Role>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::RoleApplication>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::Extending>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
136
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Clean.pm
vendored
Normal file
136
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Clean.pm
vendored
Normal file
@@ -0,0 +1,136 @@
|
||||
package MooseX::Declare::Syntax::Keyword::Clean;
|
||||
# ABSTRACT: Explicit namespace cleanups
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
use constant NAMESPACING_ROLE => 'MooseX::Declare::Syntax::NamespaceHandling';
|
||||
use Carp qw( cluck );
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This keyword will inject a call to L<namespace::clean> into its current
|
||||
#pod position.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::KeywordHandling
|
||||
);
|
||||
|
||||
sub find_namespace_handler {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
for my $item (reverse @{ $ctx->stack }) {
|
||||
return $item
|
||||
if $item->handler->does(NAMESPACING_ROLE);
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
#pod =method parse
|
||||
#pod
|
||||
#pod Object->parse(Object $context)
|
||||
#pod
|
||||
#pod This will inject a call to L<namespace::clean> C<< -except => 'meta' >> into
|
||||
#pod the code at the position of the keyword.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub parse {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
if (my $stack_item = $self->find_namespace_handler($ctx)) {
|
||||
my $namespace = $stack_item->namespace;
|
||||
|
||||
cluck "Attempted to clean an already cleaned namespace ($namespace). Did you mean to use 'is dirty'?"
|
||||
unless $stack_item->is_dirty;
|
||||
}
|
||||
|
||||
$ctx->skip_declarator;
|
||||
$ctx->inject_code_parts_here(
|
||||
';use namespace::clean -except => [qw( meta )]',
|
||||
);
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Keyword::Clean - Explicit namespace cleanups
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This keyword will inject a call to L<namespace::clean> into its current
|
||||
position.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 parse
|
||||
|
||||
Object->parse(Object $context)
|
||||
|
||||
This will inject a call to L<namespace::clean> C<< -except => 'meta' >> into
|
||||
the code at the position of the keyword.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
146
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Method.pm
vendored
Normal file
146
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Method.pm
vendored
Normal file
@@ -0,0 +1,146 @@
|
||||
package MooseX::Declare::Syntax::Keyword::Method;
|
||||
# ABSTRACT: Handle method declarations
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This role is an extension of L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
#pod that allows you to install keywords that declare methods.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with 'MooseX::Declare::Syntax::MethodDeclaration';
|
||||
|
||||
#pod =method register_method_declaration
|
||||
#pod
|
||||
#pod Object->register_method_declaration (Object $metaclass, Str $name, Object $method)
|
||||
#pod
|
||||
#pod This method required by the method declaration role will register the finished
|
||||
#pod method object via the C<< $metaclass->add_method >> method.
|
||||
#pod
|
||||
#pod MethodModifier->new(
|
||||
#pod identifier => 'around',
|
||||
#pod modifier_type => 'around',
|
||||
#pod prototype_injections => {
|
||||
#pod declarator => 'around',
|
||||
#pod injections => [ 'CodeRef $orig' ],
|
||||
#pod },
|
||||
#pod );
|
||||
#pod
|
||||
#pod This will mean that the signature C<(Str $foo)> will become
|
||||
#pod C<CodeRef $orig: Object $self, Str $foo> and C<()> will become
|
||||
#pod C<CodeRef $orig: Object $self>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub register_method_declaration {
|
||||
my ($self, $meta, $name, $method) = @_;
|
||||
return $meta->add_method($name, $method);
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod * L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
#pod * L<MooseX::Method::Signatures>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Keyword::Method - Handle method declarations
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role is an extension of L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
that allows you to install keywords that declare methods.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register_method_declaration
|
||||
|
||||
Object->register_method_declaration (Object $metaclass, Str $name, Object $method)
|
||||
|
||||
This method required by the method declaration role will register the finished
|
||||
method object via the C<< $metaclass->add_method >> method.
|
||||
|
||||
MethodModifier->new(
|
||||
identifier => 'around',
|
||||
modifier_type => 'around',
|
||||
prototype_injections => {
|
||||
declarator => 'around',
|
||||
injections => [ 'CodeRef $orig' ],
|
||||
},
|
||||
);
|
||||
|
||||
This will mean that the signature C<(Str $foo)> will become
|
||||
C<CodeRef $orig: Object $self, Str $foo> and C<()> will become
|
||||
C<CodeRef $orig: Object $self>.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Method::Signatures>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
173
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/MethodModifier.pm
vendored
Normal file
173
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/MethodModifier.pm
vendored
Normal file
@@ -0,0 +1,173 @@
|
||||
package MooseX::Declare::Syntax::Keyword::MethodModifier;
|
||||
# ABSTRACT: Handle method modifier declarations
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
use Moose::Util;
|
||||
use Moose::Util::TypeConstraints 'enum';
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod Allows the implementation of method modification handlers like C<around> and
|
||||
#pod C<before>.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with 'MooseX::Declare::Syntax::MethodDeclaration';
|
||||
|
||||
#pod =attr modifier_type
|
||||
#pod
|
||||
#pod A required string that is one of:
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * around
|
||||
#pod * after
|
||||
#pod * before
|
||||
#pod * override
|
||||
#pod * augment
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has modifier_type => (
|
||||
is => 'rw',
|
||||
isa => enum([qw( around after before override augment )]),
|
||||
required => 1,
|
||||
);
|
||||
|
||||
#pod =method register_method_declaration
|
||||
#pod
|
||||
#pod Object->register_method_declaration (Object $metaclass, Str $name, Object $method)
|
||||
#pod
|
||||
#pod This will add the method modifier to the C<$metaclass> via L<Moose::Util>s
|
||||
#pod C<add_method_modifier>, whose return value will also be returned from this
|
||||
#pod method.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub register_method_declaration {
|
||||
my ($self, $meta, $name, $method) = @_;
|
||||
return Moose::Util::add_method_modifier($meta->name, $self->modifier_type, [$name, $method->body]);
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod * L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
#pod * L<MooseX::Method::Signatures>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Keyword::MethodModifier - Handle method modifier declarations
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Allows the implementation of method modification handlers like C<around> and
|
||||
C<before>.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=head2 modifier_type
|
||||
|
||||
A required string that is one of:
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
around
|
||||
|
||||
=item *
|
||||
|
||||
after
|
||||
|
||||
=item *
|
||||
|
||||
before
|
||||
|
||||
=item *
|
||||
|
||||
override
|
||||
|
||||
=item *
|
||||
|
||||
augment
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 register_method_declaration
|
||||
|
||||
Object->register_method_declaration (Object $metaclass, Str $name, Object $method)
|
||||
|
||||
This will add the method modifier to the C<$metaclass> via L<Moose::Util>s
|
||||
C<add_method_modifier>, whose return value will also be returned from this
|
||||
method.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MethodDeclaration>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Method::Signatures>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
160
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Namespace.pm
vendored
Normal file
160
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Namespace.pm
vendored
Normal file
@@ -0,0 +1,160 @@
|
||||
package MooseX::Declare::Syntax::Keyword::Namespace;
|
||||
# ABSTRACT: Declare outer namespace
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
use Carp qw( confess );
|
||||
use MooseX::Declare::Util qw( outer_stack_push outer_stack_peek );
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 SYNOPSIS
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod
|
||||
#pod namespace Foo::Bar;
|
||||
#pod
|
||||
#pod class ::Baz extends ::Qux with ::Fnording {
|
||||
#pod ...
|
||||
#pod }
|
||||
#pod
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod The C<namespace> keyword allows you to declare an outer namespace under
|
||||
#pod which other namespaced constructs can be nested. The L</SYNOPSIS> is
|
||||
#pod effectively the same as
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod
|
||||
#pod class Foo::Bar::Baz extends Foo::Bar::Qux with Foo::Bar::Fnording {
|
||||
#pod ...
|
||||
#pod }
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::KeywordHandling
|
||||
);
|
||||
|
||||
#pod =method parse
|
||||
#pod
|
||||
#pod Object->parse(Object $context)
|
||||
#pod
|
||||
#pod Will skip the declarator, parse the namespace and push the namespace
|
||||
#pod in the file package stack.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub parse {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
confess "Nested namespaces are not supported yet"
|
||||
if outer_stack_peek $ctx->caller_file;
|
||||
|
||||
$ctx->skip_declarator;
|
||||
my $namespace = $ctx->strip_word
|
||||
or confess "Expected a namespace argument to use from here on";
|
||||
|
||||
confess "Relative namespaces are currently not supported"
|
||||
if $namespace =~ /^::/;
|
||||
|
||||
$ctx->skipspace;
|
||||
|
||||
my $next_char = $ctx->peek_next_char;
|
||||
confess "Expected end of statement after namespace argument"
|
||||
unless $next_char eq ';';
|
||||
|
||||
outer_stack_push $ctx->caller_file, $namespace;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Keyword::Namespace - Declare outer namespace
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use MooseX::Declare;
|
||||
|
||||
namespace Foo::Bar;
|
||||
|
||||
class ::Baz extends ::Qux with ::Fnording {
|
||||
...
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The C<namespace> keyword allows you to declare an outer namespace under
|
||||
which other namespaced constructs can be nested. The L</SYNOPSIS> is
|
||||
effectively the same as
|
||||
|
||||
use MooseX::Declare;
|
||||
|
||||
class Foo::Bar::Baz extends Foo::Bar::Qux with Foo::Bar::Fnording {
|
||||
...
|
||||
}
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 parse
|
||||
|
||||
Object->parse(Object $context)
|
||||
|
||||
Will skip the declarator, parse the namespace and push the namespace
|
||||
in the file package stack.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
256
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Role.pm
vendored
Normal file
256
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/Role.pm
vendored
Normal file
@@ -0,0 +1,256 @@
|
||||
package MooseX::Declare::Syntax::Keyword::Role;
|
||||
# ABSTRACT: Role declarations
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
use Moose::Util qw(does_role find_meta);
|
||||
use aliased 'Parse::Method::Signatures' => 'PMS';
|
||||
use aliased 'MooseX::Declare::Syntax::MethodDeclaration';
|
||||
use aliased 'Parse::Method::Signatures::Param::Placeholder';
|
||||
use aliased 'MooseX::Declare::Context::Parameterized', 'ParameterizedCtx';
|
||||
use aliased 'MooseX::Declare::Syntax::MethodDeclaration::Parameterized', 'ParameterizedMethod';
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod * L<MooseX::Declare::Syntax::RoleApplication>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::MooseSetup
|
||||
MooseX::Declare::Syntax::RoleApplication
|
||||
);
|
||||
|
||||
#pod =head1 MODIFIED METHODS
|
||||
#pod
|
||||
#pod =head2 imported_moose_symbols
|
||||
#pod
|
||||
#pod List Object->imported_moose_symbols ()
|
||||
#pod
|
||||
#pod Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols>
|
||||
#pod with C<requires>, C<extends>, C<has>, C<inner> and C<super>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
around imported_moose_symbols => sub { shift->(@_), qw( requires excludes extends has inner super ) };
|
||||
|
||||
#pod =head2 import_symbols_from
|
||||
#pod
|
||||
#pod Str Object->import_symbols_from ()
|
||||
#pod
|
||||
#pod Will return L<Moose::Role> instead of the default L<Moose>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
around import_symbols_from => sub {
|
||||
my ($next, $self, $ctx) = @_;
|
||||
return $ctx->has_parameter_signature
|
||||
? 'MooseX::Role::Parameterized'
|
||||
: 'Moose::Role';
|
||||
};
|
||||
|
||||
#pod =head2 make_anon_metaclass
|
||||
#pod
|
||||
#pod Object Object->make_anon_metaclass ()
|
||||
#pod
|
||||
#pod This will return an anonymous instance of L<Moose::Meta::Role>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
around make_anon_metaclass => sub { Moose::Meta::Role->create_anon_role };
|
||||
|
||||
around context_traits => sub { shift->(@_), ParameterizedCtx };
|
||||
|
||||
around default_inner => sub {
|
||||
my ($next, $self, $stack) = @_;
|
||||
my $inner = $self->$next;
|
||||
return $inner
|
||||
if !@{ $stack || [] } || !$stack->[-1]->is_parameterized;
|
||||
|
||||
ParameterizedMethod->meta->apply($_)
|
||||
for grep { does_role($_, MethodDeclaration) } @{ $inner };
|
||||
|
||||
return $inner;
|
||||
};
|
||||
|
||||
#pod =method generate_export
|
||||
#pod
|
||||
#pod CodeRef Object->generate_export ()
|
||||
#pod
|
||||
#pod Returns a closure with a call to L</make_anon_metaclass>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub generate_export { my $self = shift; sub { $self->make_anon_metaclass } }
|
||||
|
||||
after parse_namespace_specification => sub {
|
||||
my ($self, $ctx) = @_;
|
||||
$ctx->strip_parameter_signature;
|
||||
};
|
||||
|
||||
after add_namespace_customizations => sub {
|
||||
my ($self, $ctx, $package, $options) = @_;
|
||||
$self->add_parameterized_customizations($ctx, $package, $options)
|
||||
if $ctx->has_parameter_signature;
|
||||
};
|
||||
|
||||
sub add_parameterized_customizations {
|
||||
my ($self, $ctx, $package, $options) = @_;
|
||||
|
||||
my $sig = PMS->signature(
|
||||
input => "(${\$ctx->parameter_signature})",
|
||||
from_namespace => $ctx->get_curstash_name,
|
||||
);
|
||||
confess 'Positional parameters are not allowed in parameterized roles'
|
||||
if $sig->has_positional_params;
|
||||
|
||||
my @vars = map {
|
||||
does_role($_, Placeholder)
|
||||
? ()
|
||||
: {
|
||||
var => $_->variable_name,
|
||||
name => $_->label,
|
||||
tc => $_->meta_type_constraint,
|
||||
($_->has_default_value
|
||||
? (default => $_->default_value)
|
||||
: ()),
|
||||
},
|
||||
} $sig->named_params;
|
||||
|
||||
$ctx->add_preamble_code_parts(
|
||||
sprintf 'my (%s) = map { $_[0]->$_ } qw(%s);',
|
||||
join(',', map { $_->{var} } @vars),
|
||||
join(' ', map { $_->{name} } @vars),
|
||||
);
|
||||
|
||||
for my $var (@vars) {
|
||||
$ctx->add_parameter($var->{name} => {
|
||||
is => 'ro',
|
||||
isa => $var->{tc},
|
||||
(exists $var->{default}
|
||||
? (default => sub { eval $var->{default} })
|
||||
: ()),
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
after handle_post_parsing => sub {
|
||||
my ($self, $ctx, $package, $class) = @_;
|
||||
return unless $ctx->has_parameter_signature;
|
||||
$ctx->shadow(sub (&) {
|
||||
my $meta = find_meta($class);
|
||||
$meta->add_parameter($_->[0], %{ $_->[1] })
|
||||
for $ctx->get_parameters;
|
||||
$meta->role_generator($_[0]);
|
||||
return $class;
|
||||
});
|
||||
};
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::Keyword::Class>
|
||||
#pod * L<MooseX::Declare::Syntax::RoleApplication>
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Keyword::Role - Role declarations
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 generate_export
|
||||
|
||||
CodeRef Object->generate_export ()
|
||||
|
||||
Returns a closure with a call to L</make_anon_metaclass>.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::RoleApplication>
|
||||
|
||||
=back
|
||||
|
||||
=head1 MODIFIED METHODS
|
||||
|
||||
=head2 imported_moose_symbols
|
||||
|
||||
List Object->imported_moose_symbols ()
|
||||
|
||||
Extends the existing L<MooseX::Declare::Syntax::MooseSetup/imported_moose_symbols>
|
||||
with C<requires>, C<extends>, C<has>, C<inner> and C<super>.
|
||||
|
||||
=head2 import_symbols_from
|
||||
|
||||
Str Object->import_symbols_from ()
|
||||
|
||||
Will return L<Moose::Role> instead of the default L<Moose>.
|
||||
|
||||
=head2 make_anon_metaclass
|
||||
|
||||
Object Object->make_anon_metaclass ()
|
||||
|
||||
This will return an anonymous instance of L<Moose::Meta::Role>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::Keyword::Class>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::RoleApplication>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
153
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/With.pm
vendored
Normal file
153
database/perl/vendor/lib/MooseX/Declare/Syntax/Keyword/With.pm
vendored
Normal file
@@ -0,0 +1,153 @@
|
||||
package MooseX::Declare::Syntax::Keyword::With;
|
||||
# ABSTRACT: Apply roles within a class- or role-body
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose;
|
||||
use Moose::Util;
|
||||
use MooseX::Declare::Util qw( outer_stack_peek );
|
||||
use aliased 'MooseX::Declare::Context::Namespaced';
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 SYNOPSIS
|
||||
#pod
|
||||
#pod use MooseX::Declare;
|
||||
#pod
|
||||
#pod class ::Baz {
|
||||
#pod with 'Qux';
|
||||
#pod ...
|
||||
#pod }
|
||||
#pod
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod The C<with> keyword allows you to apply roles to the local class or role. It
|
||||
#pod differs from the C<with>-option of the C<class> and C<role> keywords in that it
|
||||
#pod applies the roles immediately instead of deferring application until the end of
|
||||
#pod the class- or role-definition.
|
||||
#pod
|
||||
#pod It also differs slightly from the C<with> provided by L<Moose|Moose> in that it
|
||||
#pod expands relative role names (C<::Foo>) according to the current C<namespace>.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::KeywordHandling
|
||||
);
|
||||
|
||||
around context_traits => sub { shift->(@_), Namespaced };
|
||||
|
||||
#pod =method parse
|
||||
#pod
|
||||
#pod Object->parse(Object $context)
|
||||
#pod
|
||||
#pod Will skip the declarator and make with C<with> invocation apply the set of
|
||||
#pod specified roles after possible C<namespace>-expanding has been done.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub parse {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
$ctx->skip_declarator;
|
||||
|
||||
my $pkg = outer_stack_peek $ctx->caller_file;
|
||||
$ctx->shadow(sub {
|
||||
Moose::Util::apply_all_roles($pkg, map {
|
||||
$ctx->qualify_namespace($_)
|
||||
} @_);
|
||||
});
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::Keyword::Namespace>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::Keyword::With - Apply roles within a class- or role-body
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use MooseX::Declare;
|
||||
|
||||
class ::Baz {
|
||||
with 'Qux';
|
||||
...
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The C<with> keyword allows you to apply roles to the local class or role. It
|
||||
differs from the C<with>-option of the C<class> and C<role> keywords in that it
|
||||
applies the roles immediately instead of deferring application until the end of
|
||||
the class- or role-definition.
|
||||
|
||||
It also differs slightly from the C<with> provided by L<Moose|Moose> in that it
|
||||
expands relative role names (C<::Foo>) according to the current C<namespace>.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 parse
|
||||
|
||||
Object->parse(Object $context)
|
||||
|
||||
Will skip the declarator and make with C<with> invocation apply the set of
|
||||
specified roles after possible C<namespace>-expanding has been done.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::Keyword::Namespace>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
240
database/perl/vendor/lib/MooseX/Declare/Syntax/KeywordHandling.pm
vendored
Normal file
240
database/perl/vendor/lib/MooseX/Declare/Syntax/KeywordHandling.pm
vendored
Normal file
@@ -0,0 +1,240 @@
|
||||
package MooseX::Declare::Syntax::KeywordHandling;
|
||||
# ABSTRACT: Basic keyword functionality
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use Moose::Util::TypeConstraints qw(subtype as where);
|
||||
use Devel::Declare ();
|
||||
use Sub::Install qw( install_sub );
|
||||
use Moose::Meta::Class ();
|
||||
use Module::Runtime 'use_module';
|
||||
|
||||
use aliased 'MooseX::Declare::Context';
|
||||
|
||||
use namespace::autoclean -also => ['_uniq'];
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This role provides the functionality common for all keyword handlers
|
||||
#pod in L<MooseX::Declare>.
|
||||
#pod
|
||||
#pod =head1 REQUIRED METHODS
|
||||
#pod
|
||||
#pod =head2 parse
|
||||
#pod
|
||||
#pod Object->parse (Object $context)
|
||||
#pod
|
||||
#pod This method must implement the actual parsing of the keyword syntax.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
requires qw(
|
||||
parse
|
||||
);
|
||||
|
||||
#pod =attr identifier
|
||||
#pod
|
||||
#pod This is the name of the actual keyword. It is a required string that is in
|
||||
#pod the same format as a usual Perl identifier.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has identifier => (
|
||||
is => 'ro',
|
||||
isa => subtype(as 'Str', where { /^ [_a-z] [_a-z0-9]* $/ix }),
|
||||
required => 1,
|
||||
);
|
||||
|
||||
#pod =method get_identifier
|
||||
#pod
|
||||
#pod Str Object->get_identifier ()
|
||||
#pod
|
||||
#pod Returns the name the handler will be setup under.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub get_identifier { shift->identifier }
|
||||
|
||||
sub context_class { Context }
|
||||
|
||||
sub context_traits { }
|
||||
|
||||
#pod =method setup_for
|
||||
#pod
|
||||
#pod Object->setup_for (ClassName $class, %args)
|
||||
#pod
|
||||
#pod This will setup the handler in the specified C<$class>. The handler will
|
||||
#pod dispatch to the L</parse_declaration> method when the keyword is used.
|
||||
#pod
|
||||
#pod A normal code reference will also be exported into the calling namespace.
|
||||
#pod It will either be empty or, if a C<generate_export> method is provided,
|
||||
#pod the return value of that method.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub setup_for {
|
||||
my ($self, $setup_class, %args) = @_;
|
||||
|
||||
# make sure the stack is valid
|
||||
my $stack = $args{stack} || [];
|
||||
my $ident = $self->get_identifier;
|
||||
|
||||
# setup the D:D handler for our keyword
|
||||
Devel::Declare->setup_for($setup_class, {
|
||||
$ident => {
|
||||
const => sub { $self->parse_declaration((caller(1))[1], \%args, @_) },
|
||||
},
|
||||
});
|
||||
|
||||
# search or generate a real export
|
||||
my $export = $self->can('generate_export') ? $self->generate_export($setup_class) : sub { };
|
||||
|
||||
# export subroutine
|
||||
install_sub({
|
||||
code => $export,
|
||||
into => $setup_class,
|
||||
as => $ident,
|
||||
}) unless $setup_class->can($ident);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#pod =method parse_declaration
|
||||
#pod
|
||||
#pod Object->parse_declaration (Str $filename, HashRef $setup_args, @call_args)
|
||||
#pod
|
||||
#pod This simply creates a new L<context|MooseX::Declare::Context> and passes it
|
||||
#pod to the L</parse> method.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub parse_declaration {
|
||||
my ($self, $caller_file, $args, @ctx_args) = @_;
|
||||
|
||||
# find and load context object class
|
||||
my $ctx_class = $self->context_class;
|
||||
use_module $ctx_class;
|
||||
|
||||
# do we have traits?
|
||||
if (my @ctx_traits = _uniq($self->context_traits)) {
|
||||
|
||||
use_module $_
|
||||
for @ctx_traits;
|
||||
|
||||
$ctx_class = Moose::Meta::Class->create_anon_class(
|
||||
superclasses => [$ctx_class],
|
||||
roles => [@ctx_traits],
|
||||
cache => 1,
|
||||
)->name;
|
||||
}
|
||||
|
||||
# create a context object and initialize it
|
||||
my $ctx = $ctx_class->new(
|
||||
%{ $args },
|
||||
caller_file => $caller_file,
|
||||
);
|
||||
$ctx->init(@ctx_args);
|
||||
|
||||
# parse with current context
|
||||
return $self->parse($ctx);
|
||||
}
|
||||
|
||||
sub _uniq { keys %{ +{ map { $_ => undef } @_ } } }
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Context>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::KeywordHandling - Basic keyword functionality
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role provides the functionality common for all keyword handlers
|
||||
in L<MooseX::Declare>.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=head2 identifier
|
||||
|
||||
This is the name of the actual keyword. It is a required string that is in
|
||||
the same format as a usual Perl identifier.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 get_identifier
|
||||
|
||||
Str Object->get_identifier ()
|
||||
|
||||
Returns the name the handler will be setup under.
|
||||
|
||||
=head2 setup_for
|
||||
|
||||
Object->setup_for (ClassName $class, %args)
|
||||
|
||||
This will setup the handler in the specified C<$class>. The handler will
|
||||
dispatch to the L</parse_declaration> method when the keyword is used.
|
||||
|
||||
A normal code reference will also be exported into the calling namespace.
|
||||
It will either be empty or, if a C<generate_export> method is provided,
|
||||
the return value of that method.
|
||||
|
||||
=head2 parse_declaration
|
||||
|
||||
Object->parse_declaration (Str $filename, HashRef $setup_args, @call_args)
|
||||
|
||||
This simply creates a new L<context|MooseX::Declare::Context> and passes it
|
||||
to the L</parse> method.
|
||||
|
||||
=head1 REQUIRED METHODS
|
||||
|
||||
=head2 parse
|
||||
|
||||
Object->parse (Object $context)
|
||||
|
||||
This method must implement the actual parsing of the keyword syntax.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Context>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
189
database/perl/vendor/lib/MooseX/Declare/Syntax/MethodDeclaration.pm
vendored
Normal file
189
database/perl/vendor/lib/MooseX/Declare/Syntax/MethodDeclaration.pm
vendored
Normal file
@@ -0,0 +1,189 @@
|
||||
package MooseX::Declare::Syntax::MethodDeclaration;
|
||||
# ABSTRACT: Handles method declarations
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use MooseX::Method::Signatures::Meta::Method;
|
||||
use MooseX::Method::Signatures 0.36 ();
|
||||
use MooseX::Method::Signatures::Types qw/PrototypeInjections/;
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod A role for keyword handlers that gives a framework to add or modify
|
||||
#pod methods or things that look like methods.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::KeywordHandling
|
||||
);
|
||||
|
||||
#pod =head1 REQUIRED METHODS
|
||||
#pod
|
||||
#pod =head2 register_method_declaration
|
||||
#pod
|
||||
#pod Object->register_method_declaration (Object $metaclass, Str $name, Object $method)
|
||||
#pod
|
||||
#pod This method will be called with the target metaclass and the final built
|
||||
#pod L<method meta object|MooseX::Method::Signatures::Meta::Method> and its name.
|
||||
#pod The value it returns will be the value returned where the method was declared.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
requires qw(
|
||||
register_method_declaration
|
||||
);
|
||||
|
||||
#pod =attr prototype_injections
|
||||
#pod
|
||||
#pod An optional structure describing additional things to be added to a methods
|
||||
#pod signature. A popular example is found in the C<around>
|
||||
#pod L<method modifier handler|MooseX::Declare::Syntax::Keyword::MethodModifier>:
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
has prototype_injections => (
|
||||
is => 'ro',
|
||||
isa => PrototypeInjections,
|
||||
predicate => 'has_prototype_injections',
|
||||
);
|
||||
|
||||
#pod =method parse
|
||||
#pod
|
||||
#pod Object->parse (Object $ctx);
|
||||
#pod
|
||||
#pod Reads a name and a prototype and builds the method meta object then registers
|
||||
#pod it into the current class using MooseX::Method::Signatures and a
|
||||
#pod C<custom_method_application>, that calls L</register_method_declaration>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub parse {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
my %args = (
|
||||
context => $ctx->_dd_context,
|
||||
initialized_context => 1,
|
||||
custom_method_application => sub {
|
||||
my ($meta, $name, $method) = @_;
|
||||
$self->register_method_declaration($meta, $name, $method);
|
||||
},
|
||||
);
|
||||
|
||||
$args{prototype_injections} = $self->prototype_injections
|
||||
if $self->has_prototype_injections;
|
||||
|
||||
my $mxms = MooseX::Method::Signatures->new(%args);
|
||||
$mxms->parser;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod * L<MooseX::Method::Signatures>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::MethodDeclaration - Handles method declarations
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A role for keyword handlers that gives a framework to add or modify
|
||||
methods or things that look like methods.
|
||||
|
||||
=head1 ATTRIBUTES
|
||||
|
||||
=head2 prototype_injections
|
||||
|
||||
An optional structure describing additional things to be added to a methods
|
||||
signature. A popular example is found in the C<around>
|
||||
L<method modifier handler|MooseX::Declare::Syntax::Keyword::MethodModifier>:
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 parse
|
||||
|
||||
Object->parse (Object $ctx);
|
||||
|
||||
Reads a name and a prototype and builds the method meta object then registers
|
||||
it into the current class using MooseX::Method::Signatures and a
|
||||
C<custom_method_application>, that calls L</register_method_declaration>.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 REQUIRED METHODS
|
||||
|
||||
=head2 register_method_declaration
|
||||
|
||||
Object->register_method_declaration (Object $metaclass, Str $name, Object $method)
|
||||
|
||||
This method will be called with the target metaclass and the final built
|
||||
L<method meta object|MooseX::Method::Signatures::Meta::Method> and its name.
|
||||
The value it returns will be the value returned where the method was declared.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Method::Signatures>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
24
database/perl/vendor/lib/MooseX/Declare/Syntax/MethodDeclaration/Parameterized.pm
vendored
Normal file
24
database/perl/vendor/lib/MooseX/Declare/Syntax/MethodDeclaration/Parameterized.pm
vendored
Normal file
@@ -0,0 +1,24 @@
|
||||
package # hide from PAUSE
|
||||
MooseX::Declare::Syntax::MethodDeclaration::Parameterized;
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
# we actually require MXRP 1.06 if versions 1.03,1.04,1.05 are installed
|
||||
# (which is where current_metaclass was removed from the API), but this was
|
||||
# only in the wild for a short time, so it's not worth creating a dynamic
|
||||
# prereq for.
|
||||
use MooseX::Role::Parameterized 0.12 ();
|
||||
use namespace::autoclean;
|
||||
|
||||
around register_method_declaration => sub {
|
||||
my ($next, $self, $parameterizable_meta, $name, $method) = @_;
|
||||
my $meta = $self->metaclass_for_method_application($parameterizable_meta, $name, $method);
|
||||
$self->$next($meta, $name, $method);
|
||||
};
|
||||
|
||||
sub metaclass_for_method_application {
|
||||
return MooseX::Role::Parameterized->current_metaclass;
|
||||
}
|
||||
|
||||
1;
|
||||
359
database/perl/vendor/lib/MooseX/Declare/Syntax/MooseSetup.pm
vendored
Normal file
359
database/perl/vendor/lib/MooseX/Declare/Syntax/MooseSetup.pm
vendored
Normal file
@@ -0,0 +1,359 @@
|
||||
package MooseX::Declare::Syntax::MooseSetup;
|
||||
# ABSTRACT: Common Moose namespaces declarations
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
|
||||
use Moose::Util qw( find_meta );
|
||||
use Sub::Install qw( install_sub );
|
||||
|
||||
use aliased 'MooseX::Declare::Syntax::Keyword::MethodModifier';
|
||||
use aliased 'MooseX::Declare::Syntax::Keyword::Method';
|
||||
use aliased 'MooseX::Declare::Syntax::Keyword::With', 'WithKeyword';
|
||||
use aliased 'MooseX::Declare::Syntax::Keyword::Clean', 'CleanKeyword';
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This role is basically an extension to
|
||||
#pod L<NamespaceHandling|MooseX::Declare::Syntax::NamespaceHandling>. It adds all
|
||||
#pod the common parts for L<Moose> namespace definitions. Examples of this role
|
||||
#pod can be found in the L<class|MooseX::Declare::Syntax::Keyword::Class> and
|
||||
#pod L<role|MooseX::Declare::Syntax::Keyword::Role> keywords.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
#pod * L<MooseX::Declare::Syntax::EmptyBlockIfMissing>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::NamespaceHandling
|
||||
MooseX::Declare::Syntax::EmptyBlockIfMissing
|
||||
);
|
||||
|
||||
#pod =method auto_make_immutable
|
||||
#pod
|
||||
#pod Bool Object->auto_make_immutable ()
|
||||
#pod
|
||||
#pod Since L<Moose::Role>s can't be made immutable (this is not a bug or a
|
||||
#pod missing feature, it would make no sense), this always returns false.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub auto_make_immutable { 0 }
|
||||
|
||||
#pod =method imported_moose_symbols
|
||||
#pod
|
||||
#pod List Object->imported_moose_symbols ()
|
||||
#pod
|
||||
#pod This will return C<confess> and C<blessed> by default to provide as
|
||||
#pod additional imports to the namespace.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub imported_moose_symbols { qw( confess blessed ) }
|
||||
|
||||
#pod =method import_symbols_from
|
||||
#pod
|
||||
#pod Str Object->import_symbols_from ()
|
||||
#pod
|
||||
#pod The namespace from which the additional imports will be imported. This
|
||||
#pod will return C<Moose> by default.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub import_symbols_from { 'Moose' }
|
||||
|
||||
#pod =head1 MODIFIED METHODS
|
||||
#pod
|
||||
#pod =head2 default_inner
|
||||
#pod
|
||||
#pod ArrayRef default_inner ()
|
||||
#pod
|
||||
#pod This will provide the following default inner-handlers to the namespace:
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * method
|
||||
#pod A simple L<Method|MooseX::Declare::Syntax::Keyword::Method> handler.
|
||||
#pod * around
|
||||
#pod This is a L<MethodModifier|MooseX::Declare::Syntax::Keyword::MethodModifier>
|
||||
#pod handler that will start the signature of the generated method with
|
||||
#pod C<$orig: $self> to provide the original method in C<$orig>.
|
||||
#pod * after
|
||||
#pod * before
|
||||
#pod * override
|
||||
#pod * augment
|
||||
#pod These four handlers are L<MethodModifier|MooseX::Declare::Syntax::Keyword::MethodModifier>
|
||||
#pod instances.
|
||||
#pod * clean
|
||||
#pod This is an instance of the L<Clean|MooseX::Declare::Syntax::Keyword::Clean> keyword
|
||||
#pod handler.
|
||||
#pod
|
||||
#pod The original method will never be called and all arguments are ignored at the
|
||||
#pod moment.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
around default_inner => sub {
|
||||
return [
|
||||
WithKeyword->new(identifier => 'with'),
|
||||
Method->new(identifier => 'method'),
|
||||
MethodModifier->new(
|
||||
identifier => 'around',
|
||||
modifier_type => 'around',
|
||||
prototype_injections => {
|
||||
declarator => 'around',
|
||||
injections => [ 'CodeRef $orig' ],
|
||||
},
|
||||
),
|
||||
map { MethodModifier->new(identifier => $_, modifier_type => $_) }
|
||||
qw( after before override augment ),
|
||||
];
|
||||
};
|
||||
|
||||
#pod =head2 setup_inner_for
|
||||
#pod
|
||||
#pod Object->setup_inner_for (ClassName $class)
|
||||
#pod
|
||||
#pod This will install a C<with> function that will push its arguments onto a global
|
||||
#pod storage array holding the roles of the current namespace.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
after setup_inner_for => sub {
|
||||
my ($self, $setup_class, %args) = @_;
|
||||
my $keyword = CleanKeyword->new(identifier => 'clean');
|
||||
$keyword->setup_for($setup_class, %args);
|
||||
};
|
||||
|
||||
#pod =head2 add_namespace_customizations
|
||||
#pod
|
||||
#pod Object->add_namespace_customizations (Object $context, Str $package, HashRef $options)
|
||||
#pod
|
||||
#pod After all other customizations, this will first add code to import the
|
||||
#pod L</imported_moose_symbols> from the package returned in L</import_symbols_from> to
|
||||
#pod the L<preamble|MooseX::Declare::Context/preamble_code_parts>.
|
||||
#pod
|
||||
#pod Then it will add a code part that will immutabilize the class to the
|
||||
#pod L<cleanup|MooseX::Declare::Context/cleanup_code_parts> code if the
|
||||
#pod L</auto_make_immutable> method returned a true value and C<< $options->{is}{mutable} >>
|
||||
#pod does not exist.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
after add_namespace_customizations => sub {
|
||||
my ($self, $ctx, $package) = @_;
|
||||
|
||||
# add Moose initializations to preamble
|
||||
$ctx->add_preamble_code_parts(
|
||||
sprintf 'use %s qw( %s )', $self->import_symbols_from($ctx), join ' ', $self->imported_moose_symbols($ctx),
|
||||
);
|
||||
|
||||
# make class immutable unless specified otherwise
|
||||
$ctx->add_cleanup_code_parts(
|
||||
"${package}->meta->make_immutable",
|
||||
) if $self->auto_make_immutable
|
||||
and not exists $ctx->options->{is}{mutable};
|
||||
};
|
||||
|
||||
#pod =head2 handle_post_parsing
|
||||
#pod
|
||||
#pod CodeRef Object->handle_post_parsing (Object $context, Str $package, Str|Object $name)
|
||||
#pod
|
||||
#pod Generates a callback that sets up the roles in the global role storage for the current
|
||||
#pod namespace. The C<$name> parameter will be the specified name (in contrast to C<$package>
|
||||
#pod which will always be the fully qualified name) or the anonymous metaclass instance if
|
||||
#pod none was specified.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
after handle_post_parsing => sub {
|
||||
my ($self, $ctx, $package, $class) = @_;
|
||||
$ctx->shadow(sub (&) { shift->(); return $class; });
|
||||
};
|
||||
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<Moose>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::MooseSetup - Common Moose namespaces declarations
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role is basically an extension to
|
||||
L<NamespaceHandling|MooseX::Declare::Syntax::NamespaceHandling>. It adds all
|
||||
the common parts for L<Moose> namespace definitions. Examples of this role
|
||||
can be found in the L<class|MooseX::Declare::Syntax::Keyword::Class> and
|
||||
L<role|MooseX::Declare::Syntax::Keyword::Role> keywords.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 auto_make_immutable
|
||||
|
||||
Bool Object->auto_make_immutable ()
|
||||
|
||||
Since L<Moose::Role>s can't be made immutable (this is not a bug or a
|
||||
missing feature, it would make no sense), this always returns false.
|
||||
|
||||
=head2 imported_moose_symbols
|
||||
|
||||
List Object->imported_moose_symbols ()
|
||||
|
||||
This will return C<confess> and C<blessed> by default to provide as
|
||||
additional imports to the namespace.
|
||||
|
||||
=head2 import_symbols_from
|
||||
|
||||
Str Object->import_symbols_from ()
|
||||
|
||||
The namespace from which the additional imports will be imported. This
|
||||
will return C<Moose> by default.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::EmptyBlockIfMissing>
|
||||
|
||||
=back
|
||||
|
||||
=head1 MODIFIED METHODS
|
||||
|
||||
=head2 default_inner
|
||||
|
||||
ArrayRef default_inner ()
|
||||
|
||||
This will provide the following default inner-handlers to the namespace:
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
method
|
||||
|
||||
A simple L<Method|MooseX::Declare::Syntax::Keyword::Method> handler.
|
||||
|
||||
=item *
|
||||
|
||||
around
|
||||
|
||||
This is a L<MethodModifier|MooseX::Declare::Syntax::Keyword::MethodModifier>
|
||||
handler that will start the signature of the generated method with
|
||||
C<$orig: $self> to provide the original method in C<$orig>.
|
||||
|
||||
=item *
|
||||
|
||||
after
|
||||
|
||||
=item *
|
||||
|
||||
before
|
||||
|
||||
=item *
|
||||
|
||||
override
|
||||
|
||||
=item *
|
||||
|
||||
augment
|
||||
|
||||
These four handlers are L<MethodModifier|MooseX::Declare::Syntax::Keyword::MethodModifier>
|
||||
instances.
|
||||
|
||||
=item *
|
||||
|
||||
clean
|
||||
|
||||
This is an instance of the L<Clean|MooseX::Declare::Syntax::Keyword::Clean> keyword
|
||||
handler.
|
||||
|
||||
=back
|
||||
|
||||
The original method will never be called and all arguments are ignored at the
|
||||
moment.
|
||||
|
||||
=head2 setup_inner_for
|
||||
|
||||
Object->setup_inner_for (ClassName $class)
|
||||
|
||||
This will install a C<with> function that will push its arguments onto a global
|
||||
storage array holding the roles of the current namespace.
|
||||
|
||||
=head2 add_namespace_customizations
|
||||
|
||||
Object->add_namespace_customizations (Object $context, Str $package, HashRef $options)
|
||||
|
||||
After all other customizations, this will first add code to import the
|
||||
L</imported_moose_symbols> from the package returned in L</import_symbols_from> to
|
||||
the L<preamble|MooseX::Declare::Context/preamble_code_parts>.
|
||||
|
||||
Then it will add a code part that will immutabilize the class to the
|
||||
L<cleanup|MooseX::Declare::Context/cleanup_code_parts> code if the
|
||||
L</auto_make_immutable> method returned a true value and C<< $options->{is}{mutable} >>
|
||||
does not exist.
|
||||
|
||||
=head2 handle_post_parsing
|
||||
|
||||
CodeRef Object->handle_post_parsing (Object $context, Str $package, Str|Object $name)
|
||||
|
||||
Generates a callback that sets up the roles in the global role storage for the current
|
||||
namespace. The C<$name> parameter will be the specified name (in contrast to C<$package>
|
||||
which will always be the fully qualified name) or the anonymous metaclass instance if
|
||||
none was specified.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<Moose>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
440
database/perl/vendor/lib/MooseX/Declare/Syntax/NamespaceHandling.pm
vendored
Normal file
440
database/perl/vendor/lib/MooseX/Declare/Syntax/NamespaceHandling.pm
vendored
Normal file
@@ -0,0 +1,440 @@
|
||||
package MooseX::Declare::Syntax::NamespaceHandling;
|
||||
# ABSTRACT: Handle namespaced blocks
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use Moose::Util qw( does_role );
|
||||
use MooseX::Declare::Util qw( outer_stack_peek );
|
||||
use Carp;
|
||||
|
||||
use aliased 'MooseX::Declare::Context::Namespaced';
|
||||
use aliased 'MooseX::Declare::Context::WithOptions';
|
||||
use aliased 'MooseX::Declare::Context::Parameterized';
|
||||
use aliased 'MooseX::Declare::StackItem';
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod Allows the implementation of namespaced blocks like the
|
||||
#pod L<role|MooseX::Declare::Syntax::Keyword::Role> and
|
||||
#pod L<class|MooseX::Declare::Syntax::Keyword::Class> keyword handlers.
|
||||
#pod
|
||||
#pod Namespaces are automatically nested. Meaning that, for example, a C<class Bar>
|
||||
#pod declaration inside another C<class Foo> block gives the inner one actually the
|
||||
#pod name C<Foo::Bar>.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
#pod * L<MooseX::Declare::Syntax::InnerSyntaxHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::KeywordHandling
|
||||
MooseX::Declare::Syntax::InnerSyntaxHandling
|
||||
);
|
||||
|
||||
#pod =head1 REQUIRED METHODS
|
||||
#pod
|
||||
#pod =head2 handle_missing_block
|
||||
#pod
|
||||
#pod Object->handle_missing_block (Object $context, Str $body, %args)
|
||||
#pod
|
||||
#pod This must be implemented to decide what to do in case the statement is
|
||||
#pod terminated rather than followed by a block. It will receive the context
|
||||
#pod object, the produced code that needs to be injected, and all the arguments
|
||||
#pod that were passed to the call to L<MooseX::Declare::Context/inject_code_parts>.
|
||||
#pod
|
||||
#pod The return value will be ignored.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
requires qw(
|
||||
handle_missing_block
|
||||
);
|
||||
|
||||
#pod =head1 EXTENDABLE STUB METHODS
|
||||
#pod
|
||||
#pod =head2 add_namespace_customizations
|
||||
#pod
|
||||
#pod =head2 add_optional_customizations
|
||||
#pod
|
||||
#pod Object->add_namespace_customizations (Object $context, Str $package, HashRef $options)
|
||||
#pod Object->add_optional_customizations (Object $context, Str $package, HashRef $options)
|
||||
#pod
|
||||
#pod These will be called (in this order) by the L</parse> method. They allow specific hooks
|
||||
#pod to attach before/after/around the customizations for the namespace and the provided
|
||||
#pod options that are not attached to the namespace directly.
|
||||
#pod
|
||||
#pod While this distinction might seem superficial, we advise library developers facilitating
|
||||
#pod this role to follow the precedent. This ensures that when another component needs to
|
||||
#pod tie between the namespace and any additional customizations everything will run in the
|
||||
#pod correct order. An example of this separation would be
|
||||
#pod
|
||||
#pod class Foo is mutable ...
|
||||
#pod
|
||||
#pod being an option of the namespace generation, while
|
||||
#pod
|
||||
#pod class Foo with Bar ...
|
||||
#pod
|
||||
#pod is an additional optional customization.
|
||||
#pod
|
||||
#pod =head2 handle_post_parsing
|
||||
#pod
|
||||
#pod Object->handle_post_parsing (Object $context, Str $package, Str | Object $name)
|
||||
#pod
|
||||
#pod Allows for additional modifications to the namespace after everything else has been
|
||||
#pod done. It will receive the context, the fully qualified package name, and either a
|
||||
#pod string with the name that was specified (might not be fully qualified, since
|
||||
#pod namespaces can be nested) or the anonymous metaclass instance if no name was
|
||||
#pod specified.
|
||||
#pod
|
||||
#pod The return value of this method will be the value returned to the user of the
|
||||
#pod keyword. If you always return the C<$package> argument like this:
|
||||
#pod
|
||||
#pod sub handle_post_parsing {
|
||||
#pod my ($self, $context, $package, $name) = @_;
|
||||
#pod return $package;
|
||||
#pod }
|
||||
#pod
|
||||
#pod and set this up in a C<foo> keyword handler, you can use it like this:
|
||||
#pod
|
||||
#pod foo Cthulhu {
|
||||
#pod
|
||||
#pod my $fhtagn = foo Fhtagn { }
|
||||
#pod my $anon = foo { };
|
||||
#pod
|
||||
#pod say $fhtagn; # Cthulhu::Fhtagn
|
||||
#pod say $anon; # some autogenerated package name
|
||||
#pod }
|
||||
#pod
|
||||
#pod =head2 make_anon_metaclass
|
||||
#pod
|
||||
#pod Class::MOP::Class Object->make_anon_metaclass ()
|
||||
#pod
|
||||
#pod This method should be overridden if you want to provide anonymous namespaces.
|
||||
#pod
|
||||
#pod It does not receive any arguments for customization of the metaclass, because
|
||||
#pod the configuration and customization will be done by L<MooseX::Declare> in the
|
||||
#pod package of the generated class in the same way as in those that have specified
|
||||
#pod names. This way ensures that anonymous and named namespaces are always handled
|
||||
#pod equally.
|
||||
#pod
|
||||
#pod If you do not extend this method (it will return nothing by default), an error
|
||||
#pod will be thrown when a user attempts to declare an anonymous namespace.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub add_namespace_customizations { }
|
||||
sub add_optional_customizations { }
|
||||
sub handle_post_parsing { }
|
||||
sub make_anon_metaclass { }
|
||||
|
||||
around context_traits => sub { super, WithOptions, Namespaced };
|
||||
|
||||
sub parse_specification {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
$self->parse_namespace_specification($ctx);
|
||||
$self->parse_option_specification($ctx);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub parse_namespace_specification {
|
||||
my ($self, $ctx) = @_;
|
||||
return scalar $ctx->strip_namespace;
|
||||
}
|
||||
|
||||
sub parse_option_specification {
|
||||
my ($self, $ctx) = @_;
|
||||
return scalar $ctx->strip_options;
|
||||
}
|
||||
|
||||
sub generate_inline_stack {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
return join ', ',
|
||||
map { $_->serialize }
|
||||
@{ $ctx->stack },
|
||||
$self->generate_current_stack_item($ctx);
|
||||
}
|
||||
|
||||
sub generate_current_stack_item {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
return StackItem->new(
|
||||
identifier => $self->identifier,
|
||||
is_dirty => $ctx->options->{is}{dirty},
|
||||
is_parameterized => does_role($ctx, Parameterized) && $ctx->has_parameter_signature,
|
||||
handler => ref($self),
|
||||
namespace => $ctx->namespace,
|
||||
);
|
||||
}
|
||||
|
||||
#pod =method parse
|
||||
#pod
|
||||
#pod Any Object->parse (Object $context)
|
||||
#pod
|
||||
#pod This is the main handling routine for namespaces. It will remove the namespace
|
||||
#pod name and its options. If the handler was invoked without a name, options or
|
||||
#pod a following block, it is assumed that this is an instance of an autoquoted
|
||||
#pod bareword like C<< class => "Foo" >>.
|
||||
#pod
|
||||
#pod The return value of the C<parse> method is also the value that is returned
|
||||
#pod to the user of the keyword.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub parse {
|
||||
my ($self, $ctx) = @_;
|
||||
|
||||
# keyword comes first
|
||||
$ctx->skip_declarator;
|
||||
|
||||
# read the name and unwrap the options
|
||||
$self->parse_specification($ctx);
|
||||
|
||||
my $name = $ctx->namespace;
|
||||
|
||||
my ($package, $anon);
|
||||
|
||||
# we have a name in the declaration, which will be used as package name
|
||||
if (defined $name) {
|
||||
$package = $name;
|
||||
|
||||
# there is an outer namespace stack item, meaning we namespace below
|
||||
# it, if the name starts with ::
|
||||
if (my $outer = outer_stack_peek $ctx->caller_file) {
|
||||
$package = $outer . $package
|
||||
if $name =~ /^::/;
|
||||
}
|
||||
}
|
||||
|
||||
# no name, no options, no block. Probably { class => 'foo' }
|
||||
elsif (not(keys %{ $ctx->options }) and $ctx->peek_next_char ne '{') {
|
||||
return;
|
||||
}
|
||||
|
||||
# we have options and/or a block, but not name
|
||||
else {
|
||||
$anon = $self->make_anon_metaclass
|
||||
or croak sprintf 'Unable to create an anonymized %s namespace', $self->identifier;
|
||||
$package = $anon->name;
|
||||
}
|
||||
|
||||
# namespace and mx:d initialisations
|
||||
$ctx->add_preamble_code_parts(
|
||||
"package ${package}",
|
||||
sprintf(
|
||||
"use %s %s => '%s', file => __FILE__, stack => [ %s ]",
|
||||
$ctx->provided_by,
|
||||
outer_package => $package,
|
||||
$self->generate_inline_stack($ctx),
|
||||
),
|
||||
);
|
||||
|
||||
# allow consumer to provide specialisations
|
||||
$self->add_namespace_customizations($ctx, $package);
|
||||
|
||||
# make options a separate step
|
||||
$self->add_optional_customizations($ctx, $package);
|
||||
|
||||
# finish off preamble with a namespace cleanup
|
||||
$ctx->add_preamble_code_parts(
|
||||
$ctx->options->{is}->{dirty}
|
||||
? 'use namespace::clean -except => [qw( meta )]'
|
||||
: 'use namespace::autoclean'
|
||||
);
|
||||
|
||||
# clean up our stack afterwards, if there was a name
|
||||
$ctx->add_cleanup_code_parts(
|
||||
['BEGIN',
|
||||
'MooseX::Declare::Util::outer_stack_pop __FILE__',
|
||||
],
|
||||
);
|
||||
|
||||
# actual code injection
|
||||
$ctx->inject_code_parts(
|
||||
missing_block_handler => sub { $self->handle_missing_block(@_) },
|
||||
);
|
||||
|
||||
# a last chance to change things
|
||||
$self->handle_post_parsing($ctx, $package, defined($name) ? $name : $anon);
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::MooseSetup>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::NamespaceHandling - Handle namespaced blocks
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Allows the implementation of namespaced blocks like the
|
||||
L<role|MooseX::Declare::Syntax::Keyword::Role> and
|
||||
L<class|MooseX::Declare::Syntax::Keyword::Class> keyword handlers.
|
||||
|
||||
Namespaces are automatically nested. Meaning that, for example, a C<class Bar>
|
||||
declaration inside another C<class Foo> block gives the inner one actually the
|
||||
name C<Foo::Bar>.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 parse
|
||||
|
||||
Any Object->parse (Object $context)
|
||||
|
||||
This is the main handling routine for namespaces. It will remove the namespace
|
||||
name and its options. If the handler was invoked without a name, options or
|
||||
a following block, it is assumed that this is an instance of an autoquoted
|
||||
bareword like C<< class => "Foo" >>.
|
||||
|
||||
The return value of the C<parse> method is also the value that is returned
|
||||
to the user of the keyword.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::KeywordHandling>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::InnerSyntaxHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 REQUIRED METHODS
|
||||
|
||||
=head2 handle_missing_block
|
||||
|
||||
Object->handle_missing_block (Object $context, Str $body, %args)
|
||||
|
||||
This must be implemented to decide what to do in case the statement is
|
||||
terminated rather than followed by a block. It will receive the context
|
||||
object, the produced code that needs to be injected, and all the arguments
|
||||
that were passed to the call to L<MooseX::Declare::Context/inject_code_parts>.
|
||||
|
||||
The return value will be ignored.
|
||||
|
||||
=head1 EXTENDABLE STUB METHODS
|
||||
|
||||
=head2 add_namespace_customizations
|
||||
|
||||
=head2 add_optional_customizations
|
||||
|
||||
Object->add_namespace_customizations (Object $context, Str $package, HashRef $options)
|
||||
Object->add_optional_customizations (Object $context, Str $package, HashRef $options)
|
||||
|
||||
These will be called (in this order) by the L</parse> method. They allow specific hooks
|
||||
to attach before/after/around the customizations for the namespace and the provided
|
||||
options that are not attached to the namespace directly.
|
||||
|
||||
While this distinction might seem superficial, we advise library developers facilitating
|
||||
this role to follow the precedent. This ensures that when another component needs to
|
||||
tie between the namespace and any additional customizations everything will run in the
|
||||
correct order. An example of this separation would be
|
||||
|
||||
class Foo is mutable ...
|
||||
|
||||
being an option of the namespace generation, while
|
||||
|
||||
class Foo with Bar ...
|
||||
|
||||
is an additional optional customization.
|
||||
|
||||
=head2 handle_post_parsing
|
||||
|
||||
Object->handle_post_parsing (Object $context, Str $package, Str | Object $name)
|
||||
|
||||
Allows for additional modifications to the namespace after everything else has been
|
||||
done. It will receive the context, the fully qualified package name, and either a
|
||||
string with the name that was specified (might not be fully qualified, since
|
||||
namespaces can be nested) or the anonymous metaclass instance if no name was
|
||||
specified.
|
||||
|
||||
The return value of this method will be the value returned to the user of the
|
||||
keyword. If you always return the C<$package> argument like this:
|
||||
|
||||
sub handle_post_parsing {
|
||||
my ($self, $context, $package, $name) = @_;
|
||||
return $package;
|
||||
}
|
||||
|
||||
and set this up in a C<foo> keyword handler, you can use it like this:
|
||||
|
||||
foo Cthulhu {
|
||||
|
||||
my $fhtagn = foo Fhtagn { }
|
||||
my $anon = foo { };
|
||||
|
||||
say $fhtagn; # Cthulhu::Fhtagn
|
||||
say $anon; # some autogenerated package name
|
||||
}
|
||||
|
||||
=head2 make_anon_metaclass
|
||||
|
||||
Class::MOP::Class Object->make_anon_metaclass ()
|
||||
|
||||
This method should be overridden if you want to provide anonymous namespaces.
|
||||
|
||||
It does not receive any arguments for customization of the metaclass, because
|
||||
the configuration and customization will be done by L<MooseX::Declare> in the
|
||||
package of the generated class in the same way as in those that have specified
|
||||
names. This way ensures that anonymous and named namespaces are always handled
|
||||
equally.
|
||||
|
||||
If you do not extend this method (it will return nothing by default), an error
|
||||
will be thrown when a user attempts to declare an anonymous namespace.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::MooseSetup>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
157
database/perl/vendor/lib/MooseX/Declare/Syntax/OptionHandling.pm
vendored
Normal file
157
database/perl/vendor/lib/MooseX/Declare/Syntax/OptionHandling.pm
vendored
Normal file
@@ -0,0 +1,157 @@
|
||||
package MooseX::Declare::Syntax::OptionHandling;
|
||||
# ABSTRACT: Option parser dispatching
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use Carp qw( croak );
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This role will call a C<add_foo_option_customization> for every C<foo> option
|
||||
#pod that is discovered.
|
||||
#pod
|
||||
#pod =head1 REQUIRED METHODS
|
||||
#pod
|
||||
#pod =head2 get_identifier
|
||||
#pod
|
||||
#pod Str Object->get_identifier ()
|
||||
#pod
|
||||
#pod This must return the name of the current keyword's identifier.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
requires qw( get_identifier );
|
||||
|
||||
#pod =method ignored_options
|
||||
#pod
|
||||
#pod List[Str] Object->ignored_options ()
|
||||
#pod
|
||||
#pod This method returns a list of option names that won't be dispatched. By default
|
||||
#pod this only contains the C<is> option.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub ignored_options { qw( is ) }
|
||||
|
||||
|
||||
#pod =head1 MODIFIED METHODS
|
||||
#pod
|
||||
#pod =head2 add_optional_customizations
|
||||
#pod
|
||||
#pod Object->add_optional_customizations (Object $context, Str $package, HashRef $options)
|
||||
#pod
|
||||
#pod This will dispatch to the respective C<add_*_option_customization> method for option
|
||||
#pod handling unless the option is listed in the L</ignored_options>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
after add_optional_customizations => sub {
|
||||
my ($self, $ctx, $package) = @_;
|
||||
my $options = $ctx->options;
|
||||
|
||||
# ignored options
|
||||
my %ignored = map { ($_ => 1) } $self->ignored_options;
|
||||
|
||||
# try to find a handler for each option
|
||||
for my $option (keys %$options) {
|
||||
next if $ignored{ $option };
|
||||
|
||||
# call the handler with its own value and all options
|
||||
if (my $method = $self->can("add_${option}_option_customizations")) {
|
||||
$self->$method($ctx, $package, $options->{ $option }, $options);
|
||||
}
|
||||
|
||||
# no handler method was found
|
||||
else {
|
||||
croak sprintf q/The '%s' keyword does not know what to do with an '%s' option/,
|
||||
$self->get_identifier,
|
||||
$option;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
};
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::OptionHandling - Option parser dispatching
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role will call a C<add_foo_option_customization> for every C<foo> option
|
||||
that is discovered.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 ignored_options
|
||||
|
||||
List[Str] Object->ignored_options ()
|
||||
|
||||
This method returns a list of option names that won't be dispatched. By default
|
||||
this only contains the C<is> option.
|
||||
|
||||
=head1 REQUIRED METHODS
|
||||
|
||||
=head2 get_identifier
|
||||
|
||||
Str Object->get_identifier ()
|
||||
|
||||
This must return the name of the current keyword's identifier.
|
||||
|
||||
=head1 MODIFIED METHODS
|
||||
|
||||
=head2 add_optional_customizations
|
||||
|
||||
Object->add_optional_customizations (Object $context, Str $package, HashRef $options)
|
||||
|
||||
This will dispatch to the respective C<add_*_option_customization> method for option
|
||||
handling unless the option is listed in the L</ignored_options>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::NamespaceHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
134
database/perl/vendor/lib/MooseX/Declare/Syntax/RoleApplication.pm
vendored
Normal file
134
database/perl/vendor/lib/MooseX/Declare/Syntax/RoleApplication.pm
vendored
Normal file
@@ -0,0 +1,134 @@
|
||||
package MooseX::Declare::Syntax::RoleApplication;
|
||||
# ABSTRACT: Handle user specified roles
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Moose::Role;
|
||||
use aliased 'MooseX::Declare::Context::Namespaced';
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This role extends L<MooseX::Declare::Syntax::OptionHandling> and provides
|
||||
#pod a C<with|/add_with_option_customizations> option.
|
||||
#pod
|
||||
#pod =head1 CONSUMES
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare::Syntax::OptionHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
with qw(
|
||||
MooseX::Declare::Syntax::OptionHandling
|
||||
);
|
||||
|
||||
around context_traits => sub { shift->(@_), Namespaced };
|
||||
|
||||
#pod =method add_with_option_customizations
|
||||
#pod
|
||||
#pod Object->add_with_option_customizations (
|
||||
#pod Object $context,
|
||||
#pod Str $package,
|
||||
#pod ArrayRef $roles,
|
||||
#pod HashRef $options
|
||||
#pod )
|
||||
#pod
|
||||
#pod This will add a call to C<with> in the scope code.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub add_with_option_customizations {
|
||||
my ($self, $ctx, $package, $roles) = @_;
|
||||
|
||||
# consume roles
|
||||
$ctx->add_early_cleanup_code_parts(
|
||||
sprintf 'Moose::Util::apply_all_roles(%s->meta, %s)',
|
||||
$package,
|
||||
join ', ',
|
||||
map { "q[$_]" }
|
||||
map { $ctx->qualify_namespace($_) }
|
||||
@{ $roles },
|
||||
);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod * L<MooseX::Declare::Syntax::OptionHandling>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Syntax::RoleApplication - Handle user specified roles
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This role extends L<MooseX::Declare::Syntax::OptionHandling> and provides
|
||||
a C<with|/add_with_option_customizations> option.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 add_with_option_customizations
|
||||
|
||||
Object->add_with_option_customizations (
|
||||
Object $context,
|
||||
Str $package,
|
||||
ArrayRef $roles,
|
||||
HashRef $options
|
||||
)
|
||||
|
||||
This will add a call to C<with> in the scope code.
|
||||
|
||||
=head1 CONSUMES
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::OptionHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare::Syntax::OptionHandling>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
149
database/perl/vendor/lib/MooseX/Declare/Util.pm
vendored
Normal file
149
database/perl/vendor/lib/MooseX/Declare/Util.pm
vendored
Normal file
@@ -0,0 +1,149 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package MooseX::Declare::Util;
|
||||
# ABSTRACT: Common declarative utility functions
|
||||
|
||||
our $VERSION = '0.43';
|
||||
|
||||
use Sub::Exporter -setup => {
|
||||
exports => [qw(
|
||||
outer_stack_push
|
||||
outer_stack_pop
|
||||
outer_stack_peek
|
||||
)],
|
||||
};
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This exporter collection contains the commonly used functions in
|
||||
#pod L<MooseX::Declare>.
|
||||
#pod
|
||||
#pod All functions in this package will be exported upon request.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
my %OuterStack;
|
||||
|
||||
|
||||
#pod =func outer_stack_push
|
||||
#pod
|
||||
#pod outer_stack_push (Str $file, Str $value)
|
||||
#pod
|
||||
#pod Pushes the C<$value> on the internal stack for the file C<$file>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub outer_stack_push {
|
||||
my ($file, $value) = @_;
|
||||
|
||||
push @{ $OuterStack{ $file } }, $value;
|
||||
return $value;
|
||||
}
|
||||
|
||||
#pod =func outer_stack_pop
|
||||
#pod
|
||||
#pod outer_stack_pop (Str $file)
|
||||
#pod
|
||||
#pod Removes one item from the internal stack of the file C<$file>.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub outer_stack_pop {
|
||||
my ($file) = @_;
|
||||
|
||||
return undef
|
||||
unless @{ $OuterStack{ $file } || [] };
|
||||
return pop @{ $OuterStack{ $file } };
|
||||
}
|
||||
|
||||
#pod =func outer_stack_peek
|
||||
#pod
|
||||
#pod outer_stack_peek (Str $file)
|
||||
#pod
|
||||
#pod Returns the topmost item in the internal stack for C<$file> without removing
|
||||
#pod it from the stack.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub outer_stack_peek {
|
||||
my ($file) = @_;
|
||||
|
||||
return undef
|
||||
unless @{ $OuterStack{ $file } || [] };
|
||||
return $OuterStack{ $file }[-1];
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod =for :list
|
||||
#pod * L<MooseX::Declare>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Declare::Util - Common declarative utility functions
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.43
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This exporter collection contains the commonly used functions in
|
||||
L<MooseX::Declare>.
|
||||
|
||||
All functions in this package will be exported upon request.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 outer_stack_push
|
||||
|
||||
outer_stack_push (Str $file, Str $value)
|
||||
|
||||
Pushes the C<$value> on the internal stack for the file C<$file>.
|
||||
|
||||
=head2 outer_stack_pop
|
||||
|
||||
outer_stack_pop (Str $file)
|
||||
|
||||
Removes one item from the internal stack of the file C<$file>.
|
||||
|
||||
=head2 outer_stack_peek
|
||||
|
||||
outer_stack_peek (Str $file)
|
||||
|
||||
Returns the topmost item in the internal stack for C<$file> without removing
|
||||
it from the stack.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
182
database/perl/vendor/lib/MooseX/LazyRequire.pm
vendored
Normal file
182
database/perl/vendor/lib/MooseX/LazyRequire.pm
vendored
Normal file
@@ -0,0 +1,182 @@
|
||||
package MooseX::LazyRequire;
|
||||
# git description: v0.10-7-gf996968
|
||||
$MooseX::LazyRequire::VERSION = '0.11';
|
||||
# ABSTRACT: Required attributes which fail only when trying to use them
|
||||
# KEYWORDS: moose extension attribute required lazy defer populate method
|
||||
|
||||
use Moose 0.94 ();
|
||||
use Moose::Exporter;
|
||||
use aliased 0.30 'MooseX::LazyRequire::Meta::Attribute::Trait::LazyRequire';
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 SYNOPSIS
|
||||
#pod
|
||||
#pod package Foo;
|
||||
#pod
|
||||
#pod use Moose;
|
||||
#pod use MooseX::LazyRequire;
|
||||
#pod
|
||||
#pod has foo => (
|
||||
#pod is => 'ro',
|
||||
#pod lazy_required => 1,
|
||||
#pod );
|
||||
#pod
|
||||
#pod has bar => (
|
||||
#pod is => 'ro',
|
||||
#pod builder => '_build_bar',
|
||||
#pod );
|
||||
#pod
|
||||
#pod sub _build_bar { shift->foo }
|
||||
#pod
|
||||
#pod
|
||||
#pod Foo->new(foo => 42); # succeeds, foo and bar will be 42
|
||||
#pod Foo->new(bar => 42); # succeeds, bar will be 42
|
||||
#pod Foo->new; # fails, neither foo nor bare were given
|
||||
#pod
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This module adds a C<lazy_required> option to Moose attribute declarations.
|
||||
#pod
|
||||
#pod The reader methods for all attributes with that option will throw an exception
|
||||
#pod unless a value for the attributes was provided earlier by a constructor
|
||||
#pod parameter or through a writer method.
|
||||
#pod
|
||||
#pod =head1 CAVEATS
|
||||
#pod
|
||||
#pod Prior to Moose 1.9900, roles didn't have an attribute metaclass, so this module can't
|
||||
#pod easily apply its magic to attributes defined in roles. If you want to use
|
||||
#pod C<lazy_required> in role attributes, you'll have to apply the attribute trait
|
||||
#pod yourself:
|
||||
#pod
|
||||
#pod has foo => (
|
||||
#pod traits => ['LazyRequire'],
|
||||
#pod is => 'ro',
|
||||
#pod lazy_required => 1,
|
||||
#pod );
|
||||
#pod
|
||||
#pod With Moose 1.9900, you can use this module in roles just the same way you can
|
||||
#pod in classes.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
my %metaroles = (
|
||||
class_metaroles => {
|
||||
attribute => [LazyRequire],
|
||||
},
|
||||
);
|
||||
|
||||
$metaroles{role_metaroles} = {
|
||||
applied_attribute => [LazyRequire],
|
||||
}
|
||||
if $Moose::VERSION >= 1.9900;
|
||||
|
||||
Moose::Exporter->setup_import_methods(%metaroles);
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::LazyRequire - Required attributes which fail only when trying to use them
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.11
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Foo;
|
||||
|
||||
use Moose;
|
||||
use MooseX::LazyRequire;
|
||||
|
||||
has foo => (
|
||||
is => 'ro',
|
||||
lazy_required => 1,
|
||||
);
|
||||
|
||||
has bar => (
|
||||
is => 'ro',
|
||||
builder => '_build_bar',
|
||||
);
|
||||
|
||||
sub _build_bar { shift->foo }
|
||||
|
||||
|
||||
Foo->new(foo => 42); # succeeds, foo and bar will be 42
|
||||
Foo->new(bar => 42); # succeeds, bar will be 42
|
||||
Foo->new; # fails, neither foo nor bare were given
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module adds a C<lazy_required> option to Moose attribute declarations.
|
||||
|
||||
The reader methods for all attributes with that option will throw an exception
|
||||
unless a value for the attributes was provided earlier by a constructor
|
||||
parameter or through a writer method.
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
Prior to Moose 1.9900, roles didn't have an attribute metaclass, so this module can't
|
||||
easily apply its magic to attributes defined in roles. If you want to use
|
||||
C<lazy_required> in role attributes, you'll have to apply the attribute trait
|
||||
yourself:
|
||||
|
||||
has foo => (
|
||||
traits => ['LazyRequire'],
|
||||
is => 'ro',
|
||||
lazy_required => 1,
|
||||
);
|
||||
|
||||
With Moose 1.9900, you can use this module in roles just the same way you can
|
||||
in classes.
|
||||
|
||||
=for Pod::Coverage init_meta
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=back
|
||||
|
||||
=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 the Perl 5 programming language system itself.
|
||||
|
||||
=head1 CONTRIBUTORS
|
||||
|
||||
=for stopwords Karen Etheridge David Precious Jesse Luehrs
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
David Precious <davidp@preshweb.co.uk>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@tozt.net>
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
80
database/perl/vendor/lib/MooseX/LazyRequire/Meta/Attribute/Trait/LazyRequire.pm
vendored
Normal file
80
database/perl/vendor/lib/MooseX/LazyRequire/Meta/Attribute/Trait/LazyRequire.pm
vendored
Normal file
@@ -0,0 +1,80 @@
|
||||
package MooseX::LazyRequire::Meta::Attribute::Trait::LazyRequire;
|
||||
# ABSTRACT: Attribute trait to make getters fail on unset attributes
|
||||
$MooseX::LazyRequire::Meta::Attribute::Trait::LazyRequire::VERSION = '0.11';
|
||||
use Moose::Role;
|
||||
use Carp qw/cluck/;
|
||||
use namespace::autoclean;
|
||||
|
||||
has lazy_required => (
|
||||
is => 'ro',
|
||||
isa => 'Bool',
|
||||
default => 0,
|
||||
);
|
||||
|
||||
after _process_options => sub {
|
||||
my ($class, $name, $options) = @_;
|
||||
|
||||
if (exists $options->{lazy_require}) {
|
||||
cluck "deprecated option 'lazy_require' used. use 'lazy_required' instead.";
|
||||
$options->{lazy_required} = delete $options->{lazy_require};
|
||||
}
|
||||
|
||||
return unless $options->{lazy_required};
|
||||
|
||||
# lazy_required + default or builder doesn't make sense because if there
|
||||
# is a default/builder, the reader will always be able to return a value.
|
||||
Moose->throw_error(
|
||||
"You may not use both a builder or a default and lazy_required for one attribute ($name)",
|
||||
data => $options,
|
||||
) if $options->{builder} or $options->{default};
|
||||
|
||||
$options->{ lazy } = 1;
|
||||
$options->{ required } = 1;
|
||||
$options->{ default } = sub {
|
||||
confess "Attribute '$name' must be provided before calling reader"
|
||||
};
|
||||
};
|
||||
|
||||
package # hide
|
||||
Moose::Meta::Attribute::Custom::Trait::LazyRequire;
|
||||
|
||||
sub register_implementation { 'MooseX::LazyRequire::Meta::Attribute::Trait::LazyRequire' }
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::LazyRequire::Meta::Attribute::Trait::LazyRequire - Attribute trait to make getters fail on unset attributes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.11
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=back
|
||||
|
||||
=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 the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
15
database/perl/vendor/lib/MooseX/Meta/TypeCoercion/Structured.pm
vendored
Normal file
15
database/perl/vendor/lib/MooseX/Meta/TypeCoercion/Structured.pm
vendored
Normal file
@@ -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);
|
||||
29
database/perl/vendor/lib/MooseX/Meta/TypeCoercion/Structured/Optional.pm
vendored
Normal file
29
database/perl/vendor/lib/MooseX/Meta/TypeCoercion/Structured/Optional.pm
vendored
Normal file
@@ -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;
|
||||
145
database/perl/vendor/lib/MooseX/Meta/TypeConstraint/ForceCoercion.pm
vendored
Normal file
145
database/perl/vendor/lib/MooseX/Meta/TypeConstraint/ForceCoercion.pm
vendored
Normal file
@@ -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.
|
||||
|
||||
500
database/perl/vendor/lib/MooseX/Meta/TypeConstraint/Structured.pm
vendored
Normal file
500
database/perl/vendor/lib/MooseX/Meta/TypeConstraint/Structured.pm
vendored
Normal file
@@ -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
|
||||
25
database/perl/vendor/lib/MooseX/Meta/TypeConstraint/Structured/Optional.pm
vendored
Normal file
25
database/perl/vendor/lib/MooseX/Meta/TypeConstraint/Structured/Optional.pm
vendored
Normal file
@@ -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;
|
||||
777
database/perl/vendor/lib/MooseX/Method/Signatures.pm
vendored
Normal file
777
database/perl/vendor/lib/MooseX/Method/Signatures.pm
vendored
Normal file
@@ -0,0 +1,777 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package MooseX::Method::Signatures; # git description: v0.48-15-gd03dfc1
|
||||
# ABSTRACT: (DEPRECATED) Method declarations with type constraints and no source filter
|
||||
# KEYWORDS: moose extension method declaration signature prototype syntax sugar deprecated
|
||||
|
||||
our $VERSION = '0.49';
|
||||
|
||||
use Moose 0.89;
|
||||
use Devel::Declare 0.005011 ();
|
||||
use B::Hooks::EndOfScope 0.10;
|
||||
use Moose::Meta::Class;
|
||||
use MooseX::LazyRequire 0.06;
|
||||
use MooseX::Types::Moose 0.19 qw/Str Bool CodeRef/;
|
||||
use Text::Balanced qw/extract_quotelike/;
|
||||
use MooseX::Method::Signatures::Meta::Method;
|
||||
use MooseX::Method::Signatures::Types qw/PrototypeInjections/;
|
||||
use Sub::Name;
|
||||
use Moose::Util 'find_meta';
|
||||
use Module::Runtime 'use_module';
|
||||
use Carp;
|
||||
|
||||
use aliased 'Devel::Declare::Context::Simple', 'ContextSimple';
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
has package => (
|
||||
is => 'ro',
|
||||
isa => Str,
|
||||
lazy_required => 1,
|
||||
);
|
||||
|
||||
has context => (
|
||||
is => 'ro',
|
||||
isa => ContextSimple,
|
||||
lazy => 1,
|
||||
builder => '_build_context',
|
||||
);
|
||||
|
||||
has initialized_context => (
|
||||
is => 'ro',
|
||||
isa => Bool,
|
||||
default => 0,
|
||||
);
|
||||
|
||||
has custom_method_application => (
|
||||
is => 'ro',
|
||||
isa => CodeRef,
|
||||
predicate => 'has_custom_method_application',
|
||||
);
|
||||
|
||||
has prototype_injections => (
|
||||
is => 'ro',
|
||||
isa => PrototypeInjections,
|
||||
predicate => 'has_prototype_injections',
|
||||
);
|
||||
|
||||
sub _build_context {
|
||||
my ($self) = @_;
|
||||
return ContextSimple->new(into => $self->package);
|
||||
}
|
||||
|
||||
sub import {
|
||||
my ($class, %args) = @_;
|
||||
my $caller = caller();
|
||||
$class->setup_for($caller, \%args);
|
||||
}
|
||||
|
||||
sub setup_for {
|
||||
my ($class, $pkg, $args) = @_;
|
||||
|
||||
# process arguments to import
|
||||
while (my ($declarator, $injections) = each %{ $args }) {
|
||||
my $obj = $class->new(
|
||||
package => $pkg,
|
||||
prototype_injections => {
|
||||
declarator => $declarator,
|
||||
injections => $injections,
|
||||
},
|
||||
);
|
||||
|
||||
Devel::Declare->setup_for($pkg, {
|
||||
$declarator => { const => sub { $obj->parser(@_) } },
|
||||
});
|
||||
|
||||
{
|
||||
no strict 'refs';
|
||||
*{ "${pkg}::$declarator" } = sub {};
|
||||
}
|
||||
}
|
||||
|
||||
my $self = $class->new(package => $pkg);
|
||||
|
||||
Devel::Declare->setup_for($pkg, {
|
||||
method => { const => sub { $self->parser(@_) } },
|
||||
});
|
||||
|
||||
{
|
||||
no strict 'refs';
|
||||
*{ "${pkg}::method" } = sub {};
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub strip_name {
|
||||
my ($self) = @_;
|
||||
my $ctx = $self->context;
|
||||
my $ret = $ctx->strip_name;
|
||||
return $ret if defined $ret;
|
||||
|
||||
my $line = $ctx->get_linestr;
|
||||
my $offset = $ctx->offset;
|
||||
local $@;
|
||||
my $copy = substr($line, $offset);
|
||||
my ($str) = extract_quotelike($copy);
|
||||
return unless defined $str;
|
||||
|
||||
return if ($@ && $@ =~ /^No quotelike operator found/);
|
||||
die $@ if $@;
|
||||
|
||||
substr($line, $offset, length $str) = '';
|
||||
$ctx->set_linestr($line);
|
||||
|
||||
return \$str;
|
||||
}
|
||||
|
||||
sub strip_traits {
|
||||
my ($self) = @_;
|
||||
|
||||
my $ctx = $self->context;
|
||||
my $linestr = $ctx->get_linestr;
|
||||
|
||||
unless (substr($linestr, $ctx->offset, 2) eq 'is' ||
|
||||
substr($linestr, $ctx->offset, 4) eq 'does') {
|
||||
# No 'is' means no traits
|
||||
return;
|
||||
}
|
||||
|
||||
my @traits;
|
||||
|
||||
while (1) {
|
||||
if (substr($linestr, $ctx->offset, 2) eq 'is') {
|
||||
# Eat the 'is' so we can call strip_names_and_args
|
||||
substr($linestr, $ctx->offset, 2) = '';
|
||||
} elsif (substr($linestr, $ctx->offset, 4) eq 'does') {
|
||||
# Eat the 'does' so we can call strip_names_and_args
|
||||
substr($linestr, $ctx->offset, 4) = '';
|
||||
} else {
|
||||
last;
|
||||
}
|
||||
|
||||
$ctx->set_linestr($linestr);
|
||||
push @traits, @{ $ctx->strip_names_and_args };
|
||||
# Get the current linestr so that the loop can look for more 'is'
|
||||
$ctx->skipspace;
|
||||
$linestr = $ctx->get_linestr;
|
||||
}
|
||||
|
||||
confess "expected traits after 'is' or 'does', found nothing"
|
||||
unless scalar(@traits);
|
||||
|
||||
# Let's check to make sure these traits aren't aliased locally
|
||||
for my $t (@traits) {
|
||||
next if $t->[0] =~ /::/;
|
||||
my $class = $ctx->get_curstash_name;
|
||||
my $meta = find_meta($class) || Moose::Meta::Class->initialize($class);
|
||||
my $func = $meta->get_package_symbol('&' . $t->[0]);
|
||||
next unless $func;
|
||||
|
||||
my $proto = prototype $func;
|
||||
next if !defined $proto || length $proto;
|
||||
|
||||
$t->[0] = $func->();
|
||||
}
|
||||
|
||||
return \@traits;
|
||||
}
|
||||
|
||||
sub strip_return_type_constraint {
|
||||
my ($self) = @_;
|
||||
my $ctx = $self->context;
|
||||
my $returns = $ctx->strip_name;
|
||||
return unless defined $returns;
|
||||
confess "expected 'returns', found '${returns}'"
|
||||
unless $returns eq 'returns';
|
||||
return $ctx->strip_proto;
|
||||
}
|
||||
|
||||
sub parser {
|
||||
my $self = shift;
|
||||
my $err;
|
||||
|
||||
# Keep any previous compile errors from getting stepped on. But report
|
||||
# errors from inside MXMS nicely.
|
||||
{
|
||||
local $@;
|
||||
eval { $self->_parser(@_) };
|
||||
$err = $@;
|
||||
}
|
||||
|
||||
die $err if $err;
|
||||
}
|
||||
|
||||
my $anon_counter = 1;
|
||||
sub _parser {
|
||||
my $self = shift;
|
||||
my $ctx = $self->context;
|
||||
$ctx->init(@_) unless $self->initialized_context;
|
||||
|
||||
$ctx->skip_declarator;
|
||||
my $name = $self->strip_name;
|
||||
my $proto = $ctx->strip_proto;
|
||||
my $attrs = $ctx->strip_attrs || '';
|
||||
my $traits = $self->strip_traits;
|
||||
my $ret_tc = $self->strip_return_type_constraint;
|
||||
|
||||
my $compile_stash = $ctx->get_curstash_name;
|
||||
|
||||
my %args = (
|
||||
# This might get reset later, but its where we search for exported
|
||||
# symbols at compile time
|
||||
package_name => $compile_stash,
|
||||
);
|
||||
$args{ signature } = qq{($proto)} if defined $proto;
|
||||
$args{ traits } = $traits if $traits;
|
||||
$args{ return_signature } = $ret_tc if defined $ret_tc;
|
||||
|
||||
# Class::MOP::Method requires a name
|
||||
$args{ name } = $name || '__ANON__'.($anon_counter++).'__';
|
||||
|
||||
if ($self->has_prototype_injections) {
|
||||
confess('Configured declarator does not match context declarator')
|
||||
if $ctx->declarator ne $self->prototype_injections->{declarator};
|
||||
$args{prototype_injections} = $self->prototype_injections->{injections};
|
||||
}
|
||||
|
||||
my $meth_class = 'MooseX::Method::Signatures::Meta::Method';
|
||||
if ($args{traits}) {
|
||||
my @traits = ();
|
||||
foreach my $t (@{$args{traits}}) {
|
||||
use_module($t->[0]);
|
||||
if ($t->[1]) {
|
||||
%args = (%args, eval $t->[1]);
|
||||
};
|
||||
push @traits, $t->[0];
|
||||
}
|
||||
my $meta = Moose::Meta::Class->create_anon_class(
|
||||
superclasses => [ $meth_class ],
|
||||
roles => [ @traits ],
|
||||
cache => 1,
|
||||
);
|
||||
$meth_class = $meta->name;
|
||||
delete $args{traits};
|
||||
}
|
||||
|
||||
my $proto_method = $meth_class->wrap(sub { }, %args);
|
||||
|
||||
my $after_block = ')';
|
||||
|
||||
if ($traits) {
|
||||
if (my @trait_args = grep { defined } map { $_->[1] } @{ $traits }) {
|
||||
$after_block = q{, } . join(q{,} => @trait_args) . $after_block;
|
||||
}
|
||||
}
|
||||
|
||||
if (defined $name) {
|
||||
my $name_arg = q{, } . (ref $name ? ${$name} : qq{q[${name}]});
|
||||
$after_block = $name_arg . $after_block . q{;};
|
||||
}
|
||||
|
||||
my $inject = $proto_method->injectable_code;
|
||||
$inject = $self->scope_injector_call($after_block) . $inject;
|
||||
|
||||
$ctx->inject_if_block($inject, "(sub ${attrs} ");
|
||||
|
||||
my $create_meta_method = sub {
|
||||
my ($code, $pkg, $meth_name, @args) = @_;
|
||||
subname $pkg . "::" .$meth_name, $code;
|
||||
|
||||
# we want to reinitialize with all the args,
|
||||
# so we give the opportunity for traits to wrap the correct
|
||||
# closure.
|
||||
my %other_args = %{$proto_method};
|
||||
delete $other_args{body};
|
||||
delete $other_args{actual_body};
|
||||
|
||||
my $ret = $meth_class->wrap(
|
||||
$code,
|
||||
%other_args, @args
|
||||
);
|
||||
};
|
||||
|
||||
if (defined $name) {
|
||||
my $apply = $self->has_custom_method_application
|
||||
? $self->custom_method_application
|
||||
: sub {
|
||||
my ($meta, $name, $method) = @_;
|
||||
|
||||
if (warnings::enabled("redefine") && (my $meta_meth = $meta->get_method($name))) {
|
||||
warnings::warn("redefine", "Method $name redefined on package ${ \$meta->name }")
|
||||
if $meta_meth->isa('MooseX::Method::Signatures::Meta::Method');
|
||||
}
|
||||
|
||||
$meta->add_method($name => $method);
|
||||
};
|
||||
|
||||
$ctx->shadow(sub {
|
||||
my ($code, $name, @args) = @_;
|
||||
|
||||
my $pkg = $compile_stash;
|
||||
($pkg, $name) = $name =~ /^(.*)::([^:]+)$/
|
||||
if $name =~ /::/;
|
||||
|
||||
my $meth = $create_meta_method->($code, $pkg, $name, @args);
|
||||
my $meta = Moose::Meta::Class->initialize($pkg);
|
||||
|
||||
$meta->$apply($name, $meth);
|
||||
return;
|
||||
});
|
||||
}
|
||||
else {
|
||||
$ctx->shadow(sub {
|
||||
return $create_meta_method->(shift, $compile_stash, '__ANON__', @_);
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
sub scope_injector_call {
|
||||
my ($self, $code) = @_;
|
||||
$code =~ s/'/\\'/g; # we're generating code that's quoted with single quotes
|
||||
return qq[BEGIN { ${\ref $self}->inject_scope('${code}') }];
|
||||
}
|
||||
|
||||
sub inject_scope {
|
||||
my ($class, $inject) = @_;
|
||||
on_scope_end {
|
||||
my $line = Devel::Declare::get_linestr();
|
||||
return unless defined $line;
|
||||
my $offset = Devel::Declare::get_linestr_offset();
|
||||
substr($line, $offset, 0) = $inject;
|
||||
Devel::Declare::set_linestr($line);
|
||||
};
|
||||
}
|
||||
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Method::Signatures - (DEPRECATED) Method declarations with type constraints and no source filter
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.49
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Foo;
|
||||
|
||||
use Moose;
|
||||
use MooseX::Method::Signatures;
|
||||
|
||||
method morning (Str $name) {
|
||||
$self->say("Good morning ${name}!");
|
||||
}
|
||||
|
||||
method hello (Str :$who, Int :$age where { $_ > 0 }) {
|
||||
$self->say("Hello ${who}, I am ${age} years old!");
|
||||
}
|
||||
|
||||
method greet (Str $name, Bool :$excited = 0) {
|
||||
if ($excited) {
|
||||
$self->say("GREETINGS ${name}!");
|
||||
}
|
||||
else {
|
||||
$self->say("Hi ${name}!");
|
||||
}
|
||||
}
|
||||
|
||||
$foo->morning('Resi'); # This works.
|
||||
|
||||
$foo->hello(who => 'world', age => 42); # This too.
|
||||
|
||||
$foo->greet('Resi', excited => 1); # And this as well.
|
||||
|
||||
$foo->hello(who => 'world', age => 'fortytwo'); # This doesn't.
|
||||
|
||||
$foo->hello(who => 'world', age => -23); # This neither.
|
||||
|
||||
$foo->morning; # Won't work.
|
||||
|
||||
$foo->greet; # Will fail.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Provides a proper method keyword, like "sub" but specifically for making methods
|
||||
and validating their arguments against Moose type constraints.
|
||||
|
||||
=head1 DEPRECATION NOTICE
|
||||
|
||||
=for stopwords mst
|
||||
|
||||
=for comment rafl agreed we should have a warning, and mst wrote this for MooseX::Declare, but it applies equally well here:
|
||||
|
||||
B<Warning:> MooseX::Method::Signatures and L<MooseX::Declare> are based on
|
||||
L<Devel::Declare>, a giant bag of crack originally implemented by mst with the
|
||||
goal of upsetting the perl core developers so much by its very existence that
|
||||
they implemented proper keyword handling in the core.
|
||||
|
||||
As of perl5 version 14, this goal has been achieved, and modules such as
|
||||
L<Devel::CallParser>, L<Function::Parameters>, and L<Keyword::Simple> provide
|
||||
mechanisms to mangle perl syntax that don't require hallucinogenic drugs to
|
||||
interpret the error messages they produce.
|
||||
|
||||
If you want to use declarative syntax in new code, please for the love
|
||||
of kittens get yourself a recent perl and look at L<Moops> and
|
||||
L<core signatures|perlsub/Signatures> instead.
|
||||
|
||||
=head1 SIGNATURE SYNTAX
|
||||
|
||||
The signature syntax is heavily based on Perl 6. However not the full Perl 6
|
||||
signature syntax is supported yet and some of it never will be.
|
||||
|
||||
=head2 Type Constraints
|
||||
|
||||
method foo ( $affe) # no type checking
|
||||
method bar (Animal $affe) # $affe->isa('Animal')
|
||||
method baz (Animal|Human $affe) # $affe->isa('Animal') || $affe->isa('Human')
|
||||
|
||||
=head2 Positional vs. Named
|
||||
|
||||
method foo ( $a, $b, $c) # positional
|
||||
method bar (:$a, :$b, :$c) # named
|
||||
method baz ( $a, $b, :$c) # combined
|
||||
|
||||
=head2 Required vs. Optional
|
||||
|
||||
method foo ($a , $b!, :$c!, :$d!) # required
|
||||
method bar ($a?, $b?, :$c , :$d?) # optional
|
||||
|
||||
=head2 Defaults
|
||||
|
||||
method foo ($a = 42) # defaults to 42
|
||||
|
||||
=head2 Constraints
|
||||
|
||||
method foo ($foo where { $_ % 2 == 0 }) # only even
|
||||
|
||||
=for stopwords Invocant
|
||||
|
||||
=head2 Invocant
|
||||
|
||||
method foo ( $moo) # invocant is called $self and is required
|
||||
method bar ($self: $moo) # same, but explicit
|
||||
method baz ($class: $moo) # invocant is called $class
|
||||
|
||||
=head2 Labels
|
||||
|
||||
method foo (: $affe ) # called as $obj->foo(affe => $value)
|
||||
method bar (:apan($affe)) # called as $obj->foo(apan => $value)
|
||||
|
||||
=head2 Traits
|
||||
|
||||
method foo (Affe $bar does trait)
|
||||
method foo (Affe $bar is trait)
|
||||
|
||||
The only currently supported trait is C<coerce>, which will attempt to coerce
|
||||
the value provided if it doesn't satisfy the requirements of the type
|
||||
constraint.
|
||||
|
||||
=head2 Placeholders
|
||||
|
||||
method foo ($bar, $, $baz)
|
||||
|
||||
=for stopwords sigil
|
||||
|
||||
Sometimes you don't care about some parameters you're being called with. Just put
|
||||
the bare sigil instead of a full variable name into the signature to avoid an
|
||||
extra lexical variable to be created.
|
||||
|
||||
=head2 Complex Example
|
||||
|
||||
method foo ( SomeClass $thing where { $_->can('stuff') }:
|
||||
Str $bar = "apan",
|
||||
Int :$baz! = 42 where { $_ % 2 == 0 } where { $_ > 10 } )
|
||||
|
||||
# the invocant is called $thing, must be an instance of SomeClass and
|
||||
has to implement a 'stuff' method
|
||||
# $bar is positional, required, must be a string and defaults to "apan"
|
||||
# $baz is named, required, must be an integer, defaults to 42 and needs
|
||||
# to be even and greater than 10
|
||||
|
||||
=head1 CAVEATS AND NOTES
|
||||
|
||||
This module is as stable now, but this is not to say that it is entirely bug
|
||||
free. If you notice any odd behaviour (messages not being as good as they could
|
||||
for example) then please raise a bug.
|
||||
|
||||
=head2 Fancy signatures
|
||||
|
||||
L<Parse::Method::Signatures> is used to parse the signatures. However, some
|
||||
signatures that can be parsed by it aren't supported by this module (yet).
|
||||
|
||||
=head2 No source filter
|
||||
|
||||
While this module does rely on the hairy black magic of L<Devel::Declare> it
|
||||
does not depend on a source filter. As such, it doesn't try to parse and
|
||||
rewrite your source code and there should be no weird side effects.
|
||||
|
||||
Devel::Declare only effects compilation. After that, it's a normal subroutine.
|
||||
As such, for all that hairy magic, this module is surprisingly stable.
|
||||
|
||||
=head2 What about regular subroutines?
|
||||
|
||||
L<Devel::Declare> cannot yet change the way C<sub> behaves. However, the
|
||||
L<signatures|signatures> module can. Right now it only provides very basic
|
||||
signatures, but it's extendable enough that plugging MooseX::Method::Signatures
|
||||
signatures into that should be quite possible.
|
||||
|
||||
=head2 What about the return value?
|
||||
|
||||
Type constraints for return values can be declared using
|
||||
|
||||
method foo (Int $x, Str $y) returns (Bool) { ... }
|
||||
|
||||
however, this feature only works with scalar return values and is still
|
||||
considered to be experimental.
|
||||
|
||||
=head2 Interaction with L<Moose::Role>
|
||||
|
||||
=head3 Methods not seen by a role's C<requires>
|
||||
|
||||
Because the processing of the L<MooseX::Method::Signatures>
|
||||
C<method> and the L<Moose> C<with> keywords are both
|
||||
done at runtime, it can happen that a role will require
|
||||
a method before it is declared (which will cause
|
||||
Moose to complain very loudly and abort the program).
|
||||
|
||||
For example, the following will not work:
|
||||
|
||||
# in file Canine.pm
|
||||
|
||||
package Canine;
|
||||
|
||||
use Moose;
|
||||
use MooseX::Method::Signatures;
|
||||
|
||||
with 'Watchdog';
|
||||
|
||||
method bark { print "Woof!\n"; }
|
||||
|
||||
1;
|
||||
|
||||
|
||||
# in file Watchdog.pm
|
||||
|
||||
package Watchdog;
|
||||
|
||||
use Moose::Role;
|
||||
|
||||
requires 'bark'; # will assert! evaluated before 'method' is processed
|
||||
|
||||
sub warn_intruder {
|
||||
my $self = shift;
|
||||
my $intruder = shift;
|
||||
|
||||
$self->bark until $intruder->gone;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
A workaround for this problem is to use C<with> only
|
||||
after the methods have been defined. To take our previous
|
||||
example, B<Canine> could be reworked thus:
|
||||
|
||||
package Canine;
|
||||
|
||||
use Moose;
|
||||
use MooseX::Method::Signatures;
|
||||
|
||||
method bark { print "Woof!\n"; }
|
||||
|
||||
with 'Watchdog';
|
||||
|
||||
1;
|
||||
|
||||
A better solution is to use L<MooseX::Declare> instead of plain
|
||||
L<MooseX::Method::Signatures>. It defers application of roles until the end
|
||||
of the class definition. With it, our example would becomes:
|
||||
|
||||
# in file Canine.pm
|
||||
|
||||
use MooseX::Declare;
|
||||
|
||||
class Canine with Watchdog {
|
||||
method bark { print "Woof!\n"; }
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# in file Watchdog.pm
|
||||
|
||||
use MooseX::Declare;
|
||||
|
||||
role Watchdog {
|
||||
requires 'bark';
|
||||
|
||||
method warn_intruder ( $intruder ) {
|
||||
$self->bark until $intruder->gone;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head3 I<Subroutine redefined> warnings
|
||||
|
||||
When composing a L<Moose::Role> into a class that uses
|
||||
L<MooseX::Method::Signatures>, you may get a "Subroutine redefined"
|
||||
warning. This happens when both the role and the class define a
|
||||
method/subroutine of the same name. (The way roles work, the one
|
||||
defined in the class takes precedence.) To eliminate this warning,
|
||||
make sure that your C<with> declaration happens after any
|
||||
method/subroutine declarations that may have the same name as a
|
||||
method/subroutine within a role.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
L<MooseX::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<Method::Signatures::Simple>
|
||||
|
||||
=item *
|
||||
|
||||
L<Method::Signatures>
|
||||
|
||||
=item *
|
||||
|
||||
L<Devel::Declare>
|
||||
|
||||
=item *
|
||||
|
||||
L<Parse::Method::Signatures>
|
||||
|
||||
=item *
|
||||
|
||||
L<Moose>
|
||||
|
||||
=item *
|
||||
|
||||
L<signatures>
|
||||
|
||||
=back
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Method-Signatures>
|
||||
(or L<bug-MooseX-Method-Signatures@rt.cpan.org|mailto:bug-MooseX-Method-Signatures@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
|
||||
irc://irc.perl.org/#moose.
|
||||
|
||||
I am also usually active on irc, as 'ether' at C<irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 CONTRIBUTORS
|
||||
|
||||
=for stopwords Karen Etheridge Ash Berlin Daniel Ruoso Justin Hunter Nicholas Perez Dagfinn Ilmari Mannsåker Rhesa Rozendaal Yanick Champoux Cory Watson Kent Fredric Lukas Mai Matt Kraai Jonathan Scott Duff Jesse Luehrs Hakim Cassimally Dave Rolsky Ricardo SIGNES Sebastian Willert Steffen Schwigon
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Ash Berlin <ash@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Daniel Ruoso <daniel@ruoso.com>
|
||||
|
||||
=item *
|
||||
|
||||
Justin Hunter <justin.d.hunter@gmail.com>
|
||||
|
||||
=item *
|
||||
|
||||
Nicholas Perez <nperez@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
|
||||
|
||||
=item *
|
||||
|
||||
Rhesa Rozendaal <rhesa@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Yanick Champoux <yanick@babyl.dyndns.org>
|
||||
|
||||
=item *
|
||||
|
||||
Cory Watson <gphat@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Kent Fredric <kentfredric@gmail.com>
|
||||
|
||||
=item *
|
||||
|
||||
Lukas Mai <l.mai@web.de>
|
||||
|
||||
=item *
|
||||
|
||||
Matt Kraai <kraai@ftbfs.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jonathan Scott Duff <duff@pobox.com>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@tozt.net>
|
||||
|
||||
=item *
|
||||
|
||||
Hakim Cassimally <osfameron@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Ricardo SIGNES <rjbs@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Sebastian Willert <willert@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Steffen Schwigon <ss5@renormalist.net>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
489
database/perl/vendor/lib/MooseX/Method/Signatures/Meta/Method.pm
vendored
Normal file
489
database/perl/vendor/lib/MooseX/Method/Signatures/Meta/Method.pm
vendored
Normal file
@@ -0,0 +1,489 @@
|
||||
package MooseX::Method::Signatures::Meta::Method;
|
||||
# ABSTRACT: (DEPRECATED) Provides the metaclass for methods with signatures
|
||||
|
||||
our $VERSION = '0.49';
|
||||
|
||||
use Moose;
|
||||
use Carp qw/cluck/;
|
||||
use Context::Preserve;
|
||||
use Parse::Method::Signatures 1.003014;
|
||||
use Parse::Method::Signatures::TypeConstraint;
|
||||
use Scalar::Util qw/weaken/;
|
||||
use Moose::Util qw/does_role/;
|
||||
use Moose::Util::TypeConstraints;
|
||||
use MooseX::Meta::TypeConstraint::ForceCoercion;
|
||||
use MooseX::Types::Util qw/has_available_type_export/;
|
||||
use MooseX::Types::Structured qw/Tuple Dict Optional slurpy/;
|
||||
use MooseX::Types::Moose qw/ArrayRef Str Maybe Object Any CodeRef Bool/;
|
||||
use MooseX::Method::Signatures::Types qw/Injections Params/;
|
||||
use aliased 'Parse::Method::Signatures::Param::Named';
|
||||
use aliased 'Parse::Method::Signatures::Param::Placeholder';
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
extends 'Moose::Meta::Method';
|
||||
|
||||
has signature => (
|
||||
is => 'ro',
|
||||
isa => Str,
|
||||
default => '(@)',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has parsed_signature => (
|
||||
is => 'ro',
|
||||
isa => class_type('Parse::Method::Signatures::Sig'),
|
||||
lazy => 1,
|
||||
builder => '_build_parsed_signature',
|
||||
);
|
||||
|
||||
sub _parsed_signature {
|
||||
cluck '->_parsed_signature is deprecated. use ->parsed_signature instead.';
|
||||
shift->parsed_signature;
|
||||
}
|
||||
|
||||
has _lexicals => (
|
||||
is => 'ro',
|
||||
isa => ArrayRef[Str],
|
||||
lazy => 1,
|
||||
builder => '_build__lexicals',
|
||||
);
|
||||
|
||||
has injectable_code => (
|
||||
is => 'ro',
|
||||
isa => Str,
|
||||
lazy => 1,
|
||||
builder => '_build_injectable_code',
|
||||
);
|
||||
|
||||
has _positional_args => (
|
||||
is => 'ro',
|
||||
isa => ArrayRef,
|
||||
lazy => 1,
|
||||
builder => '_build__positional_args',
|
||||
);
|
||||
|
||||
has _named_args => (
|
||||
is => 'ro',
|
||||
isa => ArrayRef,
|
||||
lazy => 1,
|
||||
builder => '_build__named_args',
|
||||
);
|
||||
|
||||
has _has_slurpy_positional => (
|
||||
is => 'rw',
|
||||
isa => Bool,
|
||||
);
|
||||
|
||||
has type_constraint => (
|
||||
is => 'ro',
|
||||
isa => class_type('Moose::Meta::TypeConstraint'),
|
||||
lazy => 1,
|
||||
builder => '_build_type_constraint',
|
||||
);
|
||||
|
||||
has return_signature => (
|
||||
is => 'ro',
|
||||
isa => Str,
|
||||
predicate => 'has_return_signature',
|
||||
);
|
||||
|
||||
has _return_type_constraint => (
|
||||
is => 'ro',
|
||||
isa => class_type('Moose::Meta::TypeConstraint'),
|
||||
lazy => 1,
|
||||
builder => '_build__return_type_constraint',
|
||||
);
|
||||
|
||||
has actual_body => (
|
||||
is => 'ro',
|
||||
isa => CodeRef,
|
||||
predicate => '_has_actual_body',
|
||||
);
|
||||
|
||||
has prototype_injections => (
|
||||
is => 'rw',
|
||||
isa => Injections,
|
||||
trigger => \&_parse_prototype_injections
|
||||
);
|
||||
|
||||
has _parsed_prototype_injections => (
|
||||
is => 'ro',
|
||||
isa => Params,
|
||||
predicate => '_has_parsed_prototype_injections',
|
||||
writer => '_set_parsed_prototype_injections',
|
||||
);
|
||||
|
||||
before actual_body => sub {
|
||||
my ($self) = @_;
|
||||
confess "method doesn't have an actual body yet"
|
||||
unless $self->_has_actual_body;
|
||||
};
|
||||
|
||||
around name => sub {
|
||||
my ($next, $self) = @_;
|
||||
my $ret = $self->$next;
|
||||
confess "method doesn't have a name yet"
|
||||
unless defined $ret;
|
||||
return $ret;
|
||||
};
|
||||
|
||||
sub _wrapped_body {
|
||||
my ($class, $self, %args) = @_;
|
||||
|
||||
if (exists $args{return_signature}) {
|
||||
return sub {
|
||||
my @args = ${ $self }->validate(\@_);
|
||||
return preserve_context { ${ $self }->actual_body->(@args) }
|
||||
after => sub {
|
||||
if (defined (my $msg = ${ $self }->_return_type_constraint->validate(\@_))) {
|
||||
confess $msg;
|
||||
}
|
||||
};
|
||||
};
|
||||
}
|
||||
|
||||
my $actual_body;
|
||||
return sub {
|
||||
@_ = ${ $self }->validate(\@_);
|
||||
$actual_body ||= ${ $self }->actual_body;
|
||||
goto &{ $actual_body };
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
around wrap => sub {
|
||||
my $orig = shift;
|
||||
my $self;
|
||||
my ($class, $code, %args);
|
||||
if (ref $_[1]) {
|
||||
($class, $code, %args) = @_;
|
||||
} else {
|
||||
($class, %args) = @_;
|
||||
$code = delete $args{body};
|
||||
}
|
||||
|
||||
my $wrapped = $class->_wrapped_body(\$self, %args);
|
||||
$self = $class->$orig($wrapped, %args, $code ? (actual_body => $code) : ());
|
||||
|
||||
# Vivify the type constraints so TC lookups happen before namespace::clean
|
||||
# removes them
|
||||
$self->type_constraint;
|
||||
$self->_return_type_constraint if $self->has_return_signature;
|
||||
|
||||
weaken($self->{associated_metaclass})
|
||||
if $self->{associated_metaclass};
|
||||
|
||||
return $self;
|
||||
};
|
||||
|
||||
sub reify {
|
||||
my $self = shift;
|
||||
my %args = @_;
|
||||
|
||||
my %other_args = %{$self};
|
||||
delete $other_args{body};
|
||||
delete $other_args{actual_body};
|
||||
|
||||
my $body = delete $args{body} || delete $args{actual_body} || $self->body;
|
||||
my %final_args = (%other_args, %args);
|
||||
|
||||
return $self->meta->name->wrap($body, %final_args);
|
||||
}
|
||||
|
||||
sub _build_parsed_signature {
|
||||
my ($self) = @_;
|
||||
return Parse::Method::Signatures->signature(
|
||||
input => $self->signature,
|
||||
from_namespace => $self->package_name,
|
||||
);
|
||||
}
|
||||
|
||||
sub _build__return_type_constraint {
|
||||
my ($self) = @_;
|
||||
confess 'no return type constraint'
|
||||
unless $self->has_return_signature;
|
||||
|
||||
my $parser = Parse::Method::Signatures->new(
|
||||
input => $self->return_signature,
|
||||
from_namespace => $self->package_name,
|
||||
);
|
||||
|
||||
my $param = $parser->_param_typed({});
|
||||
confess 'failed to parse return value type constraint'
|
||||
unless exists $param->{type_constraints};
|
||||
|
||||
return Tuple[$param->{type_constraints}->tc];
|
||||
}
|
||||
|
||||
sub _param_to_spec {
|
||||
my ($self, $param) = @_;
|
||||
|
||||
my $tc = Any;
|
||||
{
|
||||
# Ensure errors get reported from the right place
|
||||
local $Carp::Internal{'MooseX::Method::Signatures::Meta::Method'} = 1;
|
||||
local $Carp::Internal{'Moose::Meta::Method::Delegation'} = 1;
|
||||
local $Carp::Internal{'Moose::Meta::Method::Accessor'} = 1;
|
||||
local $Carp::Internal{'MooseX::Method::Signatures'} = 1;
|
||||
local $Carp::Internal{'Devel::Declare'} = 1;
|
||||
$tc = $param->meta_type_constraint
|
||||
if $param->has_type_constraints;
|
||||
}
|
||||
|
||||
if ($param->has_constraints) {
|
||||
my $cb = join ' && ', map { "sub {${_}}->(\\\@_)" } $param->constraints;
|
||||
my $code = eval "sub {${cb}}";
|
||||
$tc = subtype({ as => $tc, where => $code });
|
||||
}
|
||||
|
||||
my %spec;
|
||||
if ($param->sigil ne '$') {
|
||||
$spec{slurpy} = 1;
|
||||
$tc = slurpy ArrayRef[$tc];
|
||||
}
|
||||
|
||||
$spec{tc} = $param->required
|
||||
? $tc
|
||||
: Optional[$tc];
|
||||
|
||||
$spec{default} = $param->default_value
|
||||
if $param->has_default_value;
|
||||
|
||||
if ($param->has_traits) {
|
||||
for my $trait (@{ $param->param_traits }) {
|
||||
next unless $trait->[1] eq 'coerce';
|
||||
$spec{coerce} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
return \%spec;
|
||||
}
|
||||
|
||||
sub _parse_prototype_injections {
|
||||
my $self = shift;
|
||||
|
||||
my @params;
|
||||
for my $inject (@{ $self->prototype_injections }) {
|
||||
my $param;
|
||||
eval {
|
||||
$param = Parse::Method::Signatures->param($inject);
|
||||
};
|
||||
|
||||
confess "There was a problem parsing the prototype injection '$inject': $@"
|
||||
if $@ || !defined $param;
|
||||
|
||||
push @params, $param;
|
||||
}
|
||||
|
||||
my @return = reverse @params;
|
||||
$self->_set_parsed_prototype_injections(\@return);
|
||||
}
|
||||
|
||||
sub _build__lexicals {
|
||||
my ($self) = @_;
|
||||
my ($sig) = $self->parsed_signature;
|
||||
|
||||
my @lexicals;
|
||||
|
||||
if ($self->_has_parsed_prototype_injections) {
|
||||
push @lexicals, $_->variable_name
|
||||
for @{ $self->_parsed_prototype_injections };
|
||||
}
|
||||
|
||||
push @lexicals, $sig->has_invocant
|
||||
? $sig->invocant->variable_name
|
||||
: '$self';
|
||||
|
||||
push @lexicals,
|
||||
(does_role($_, Placeholder)
|
||||
? 'undef'
|
||||
: $_->variable_name)
|
||||
for (($sig->has_positional_params ? $sig->positional_params : ()),
|
||||
($sig->has_named_params ? $sig->named_params : ()));
|
||||
|
||||
return \@lexicals;
|
||||
}
|
||||
|
||||
sub _build_injectable_code {
|
||||
my ($self) = @_;
|
||||
my $vars = join q{,}, @{ $self->_lexicals };
|
||||
return "my (${vars}) = \@_;";
|
||||
}
|
||||
|
||||
sub _build__positional_args {
|
||||
my ($self) = @_;
|
||||
my $sig = $self->parsed_signature;
|
||||
|
||||
my @positional;
|
||||
if ($self->_has_parsed_prototype_injections) {
|
||||
push @positional, map {
|
||||
$self->_param_to_spec($_)
|
||||
} @{ $self->_parsed_prototype_injections };
|
||||
}
|
||||
|
||||
push @positional, $sig->has_invocant
|
||||
? $self->_param_to_spec($sig->invocant)
|
||||
: { tc => Object };
|
||||
|
||||
my $slurpy = 0;
|
||||
if ($sig->has_positional_params) {
|
||||
for my $param ($sig->positional_params) {
|
||||
my $spec = $self->_param_to_spec($param);
|
||||
$slurpy ||= 1 if $spec->{slurpy};
|
||||
push @positional, $spec;
|
||||
}
|
||||
}
|
||||
|
||||
$self->_has_slurpy_positional($slurpy);
|
||||
return \@positional;
|
||||
}
|
||||
|
||||
sub _build__named_args {
|
||||
my ($self) = @_;
|
||||
my $sig = $self->parsed_signature;
|
||||
|
||||
# triggering building of positionals before named params is important
|
||||
# because the latter needs to know if there have been any slurpy
|
||||
# positionals to report errors
|
||||
$self->_positional_args;
|
||||
|
||||
my @named;
|
||||
|
||||
if ($sig->has_named_params) {
|
||||
confess 'Named parameters cannot be combined with slurpy positionals'
|
||||
if $self->_has_slurpy_positional;
|
||||
for my $param ($sig->named_params) {
|
||||
push @named, $param->label => $self->_param_to_spec($param);
|
||||
}
|
||||
}
|
||||
|
||||
return \@named;
|
||||
}
|
||||
|
||||
sub _build_type_constraint {
|
||||
my ($self) = @_;
|
||||
my ($positional, $named) = map { $self->$_ } map { "_${_}_args" } qw/positional named/;
|
||||
|
||||
my $tc = Tuple[
|
||||
Tuple[ map { $_->{tc} } @{ $positional } ],
|
||||
Dict[ map { ref $_ ? $_->{tc} : $_ } @{ $named } ],
|
||||
];
|
||||
|
||||
my $coerce_param = sub {
|
||||
my ($spec, $value) = @_;
|
||||
return $value unless exists $spec->{coerce};
|
||||
return $spec->{tc}->coerce($value);
|
||||
};
|
||||
|
||||
my %named = @{ $named };
|
||||
|
||||
coerce $tc,
|
||||
from ArrayRef,
|
||||
via {
|
||||
my (@positional_args, %named_args);
|
||||
|
||||
my $i = 0;
|
||||
for my $param (@{ $positional }) {
|
||||
push @positional_args, map { $coerce_param->($param, $_) }
|
||||
$#{ $_ } < $i
|
||||
? (exists $param->{default} ? eval $param->{default} : ())
|
||||
: $_->[$i];
|
||||
$i++;
|
||||
}
|
||||
|
||||
if (%named) {
|
||||
my @rest = @{ $_ }[$i .. $#{ $_ }];
|
||||
confess "Expected named arguments but didn't find an even-sized list"
|
||||
unless @rest % 2 == 0;
|
||||
my %rest = @rest;
|
||||
|
||||
while (my ($key, $spec) = each %named) {
|
||||
if (exists $rest{$key}) {
|
||||
$named_args{$key} = $coerce_param->($spec, delete $rest{$key});
|
||||
next;
|
||||
}
|
||||
|
||||
if (exists $spec->{default}) {
|
||||
$named_args{$key} = $coerce_param->($spec, eval $spec->{default});
|
||||
}
|
||||
}
|
||||
|
||||
@named_args{keys %rest} = values %rest;
|
||||
}
|
||||
elsif ($#{ $_ } >= $i) {
|
||||
push @positional_args, @{ $_ }[$i .. $#{ $_ }];
|
||||
}
|
||||
|
||||
return [\@positional_args, \%named_args];
|
||||
};
|
||||
|
||||
return MooseX::Meta::TypeConstraint::ForceCoercion->new(
|
||||
type_constraint => $tc,
|
||||
);
|
||||
}
|
||||
|
||||
sub validate {
|
||||
my ($self, $args) = @_;
|
||||
|
||||
my @named = grep { !ref $_ } @{ $self->_named_args };
|
||||
|
||||
my $coerced;
|
||||
if (defined (my $msg = $self->type_constraint->validate($args, \$coerced))) {
|
||||
confess $msg;
|
||||
}
|
||||
|
||||
return @{ $coerced->[0] }, map { $coerced->[1]->{$_} } @named;
|
||||
}
|
||||
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
|
||||
#pod =pod
|
||||
#pod
|
||||
#pod =for stopwords metaclass
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Method::Signatures::Meta::Method - (DEPRECATED) Provides the metaclass for methods with signatures
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.49
|
||||
|
||||
=for stopwords metaclass
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Method-Signatures>
|
||||
(or L<bug-MooseX-Method-Signatures@rt.cpan.org|mailto:bug-MooseX-Method-Signatures@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
|
||||
irc://irc.perl.org/#moose.
|
||||
|
||||
I am also usually active on irc, as 'ether' at C<irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
61
database/perl/vendor/lib/MooseX/Method/Signatures/Types.pm
vendored
Normal file
61
database/perl/vendor/lib/MooseX/Method/Signatures/Types.pm
vendored
Normal file
@@ -0,0 +1,61 @@
|
||||
package MooseX::Method::Signatures::Types;
|
||||
#ABSTRACT: (DEPRECATED) Provides common MooseX::Types used by MooseX::Method::Signatures
|
||||
|
||||
our $VERSION = '0.49';
|
||||
|
||||
use MooseX::Types 0.19 -declare => [qw/ Injections PrototypeInjections Params /];
|
||||
use MooseX::Types::Moose qw/Str ArrayRef/;
|
||||
use MooseX::Types::Structured 0.24 qw/Dict/;
|
||||
use Parse::Method::Signatures::Types qw/Param/;
|
||||
use if MooseX::Types->VERSION >= 0.42, 'namespace::autoclean';
|
||||
|
||||
subtype Injections,
|
||||
as ArrayRef[Str];
|
||||
|
||||
subtype PrototypeInjections,
|
||||
as Dict[declarator => Str, injections => Injections];
|
||||
|
||||
subtype Params,
|
||||
as ArrayRef[Param];
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Method::Signatures::Types - (DEPRECATED) Provides common MooseX::Types used by MooseX::Method::Signatures
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.49
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Method-Signatures>
|
||||
(or L<bug-MooseX-Method-Signatures@rt.cpan.org|mailto:bug-MooseX-Method-Signatures@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
|
||||
irc://irc.perl.org/#moose.
|
||||
|
||||
I am also usually active on irc, as 'ether' at C<irc.perl.org>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2008 by Florian Ragwitz.
|
||||
|
||||
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
|
||||
195
database/perl/vendor/lib/MooseX/NonMoose.pm
vendored
Normal file
195
database/perl/vendor/lib/MooseX/NonMoose.pm
vendored
Normal file
@@ -0,0 +1,195 @@
|
||||
package MooseX::NonMoose;
|
||||
BEGIN {
|
||||
$MooseX::NonMoose::AUTHORITY = 'cpan:DOY';
|
||||
}
|
||||
{
|
||||
$MooseX::NonMoose::VERSION = '0.26';
|
||||
}
|
||||
use Moose::Exporter;
|
||||
use Moose::Util;
|
||||
# ABSTRACT: easy subclassing of non-Moose classes
|
||||
|
||||
|
||||
my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods(
|
||||
class_metaroles => {
|
||||
class => ['MooseX::NonMoose::Meta::Role::Class'],
|
||||
constructor => ['MooseX::NonMoose::Meta::Role::Constructor'],
|
||||
},
|
||||
install => [qw(import unimport)],
|
||||
);
|
||||
|
||||
sub init_meta {
|
||||
my $package = shift;
|
||||
my %options = @_;
|
||||
my $meta = Moose::Util::find_meta($options{for_class});
|
||||
Carp::cluck('Roles have no use for MooseX::NonMoose')
|
||||
if $meta && $meta->isa('Moose::Meta::Role');
|
||||
$package->$init_meta(@_);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::NonMoose - easy subclassing of non-Moose classes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.26
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Term::VT102::NBased;
|
||||
use Moose;
|
||||
use MooseX::NonMoose;
|
||||
extends 'Term::VT102';
|
||||
|
||||
has [qw/x_base y_base/] => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
default => 1,
|
||||
);
|
||||
|
||||
around x => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
$self->$orig(@_) + $self->x_base - 1;
|
||||
};
|
||||
|
||||
# ... (wrap other methods)
|
||||
|
||||
no Moose;
|
||||
# no need to fiddle with inline_constructor here
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
|
||||
my $vt = Term::VT102::NBased->new(x_base => 0, y_base => 0);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<MooseX::NonMoose> allows for easily subclassing non-Moose classes with Moose,
|
||||
taking care of the annoying details connected with doing this, such as setting
|
||||
up proper inheritance from L<Moose::Object> and installing (and inlining, at
|
||||
C<make_immutable> time) a constructor that makes sure things like C<BUILD>
|
||||
methods are called. It tries to be as non-intrusive as possible - when this
|
||||
module is used, inheriting from non-Moose classes and inheriting from Moose
|
||||
classes should work identically, aside from the few caveats mentioned below.
|
||||
One of the goals of this module is that including it in a
|
||||
L<Moose::Exporter>-based package used across an entire application should be
|
||||
possible, without interfering with classes that only inherit from Moose
|
||||
modules, or even classes that don't inherit from anything at all.
|
||||
|
||||
There are several ways to use this module. The most straightforward is to just
|
||||
C<use MooseX::NonMoose;> in your class; this should set up everything necessary
|
||||
for extending non-Moose modules. L<MooseX::NonMoose::Meta::Role::Class> and
|
||||
L<MooseX::NonMoose::Meta::Role::Constructor> can also be applied to your
|
||||
metaclasses manually, either by passing a C<-traits> option to your C<use
|
||||
Moose;> line, or by applying them using L<Moose::Util::MetaRole> in a
|
||||
L<Moose::Exporter>-based package. L<MooseX::NonMoose::Meta::Role::Class> is the
|
||||
part that provides the main functionality of this module; if you don't care
|
||||
about inlining, this is all you need to worry about. Applying
|
||||
L<MooseX::NonMoose::Meta::Role::Constructor> as well will provide an inlined
|
||||
constructor when you immutabilize your class.
|
||||
|
||||
C<MooseX::NonMoose> allows you to manipulate the argument list that gets passed
|
||||
to the superclass constructor by defining a C<FOREIGNBUILDARGS> method. This is
|
||||
called with the same argument list as the C<BUILDARGS> method, but should
|
||||
return a list of arguments to pass to the superclass constructor. This allows
|
||||
C<MooseX::NonMoose> to support superclasses whose constructors would get
|
||||
confused by the extra arguments that Moose requires (for attributes, etc.)
|
||||
|
||||
Not all non-Moose classes use C<new> as the name of their constructor. This
|
||||
module allows you to extend these classes by explicitly stating which method is
|
||||
the constructor, during the call to C<extends>. The syntax looks like this:
|
||||
|
||||
extends 'Foo' => { -constructor_name => 'create' };
|
||||
|
||||
similar to how you can already pass C<-version> in the C<extends> call in a
|
||||
similar way.
|
||||
|
||||
=head1 BUGS/CAVEATS
|
||||
|
||||
=over 4
|
||||
|
||||
=item * The reference that the non-Moose class uses as its instance type
|
||||
B<must> match the instance type that Moose is using. Moose's default instance
|
||||
type is a hashref, but other modules exist to make Moose use other instance
|
||||
types. L<MooseX::InsideOut> is the most general solution - it should work with
|
||||
any class. For globref-based classes in particular, L<MooseX::GlobRef> will
|
||||
also allow Moose to work. For more information, see the C<032-moosex-insideout>
|
||||
and C<033-moosex-globref> tests bundled with this dist.
|
||||
|
||||
=item * Modifying your class' C<@ISA> after an initial C<extends> call will potentially
|
||||
cause problems if any of those new entries in the C<@ISA> override the constructor.
|
||||
C<MooseX::NonMoose> wraps the nearest C<new()> method at the time C<extends>
|
||||
is called and will not see any other C<new()> methods in the @ISA hierarchy.
|
||||
|
||||
=item * Completely overriding the constructor in a class using
|
||||
C<MooseX::NonMoose> (i.e. using C<sub new { ... }>) currently doesn't work,
|
||||
although using method modifiers on the constructor should work identically to
|
||||
normal Moose classes.
|
||||
|
||||
=back
|
||||
|
||||
Please report any bugs to GitHub Issues at
|
||||
L<https://github.com/doy/moosex-nonmoose/issues>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
=over 4
|
||||
|
||||
=item * L<Moose::Manual::FAQ/How do I make non-Moose constructors work with Moose?>
|
||||
|
||||
=item * L<MooseX::Alien>
|
||||
|
||||
serves the same purpose, but with a radically different (and far more hackish)
|
||||
implementation.
|
||||
|
||||
=back
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find this documentation for this module with the perldoc command.
|
||||
|
||||
perldoc MooseX::NonMoose
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * MetaCPAN
|
||||
|
||||
L<https://metacpan.org/release/MooseX-NonMoose>
|
||||
|
||||
=item * Github
|
||||
|
||||
L<https://github.com/doy/moosex-nonmoose>
|
||||
|
||||
=item * RT: CPAN's request tracker
|
||||
|
||||
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-NonMoose>
|
||||
|
||||
=item * CPAN Ratings
|
||||
|
||||
L<http://cpanratings.perl.org/d/MooseX-NonMoose>
|
||||
|
||||
=back
|
||||
|
||||
=for Pod::Coverage init_meta
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jesse Luehrs <doy@tozt.net>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2014 by Jesse Luehrs.
|
||||
|
||||
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
|
||||
87
database/perl/vendor/lib/MooseX/NonMoose/InsideOut.pm
vendored
Normal file
87
database/perl/vendor/lib/MooseX/NonMoose/InsideOut.pm
vendored
Normal file
@@ -0,0 +1,87 @@
|
||||
package MooseX::NonMoose::InsideOut;
|
||||
BEGIN {
|
||||
$MooseX::NonMoose::InsideOut::AUTHORITY = 'cpan:DOY';
|
||||
}
|
||||
{
|
||||
$MooseX::NonMoose::InsideOut::VERSION = '0.26';
|
||||
}
|
||||
use Moose::Exporter;
|
||||
# ABSTRACT: easy subclassing of non-Moose non-hashref classes
|
||||
|
||||
|
||||
my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods(
|
||||
class_metaroles => {
|
||||
class => ['MooseX::NonMoose::Meta::Role::Class'],
|
||||
constructor => ['MooseX::NonMoose::Meta::Role::Constructor'],
|
||||
instance => ['MooseX::InsideOut::Role::Meta::Instance'],
|
||||
},
|
||||
install => [qw(import unimport)],
|
||||
);
|
||||
|
||||
sub init_meta {
|
||||
my $package = shift;
|
||||
my %options = @_;
|
||||
my $meta = Moose::Util::find_meta($options{for_class});
|
||||
Carp::cluck('Roles have no use for MooseX::NonMoose')
|
||||
if $meta && $meta->isa('Moose::Meta::Role');
|
||||
$package->$init_meta(@_);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::NonMoose::InsideOut - easy subclassing of non-Moose non-hashref classes
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.26
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Term::VT102::NBased;
|
||||
use Moose;
|
||||
use MooseX::NonMoose::InsideOut;
|
||||
extends 'Term::VT102';
|
||||
|
||||
has [qw/x_base y_base/] => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
default => 1,
|
||||
);
|
||||
|
||||
around x => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
$self->$orig(@_) + $self->x_base - 1;
|
||||
};
|
||||
|
||||
# ... (wrap other methods)
|
||||
|
||||
no Moose;
|
||||
# no need to fiddle with inline_constructor here
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
|
||||
my $vt = Term::VT102::NBased->new(x_base => 0, y_base => 0);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=for Pod::Coverage init_meta
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jesse Luehrs <doy@tozt.net>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2014 by Jesse Luehrs.
|
||||
|
||||
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
|
||||
416
database/perl/vendor/lib/MooseX/NonMoose/Meta/Role/Class.pm
vendored
Normal file
416
database/perl/vendor/lib/MooseX/NonMoose/Meta/Role/Class.pm
vendored
Normal file
@@ -0,0 +1,416 @@
|
||||
package MooseX::NonMoose::Meta::Role::Class;
|
||||
BEGIN {
|
||||
$MooseX::NonMoose::Meta::Role::Class::AUTHORITY = 'cpan:DOY';
|
||||
}
|
||||
{
|
||||
$MooseX::NonMoose::Meta::Role::Class::VERSION = '0.26';
|
||||
}
|
||||
use Moose::Role;
|
||||
# ABSTRACT: metaclass trait for L<MooseX::NonMoose>
|
||||
|
||||
use List::MoreUtils qw(any);
|
||||
use Module::Runtime qw(use_package_optimistically);
|
||||
use Try::Tiny;
|
||||
|
||||
|
||||
has has_nonmoose_constructor => (
|
||||
is => 'rw',
|
||||
isa => 'Bool',
|
||||
default => 0,
|
||||
);
|
||||
|
||||
has has_nonmoose_destructor => (
|
||||
is => 'rw',
|
||||
isa => 'Bool',
|
||||
default => 0,
|
||||
);
|
||||
|
||||
# overrides the constructor_name attr that already exists
|
||||
has constructor_name => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
lazy => 1,
|
||||
default => sub { shift->throw_error("No constructor name has been set") },
|
||||
);
|
||||
|
||||
# XXX ugh, really need to fix this in moose
|
||||
around reinitialize => sub {
|
||||
my $orig = shift;
|
||||
my $class = shift;
|
||||
my ($pkg) = @_;
|
||||
|
||||
my $meta = blessed($pkg) ? $pkg : Moose::Util::find_meta($pkg);
|
||||
|
||||
$class->$orig(
|
||||
@_,
|
||||
(map { $_->init_arg => $_->get_value($meta) }
|
||||
grep { $_->has_value($meta) }
|
||||
map { $meta->meta->find_attribute_by_name($_) }
|
||||
qw(has_nonmoose_constructor
|
||||
has_nonmoose_destructor
|
||||
constructor_name)),
|
||||
);
|
||||
};
|
||||
|
||||
sub _determine_constructor_options {
|
||||
my $self = shift;
|
||||
my @options = @_;
|
||||
|
||||
# if we're using just the metaclass trait, but not the constructor trait,
|
||||
# then suppress the warning about not inlining a constructor
|
||||
my $cc_meta = Moose::Util::find_meta($self->constructor_class);
|
||||
return (@options, inline_constructor => 0)
|
||||
unless $cc_meta->can('does_role')
|
||||
&& $cc_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor');
|
||||
|
||||
# do nothing if we explicitly ask for the constructor to not be inlined
|
||||
my %options = @options;
|
||||
return @options if !$options{inline_constructor};
|
||||
|
||||
my $constructor_name = $self->constructor_name;
|
||||
|
||||
my $local_constructor = $self->get_method($constructor_name);
|
||||
if (!defined($local_constructor)) {
|
||||
warn "Not inlining a constructor for " . $self->name . " since "
|
||||
. "its parent " . ($self->superclasses)[0] . " doesn't contain a "
|
||||
. "constructor named '$constructor_name'. "
|
||||
. "If you are certain you don't need to inline your"
|
||||
. " constructor, specify inline_constructor => 0 in your"
|
||||
. " call to " . $self->name . "->meta->make_immutable\n";
|
||||
return @options;
|
||||
}
|
||||
|
||||
# do nothing if extends was called, but we then added a method modifier to
|
||||
# the constructor (this will warn, but that's okay)
|
||||
# XXX: this is a fairly big hack, but it should cover most of the cases
|
||||
# that actually show up in practice... it would be nice to do this properly
|
||||
# though
|
||||
return @options
|
||||
if $local_constructor->isa('Class::MOP::Method::Wrapped');
|
||||
|
||||
# otherwise, explicitly ask for the constructor to be replaced (to suppress
|
||||
# the warning message), since this is the expected usage, and shouldn't
|
||||
# cause a warning
|
||||
return (replace_constructor => 1, @options);
|
||||
}
|
||||
|
||||
sub _determine_destructor_options {
|
||||
my $self = shift;
|
||||
my @options = @_;
|
||||
|
||||
return (@options, inline_destructor => 0);
|
||||
}
|
||||
|
||||
around _immutable_options => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
|
||||
my @options = $self->$orig(@_);
|
||||
|
||||
# do nothing if extends was never called
|
||||
return @options if !$self->has_nonmoose_constructor
|
||||
&& !$self->has_nonmoose_destructor;
|
||||
|
||||
@options = $self->_determine_constructor_options(@options);
|
||||
@options = $self->_determine_destructor_options(@options);
|
||||
|
||||
return @options;
|
||||
};
|
||||
|
||||
sub _check_superclass_constructor {
|
||||
my $self = shift;
|
||||
|
||||
# if the current class defined a custom new method (since subs happen at
|
||||
# BEGIN time), don't try to override it
|
||||
return if $self->has_method($self->constructor_name);
|
||||
|
||||
# we need to get the non-moose constructor from the superclass
|
||||
# of the class where this method actually exists, regardless of what class
|
||||
# we're calling it on
|
||||
my $super_new = $self->find_next_method_by_name($self->constructor_name);
|
||||
|
||||
# if we're trying to extend a (non-immutable) moose class, just do nothing
|
||||
return if $super_new->package_name eq 'Moose::Object';
|
||||
|
||||
if ($super_new->associated_metaclass->can('constructor_class')) {
|
||||
my $constructor_class_meta = Class::MOP::Class->initialize(
|
||||
$super_new->associated_metaclass->constructor_class
|
||||
);
|
||||
|
||||
# if the constructor we're inheriting is already one of ours, there's
|
||||
# no reason to install a new one
|
||||
return if $constructor_class_meta->can('does_role')
|
||||
&& $constructor_class_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor');
|
||||
|
||||
# if the constructor we're inheriting is an inlined version of the
|
||||
# default moose constructor, don't do anything either
|
||||
return if any { $_->isa($constructor_class_meta->name) }
|
||||
$super_new->associated_metaclass->_inlined_methods;
|
||||
}
|
||||
|
||||
$self->add_method($self->constructor_name => sub {
|
||||
my $class = shift;
|
||||
|
||||
my $params = $class->BUILDARGS(@_);
|
||||
my @foreign_params = $class->can('FOREIGNBUILDARGS')
|
||||
? $class->FOREIGNBUILDARGS(@_)
|
||||
: @_;
|
||||
my $instance = $super_new->execute($class, @foreign_params);
|
||||
if (!blessed($instance)) {
|
||||
confess "The constructor for "
|
||||
. $super_new->associated_metaclass->name
|
||||
. " did not return a blessed instance";
|
||||
}
|
||||
elsif (!$instance->isa($class)) {
|
||||
if (!$class->isa(blessed($instance))) {
|
||||
confess "The constructor for "
|
||||
. $super_new->associated_metaclass->name
|
||||
. " returned an object whose class is not a parent of "
|
||||
. $class;
|
||||
}
|
||||
else {
|
||||
bless $instance, $class;
|
||||
}
|
||||
}
|
||||
return Class::MOP::Class->initialize($class)->new_object(
|
||||
__INSTANCE__ => $instance,
|
||||
%$params,
|
||||
);
|
||||
});
|
||||
$self->has_nonmoose_constructor(1);
|
||||
}
|
||||
|
||||
sub _check_superclass_destructor {
|
||||
my $self = shift;
|
||||
|
||||
# if the current class defined a custom DESTROY method (since subs happen
|
||||
# at BEGIN time), don't try to override it
|
||||
return if $self->has_method('DESTROY');
|
||||
|
||||
# we need to get the non-moose destructor from the superclass
|
||||
# of the class where this method actually exists, regardless of what class
|
||||
# we're calling it on
|
||||
my $super_DESTROY = $self->find_next_method_by_name('DESTROY');
|
||||
|
||||
# if we're trying to extend a (non-immutable) moose class, just do nothing
|
||||
return if $super_DESTROY->package_name eq 'Moose::Object';
|
||||
|
||||
if ($super_DESTROY->associated_metaclass->can('destructor_class')
|
||||
&& $super_DESTROY->associated_metaclass->destructor_class) {
|
||||
my $destructor_class_meta = Class::MOP::Class->initialize(
|
||||
$super_DESTROY->associated_metaclass->destructor_class
|
||||
);
|
||||
|
||||
# if the destructor we're inheriting is an inlined version of the
|
||||
# default moose destructor, don't do anything
|
||||
return if any { $_->isa($destructor_class_meta->name) }
|
||||
$super_DESTROY->associated_metaclass->_inlined_methods;
|
||||
}
|
||||
|
||||
$self->add_method(DESTROY => sub {
|
||||
my $self = shift;
|
||||
|
||||
local $?;
|
||||
|
||||
Try::Tiny::try {
|
||||
$super_DESTROY->execute($self);
|
||||
$self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction);
|
||||
}
|
||||
Try::Tiny::catch {
|
||||
# Without this, Perl will warn "\t(in cleanup)$@" because of some
|
||||
# bizarre fucked-up logic deep in the internals.
|
||||
no warnings 'misc';
|
||||
die $_;
|
||||
};
|
||||
|
||||
return;
|
||||
});
|
||||
$self->has_nonmoose_destructor(1);
|
||||
}
|
||||
|
||||
around superclasses => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
|
||||
return $self->$orig unless @_;
|
||||
|
||||
# XXX lots of duplication between here and MMC::superclasses
|
||||
my ($constructor_name, $constructor_class);
|
||||
for my $super (@{ Data::OptList::mkopt(\@_) }) {
|
||||
my ($name, $opts) = @{ $super };
|
||||
|
||||
my $cur_constructor_name = delete $opts->{'-constructor_name'};
|
||||
|
||||
if (defined($constructor_name) && defined($cur_constructor_name)) {
|
||||
$self->throw_error(
|
||||
"You have already specified "
|
||||
. "${constructor_class}::${constructor_name} as the parent "
|
||||
. "constructor; ${name}::${cur_constructor_name} cannot also be "
|
||||
. "the constructor"
|
||||
);
|
||||
}
|
||||
|
||||
if ($opts && exists($opts->{-version})) {
|
||||
use_package_optimistically($name, $opts->{-version});
|
||||
}
|
||||
else {
|
||||
use_package_optimistically($name);
|
||||
}
|
||||
|
||||
if (defined($cur_constructor_name)) {
|
||||
my $meta = Moose::Util::find_meta($name);
|
||||
$self->throw_error(
|
||||
"You specified '$cur_constructor_name' as the constructor for "
|
||||
. "$name, but $name has no method by that name"
|
||||
) unless $meta
|
||||
? $meta->find_method_by_name($cur_constructor_name)
|
||||
: $name->can($cur_constructor_name);
|
||||
}
|
||||
|
||||
if (!defined($constructor_name)) {
|
||||
$constructor_name = $cur_constructor_name;
|
||||
$constructor_class = $name;
|
||||
}
|
||||
|
||||
delete $opts->{'-constructor_name'};
|
||||
}
|
||||
|
||||
$self->constructor_name(
|
||||
defined($constructor_name) ? $constructor_name : 'new'
|
||||
);
|
||||
|
||||
my @superclasses = @_;
|
||||
push @superclasses, 'Moose::Object'
|
||||
unless grep { !ref($_) && $_->isa('Moose::Object') } @superclasses;
|
||||
|
||||
my @ret = $self->$orig(@superclasses);
|
||||
|
||||
$self->_check_superclass_constructor;
|
||||
$self->_check_superclass_destructor;
|
||||
|
||||
return @ret;
|
||||
};
|
||||
|
||||
sub _generate_fallback_constructor {
|
||||
my $self = shift;
|
||||
my ($class_var) = @_;
|
||||
|
||||
my $new = $self->constructor_name;
|
||||
my $super_new_class = $self->_find_next_nonmoose_constructor_package;
|
||||
my $arglist = $self->find_method_by_name('FOREIGNBUILDARGS')
|
||||
? "${class_var}->FOREIGNBUILDARGS(\@_)"
|
||||
: '@_';
|
||||
my $instance = "${class_var}->${super_new_class}::$new($arglist)";
|
||||
# XXX: the "my $__DUMMY = " part is because "return do" triggers a weird
|
||||
# bug in pre-5.12 perls (it ends up returning undef)
|
||||
return '(my $__DUMMY = do { '
|
||||
. 'if (ref($_[0]) eq \'HASH\') { '
|
||||
. '$_[0]->{__INSTANCE__} = ' . $instance . ' '
|
||||
. 'unless exists $_[0]->{__INSTANCE__}; '
|
||||
. '} '
|
||||
. 'else { '
|
||||
. 'unshift @_, __INSTANCE__ => ' . $instance . '; '
|
||||
. '} '
|
||||
. $class_var . '->Moose::Object::new(@_); '
|
||||
. '})';
|
||||
}
|
||||
|
||||
sub _inline_generate_instance {
|
||||
my $self = shift;
|
||||
my ($var, $class_var) = @_;
|
||||
|
||||
my $new = $self->constructor_name;
|
||||
my $super_new_class = $self->_find_next_nonmoose_constructor_package;
|
||||
my $arglist = $self->find_method_by_name('FOREIGNBUILDARGS')
|
||||
? "${class_var}->FOREIGNBUILDARGS(\@_)"
|
||||
: '@_';
|
||||
my $instance = "${class_var}->${super_new_class}::$new($arglist)";
|
||||
return (
|
||||
'my ' . $var . ' = ' . $instance . ';',
|
||||
'if (!Scalar::Util::blessed(' . $var . ')) {',
|
||||
$self->_inline_throw_error(
|
||||
'"The constructor for ' . $super_new_class . ' did not return a blessed instance"',
|
||||
) . ';',
|
||||
'}',
|
||||
'elsif (!' . $var . '->isa(' . $class_var . ')) {',
|
||||
'if (!' . $class_var . '->isa(Scalar::Util::blessed(' . $var . '))) {',
|
||||
$self->_inline_throw_error(
|
||||
'"The constructor for ' . $super_new_class . ' returned an object whose class is not a parent of ' . $class_var . '"',
|
||||
) . ';',
|
||||
'}',
|
||||
'else {',
|
||||
$self->_inline_rebless_instance($var, $class_var) . ';',
|
||||
'}',
|
||||
'}',
|
||||
);
|
||||
}
|
||||
|
||||
sub _find_next_nonmoose_constructor_package {
|
||||
my $self = shift;
|
||||
my $new = $self->constructor_name;
|
||||
for my $method (map { $_->{code} } $self->find_all_methods_by_name($new)) {
|
||||
next if $method->associated_metaclass->meta->can('does_role')
|
||||
&& $method->associated_metaclass->meta->does_role('MooseX::NonMoose::Meta::Role::Class');
|
||||
return $method->package_name;
|
||||
}
|
||||
# this should never happen (it should find Moose::Object at least)
|
||||
$self->throw_error("Couldn't find a non-Moose constructor for " . $self->name);
|
||||
}
|
||||
|
||||
no Moose::Role;
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::NonMoose::Meta::Role::Class - metaclass trait for L<MooseX::NonMoose>
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.26
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Foo;
|
||||
use Moose -traits => 'MooseX::NonMoose::Meta::Role::Class';
|
||||
|
||||
# or
|
||||
|
||||
package My::Moose;
|
||||
use Moose ();
|
||||
use Moose::Exporter;
|
||||
|
||||
Moose::Exporter->setup_import_methods;
|
||||
sub init_meta {
|
||||
shift;
|
||||
my %options = @_;
|
||||
Moose->init_meta(%options);
|
||||
Moose::Util::MetaRole::apply_metaclass_roles(
|
||||
for_class => $options{for_class},
|
||||
metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'],
|
||||
);
|
||||
return Moose::Util::find_meta($options{for_class});
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This trait implements everything involved with extending non-Moose classes,
|
||||
other than doing the actual inlining at C<make_immutable> time. See
|
||||
L<MooseX::NonMoose> for more details.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jesse Luehrs <doy@tozt.net>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2014 by Jesse Luehrs.
|
||||
|
||||
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
|
||||
81
database/perl/vendor/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
vendored
Normal file
81
database/perl/vendor/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
vendored
Normal file
@@ -0,0 +1,81 @@
|
||||
package MooseX::NonMoose::Meta::Role::Constructor;
|
||||
BEGIN {
|
||||
$MooseX::NonMoose::Meta::Role::Constructor::AUTHORITY = 'cpan:DOY';
|
||||
}
|
||||
{
|
||||
$MooseX::NonMoose::Meta::Role::Constructor::VERSION = '0.26';
|
||||
}
|
||||
use Moose::Role 2.0000;
|
||||
# ABSTRACT: constructor method trait for L<MooseX::NonMoose>
|
||||
|
||||
|
||||
around can_be_inlined => sub {
|
||||
my $orig = shift;
|
||||
my $self = shift;
|
||||
|
||||
my $meta = $self->associated_metaclass;
|
||||
my $super_new = $meta->find_method_by_name($self->name);
|
||||
my $super_meta = $super_new->associated_metaclass;
|
||||
if (Moose::Util::find_meta($super_meta)->can('does_role')
|
||||
&& Moose::Util::find_meta($super_meta)->does_role('MooseX::NonMoose::Meta::Role::Class')) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
return $self->$orig(@_);
|
||||
};
|
||||
|
||||
no Moose::Role;
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::NonMoose::Meta::Role::Constructor - constructor method trait for L<MooseX::NonMoose>
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.26
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package My::Moose;
|
||||
use Moose ();
|
||||
use Moose::Exporter;
|
||||
|
||||
Moose::Exporter->setup_import_methods;
|
||||
sub init_meta {
|
||||
shift;
|
||||
my %options = @_;
|
||||
Moose->init_meta(%options);
|
||||
Moose::Util::MetaRole::apply_metaclass_roles(
|
||||
for_class => $options{for_class},
|
||||
metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'],
|
||||
constructor_class_roles =>
|
||||
['MooseX::NonMoose::Meta::Role::Constructor'],
|
||||
);
|
||||
return Moose::Util::find_meta($options{for_class});
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This trait implements inlining of the constructor for classes using the
|
||||
L<MooseX::NonMoose::Meta::Role::Class> metaclass trait; it has no effect unless
|
||||
that trait is also used. See those docs and the docs for L<MooseX::NonMoose>
|
||||
for more information.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jesse Luehrs <doy@tozt.net>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2014 by Jesse Luehrs.
|
||||
|
||||
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
|
||||
50
database/perl/vendor/lib/MooseX/Role/Parameterised.pm
vendored
Normal file
50
database/perl/vendor/lib/MooseX/Role/Parameterised.pm
vendored
Normal file
@@ -0,0 +1,50 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
package MooseX::Role::Parameterised;
|
||||
# vim: set ts=8 sts=4 sw=4 tw=115 et :
|
||||
# ABSTRACT: Moose roles with composition parameters
|
||||
|
||||
our $VERSION = '1.11';
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterised - Moose roles with composition parameters
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
See L<MooseX::Role::Parameterized>; this module is just a stub to help the
|
||||
civilised Perl users find this distribution with search engines. :)
|
||||
|
||||
=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
|
||||
298
database/perl/vendor/lib/MooseX/Role/Parameterized.pm
vendored
Normal file
298
database/perl/vendor/lib/MooseX/Role/Parameterized.pm
vendored
Normal file
@@ -0,0 +1,298 @@
|
||||
package MooseX::Role::Parameterized; # git description: v1.10-8-g9de4ac3
|
||||
# ABSTRACT: Moose roles with composition parameters
|
||||
# KEYWORDS: moose extension parameter role arguments dynamic parameterised parameterizable parameterisable
|
||||
|
||||
our $VERSION = '1.11';
|
||||
|
||||
use 5.008001;
|
||||
use Moose 2.0300 ();
|
||||
use Moose::Exporter;
|
||||
use Carp 'confess';
|
||||
use Moose::Util 'find_meta';
|
||||
use namespace::clean 0.19;
|
||||
|
||||
use MooseX::Role::Parameterized::Meta::Trait::Parameterizable;
|
||||
|
||||
our $CURRENT_METACLASS;
|
||||
|
||||
sub current_metaclass { $CURRENT_METACLASS }
|
||||
|
||||
my $meta_lookup = sub {
|
||||
my $for = shift;
|
||||
current_metaclass() || find_meta($for);
|
||||
};
|
||||
|
||||
Moose::Exporter->setup_import_methods(
|
||||
also => 'Moose::Role',
|
||||
with_caller => [ 'parameter', 'role' ],
|
||||
with_meta => [ 'method', 'with' ],
|
||||
meta_lookup => $meta_lookup,
|
||||
role_metaroles => {
|
||||
role => ['MooseX::Role::Parameterized::Meta::Trait::Parameterizable'],
|
||||
},
|
||||
);
|
||||
|
||||
sub parameter {
|
||||
my $caller = shift;
|
||||
|
||||
confess "'parameter' may not be used inside of the role block"
|
||||
if current_metaclass && current_metaclass->genitor->name eq $caller;
|
||||
|
||||
my $meta = find_meta($caller);
|
||||
|
||||
my $names = shift;
|
||||
$names = [$names] if !ref($names);
|
||||
|
||||
for my $name (@$names) {
|
||||
$meta->add_parameter($name => (
|
||||
is => 'ro',
|
||||
@_,
|
||||
));
|
||||
}
|
||||
}
|
||||
|
||||
sub role (&) {
|
||||
my $caller = shift;
|
||||
my $role_generator = shift;
|
||||
|
||||
confess "'role' may not be used inside of the role block"
|
||||
if current_metaclass && current_metaclass->genitor->name eq $caller;
|
||||
|
||||
find_meta($caller)->role_generator($role_generator);
|
||||
}
|
||||
|
||||
sub method {
|
||||
my $meta = shift;
|
||||
my $name = shift;
|
||||
my $body = shift;
|
||||
|
||||
my $method = $meta->method_metaclass->wrap(
|
||||
package_name => $meta->name,
|
||||
name => $name,
|
||||
body => $body,
|
||||
);
|
||||
|
||||
$meta->add_method($name => $method);
|
||||
}
|
||||
|
||||
sub with {
|
||||
local $CURRENT_METACLASS = undef;
|
||||
Moose::Role::with(@_);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterized - Moose roles with composition parameters
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Counter;
|
||||
use MooseX::Role::Parameterized;
|
||||
|
||||
parameter name => (
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
role {
|
||||
my $p = shift;
|
||||
|
||||
my $name = $p->name;
|
||||
|
||||
has $name => (
|
||||
is => 'rw',
|
||||
isa => 'Int',
|
||||
default => 0,
|
||||
);
|
||||
|
||||
method "increment_$name" => sub {
|
||||
my $self = shift;
|
||||
$self->$name($self->$name + 1);
|
||||
};
|
||||
|
||||
method "reset_$name" => sub {
|
||||
my $self = shift;
|
||||
$self->$name(0);
|
||||
};
|
||||
};
|
||||
|
||||
package MyGame::Weapon;
|
||||
use Moose;
|
||||
|
||||
with Counter => { name => 'enchantment' };
|
||||
|
||||
package MyGame::Wand;
|
||||
use Moose;
|
||||
|
||||
with Counter => { name => 'zapped' };
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Your parameterized role consists of two new things: parameter declarations
|
||||
and a C<role> block.
|
||||
|
||||
Parameters are declared using the L</parameter> keyword which very much
|
||||
resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. The
|
||||
default value for the C<is> option is C<ro> as that's a very common case. Use
|
||||
C<< is => 'bare' >> if you want no accessor. These parameters will get their
|
||||
values when the consuming class (or role) uses L<Moose/with>. A parameter
|
||||
object will be constructed with these values, and passed to the C<role> block.
|
||||
|
||||
The C<role> block then uses the usual L<Moose::Role> keywords to build up a
|
||||
role. You can shift off the parameter object to inspect what the consuming
|
||||
class provided as parameters. You use the parameters to customize your
|
||||
role however you wish.
|
||||
|
||||
There are many possible implementations for parameterized roles (hopefully with
|
||||
a consistent enough API); I believe this to be the easiest and most flexible
|
||||
design. Coincidentally, Pugs originally had an eerily similar design.
|
||||
|
||||
See L<MooseX::Role::Parameterized::Extending> for some tips on how to extend
|
||||
this module.
|
||||
|
||||
=head2 Why a parameters object?
|
||||
|
||||
I've been asked several times "Why use a parameter I<object> and not just a
|
||||
parameter I<hashref>? That would eliminate the need to explicitly declare your
|
||||
parameters."
|
||||
|
||||
The benefits of using an object are similar to the benefits of using Moose. You
|
||||
get an easy way to specify lazy defaults, type constraint, delegation, and so
|
||||
on. You get to use MooseX modules.
|
||||
|
||||
=for Pod::Coverage current_metaclass method parameter role with
|
||||
|
||||
=head1 L<MooseX::Role::Parameterized::Tutorial>
|
||||
|
||||
B<Stop!> If you're new here, please read
|
||||
L<MooseX::Role::Parameterized::Tutorial> for a much gentler introduction.
|
||||
|
||||
=for stopwords metaobject
|
||||
|
||||
You also get the usual introspective and intercessory abilities that come
|
||||
standard with the metaobject protocol. Ambitious users should be able to add
|
||||
traits to the parameters metaclass to further customize behavior. Please let
|
||||
me know if you're doing anything viciously complicated with this extension. :)
|
||||
|
||||
=head1 CAVEATS
|
||||
|
||||
You must use this syntax to declare methods in the role block:
|
||||
C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In
|
||||
return though you can use parameters I<in your methods>!
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<http://sartak.org/2009/01/parametric-roles-in-perl-5.html>
|
||||
|
||||
L<http://sartak.org/2009/05/the-design-of-parameterized-roles.html>
|
||||
|
||||
L<http://stevan-little.blogspot.com/2009/07/thoughts-on-parameterized-roles.html>
|
||||
|
||||
L<http://perldition.org/articles/Parameterized%20Roles%20with%20MooseX::Declare.pod>
|
||||
|
||||
L<http://www.modernperlbooks.com/mt/2011/01/the-parametric-role-of-my-mvc-plugin-system.html>
|
||||
|
||||
L<http://jjnapiorkowski.typepad.com/modern-perl/2010/08/parameterized-roles-and-method-traits-redo.html>
|
||||
|
||||
L<http://sartak.org/talks/yapc-asia-2009/(parameterized)-roles/>
|
||||
|
||||
=for stopwords Joose
|
||||
|
||||
L<https://github.com/SamuraiJack/JooseX-Role-Parameterized> - this extension ported to JavaScript's Joose
|
||||
|
||||
=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 CONTRIBUTORS
|
||||
|
||||
=for stopwords Karen Etheridge Dave Rolsky Jesse Luehrs Oliver Charles Yuval Kogman Robert 'phaylon' Sedlacek Florian Ragwitz Mark Fowler Chris Weyl Csson Andy Jack Ricardo Signes Todd Hepler
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@tozt.net>
|
||||
|
||||
=item *
|
||||
|
||||
Oliver Charles <oliver.g.charles@googlemail.com>
|
||||
|
||||
=item *
|
||||
|
||||
Yuval Kogman <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Robert 'phaylon' Sedlacek <rs@474.at>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Mark Fowler <mark@twoshortplanks.com>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Weyl <cweyl@alumni.drew.edu>
|
||||
|
||||
=item *
|
||||
|
||||
Csson <erik.carlsson@live.com>
|
||||
|
||||
=item *
|
||||
|
||||
Andy Jack <github@veracity.ca>
|
||||
|
||||
=item *
|
||||
|
||||
Ricardo Signes <rjbs@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Todd Hepler <thepler@employees.org>
|
||||
|
||||
=back
|
||||
|
||||
=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
|
||||
87
database/perl/vendor/lib/MooseX/Role/Parameterized/Extending.pod
vendored
Normal file
87
database/perl/vendor/lib/MooseX/Role/Parameterized/Extending.pod
vendored
Normal file
@@ -0,0 +1,87 @@
|
||||
# PODNAME: MooseX::Role::Parameterized::Extending
|
||||
# ABSTRACT: extending MooseX::Role::Parameterized roles
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterized::Extending - extending MooseX::Role::Parameterized roles
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
There are heaps of useful modules in the C<MooseX> namespace that you can use
|
||||
to make your roles more powerful. However, they do not always work out of the
|
||||
box with L<MooseX::Role::Parameterized>, but it's fairly straight-forward to
|
||||
achieve the functionality you desire.
|
||||
|
||||
L<MooseX::Role::Parameterized> was designed to be as extensible as the rest of
|
||||
L<Moose>, and as such it is possible to apply custom traits to both the
|
||||
parameterizable role or the ordinary roles they generate. In this example, we
|
||||
will look at applying the fake trait C<MooseX::MagicRole> to a parameterizable
|
||||
role.
|
||||
|
||||
First we need to define a new metaclass for our parameterizable role.
|
||||
|
||||
package MyApp::Meta::Role::Parameterizable;
|
||||
use Moose;
|
||||
extends 'MooseX::Role::Parameterized::Meta::Role::Parameterizable';
|
||||
with 'MooseX::MagicRole';
|
||||
|
||||
This is a class (observe that it uses L<Moose>, not L<Moose::Role>) which
|
||||
extends the class which governs parameterizable roles.
|
||||
L<MooseX::Role::Parameterized::Meta::Role::Parameterizable> is the metaclass
|
||||
that packages using L<MooseX::Role::Parameterized> receive by default.
|
||||
|
||||
Note that the class we are extending,
|
||||
L<MooseX::Role::Parameterized::Meta::Role::ParameterizB<I<able>>|MooseX::Role::Parameterized::Meta::Role::Parameterizable>,
|
||||
is entirely distinct from the similarly-named class which governs the
|
||||
ordinary roles that parameterized roles generate. An instance of
|
||||
L<MooseX::Role::Parameterized::Meta::Role::ParameterizB<I<ed>>|MooseX::Role::Parameterized>
|
||||
represents a role with its parameters already bound.
|
||||
|
||||
Now we can take advantage of our new subclass by specifying that we want to use
|
||||
C<MyApp::Meta::Role::Parameterizable> as our metaclass when importing
|
||||
L<MooseX::Role::Parameterized>:
|
||||
|
||||
package MyApp::Role;
|
||||
use MooseX::Role::Parameterized -metaclass => 'MyApp::Meta::Role::Parameterizable';
|
||||
|
||||
role {
|
||||
...
|
||||
}
|
||||
|
||||
And there you go! C<MyApp::Role> now has the C<MooseX::MagicRole> trait applied.
|
||||
|
||||
=head1 NAME
|
||||
|
||||
=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
|
||||
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
|
||||
60
database/perl/vendor/lib/MooseX/Role/Parameterized/Parameters.pm
vendored
Normal file
60
database/perl/vendor/lib/MooseX/Role/Parameterized/Parameters.pm
vendored
Normal file
@@ -0,0 +1,60 @@
|
||||
package MooseX::Role::Parameterized::Parameters;
|
||||
# ABSTRACT: base class for parameters
|
||||
|
||||
our $VERSION = '1.11';
|
||||
|
||||
use Moose;
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
no Moose;
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterized::Parameters - base class for parameters
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is the base class for parameter objects. Currently empty, but I reserve
|
||||
the right to add things here.
|
||||
|
||||
Each parameterizable role gets their own anonymous subclass of this;
|
||||
L<MooseX::Role::Parameterized/parameter> actually operates on these anonymous
|
||||
subclasses.
|
||||
|
||||
Each parameterized role gets their own instance of the anonymous subclass
|
||||
(owned by the parameterizable 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
|
||||
248
database/perl/vendor/lib/MooseX/Role/Parameterized/Tutorial.pod
vendored
Normal file
248
database/perl/vendor/lib/MooseX/Role/Parameterized/Tutorial.pod
vendored
Normal file
@@ -0,0 +1,248 @@
|
||||
# PODNAME: MooseX::Role::Parameterized::Tutorial
|
||||
# ABSTRACT: why and how
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Role::Parameterized::Tutorial - why and how
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.11
|
||||
|
||||
=head1 MOTIVATION
|
||||
|
||||
Roles are composable units of behavior. They are useful for factoring out
|
||||
functionality common to many classes from any part of your class hierarchy. See
|
||||
L<Moose::Cookbook::Roles::Comparable_CodeReuse> for an introduction to L<Moose::Role>.
|
||||
|
||||
While combining roles affords you a great deal of flexibility, individual roles
|
||||
have very little in the way of configurability. Core Moose provides C<-alias>
|
||||
for renaming methods and C<-excludes> for ignoring methods. These options are
|
||||
primarily for resolving role conflicts. Depending on how much of a purist you are,
|
||||
these options are I<solely> for resolving role conflicts. See
|
||||
L<Moose::Cookbook::Roles::Restartable_AdvancedComposition> for more about C<-alias> and C<-excludes>.
|
||||
|
||||
Because roles serve many different masters, they usually provide only the least
|
||||
common denominator of functionality. To empower roles further, more
|
||||
configurability than C<-alias> and C<-excludes> is required. Perhaps your role
|
||||
needs to know which method to call when it is done processing. Or what default
|
||||
value to use for its C<url> attribute.
|
||||
|
||||
Parameterized roles offer a solution to these (and other) kinds of problems.
|
||||
|
||||
=head1 USAGE
|
||||
|
||||
=head2 C<with>
|
||||
|
||||
The syntax of a class consuming a parameterized role has not changed
|
||||
from the standard C<with>. You pass in parameters just like you
|
||||
pass in C<-alias> and C<-excludes> to ordinary roles (though your
|
||||
custom parameters do not get hyphens, since these are not core Moose
|
||||
composition parameters):
|
||||
|
||||
with 'MyRole::InstrumentMethod' => {
|
||||
method_name => 'dbh_do',
|
||||
log_to => 'query.log',
|
||||
};
|
||||
|
||||
You can still combine parameterized roles. You just need to specify parameters
|
||||
immediately after the role they belong to:
|
||||
|
||||
with (
|
||||
'My::Parameterized::Role' => {
|
||||
needs_better_example => 1,
|
||||
},
|
||||
'My::Other::Role',
|
||||
);
|
||||
|
||||
We, like Moose itself, use L<Data::OptList> to make sure that a list of role
|
||||
names and associated parameters is handled correctly.
|
||||
|
||||
=head2 C<parameter>
|
||||
|
||||
Inside your parameterized role, you specify a set of parameters. This is
|
||||
exactly like specifying the attributes of a class. Instead of L<Moose/has> you
|
||||
use the keyword C<parameter>, but your parameters can use any options to
|
||||
C<has>.
|
||||
|
||||
parameter 'delegation' => (
|
||||
isa => 'HashRef|ArrayRef|RegexpRef',
|
||||
predicate => 'has_delegation',
|
||||
);
|
||||
|
||||
You do have to declare what parameters you accept, just like you have to
|
||||
declare what attributes you accept for regular Moose objects.
|
||||
|
||||
One departure from C<has> is that we create a reader accessor for you by
|
||||
default. In other words, we assume C<< is => 'ro' >>. We create this reader for
|
||||
convenience because generally the parameterized role is the only consumer of
|
||||
the parameters object, so data hiding is not as important than in the general
|
||||
case of L<Moose/has>. If you do not want an accessor, you can use
|
||||
C<< is => 'bare' >>.
|
||||
|
||||
=head2 C<role>
|
||||
|
||||
C<role> takes a block of code that will be used to generate your role with its
|
||||
parameters bound. Here is where you declare components that depend on
|
||||
parameters. You can declare attributes, methods, modifiers, etc. The first
|
||||
argument to the C<role> is an object containing the parameters specified by
|
||||
C<with>. You can access the parameters just like regular attributes on that
|
||||
object.
|
||||
|
||||
Each time you compose this parameterized role, the C<role {}> block will be
|
||||
executed. It will receive a new parameter object and produce an entirely new
|
||||
role. That's the whole point, after all.
|
||||
|
||||
Due to limitations inherent in Perl, you must declare methods with
|
||||
C<< method name => sub { ... } >> instead of the usual C<sub name { ... }>.
|
||||
Your methods may, of course, close over the parameter object. This means that
|
||||
your methods may use parameters however they wish!
|
||||
|
||||
=head1 USES
|
||||
|
||||
Ideally these will become fully-explained examples in something resembling
|
||||
L<Moose::Cookbook>. But for now, only a brain dump.
|
||||
|
||||
=over 4
|
||||
|
||||
=item Configure a role's attributes
|
||||
|
||||
You can rename methods with core Moose, but now you can rename attributes. You
|
||||
can now also choose type, default value, whether it's required, B<traits>, etc.
|
||||
|
||||
parameter traits => (
|
||||
isa => 'ArrayRef',
|
||||
default => sub { [] },
|
||||
);
|
||||
|
||||
parameter type => (
|
||||
isa => 'Str',
|
||||
default => 'Any',
|
||||
);
|
||||
|
||||
role {
|
||||
my $p = shift;
|
||||
|
||||
has action => (
|
||||
traits => $p->traits,
|
||||
isa => $p->type,
|
||||
...
|
||||
);
|
||||
};
|
||||
|
||||
=item Inform a role of your class' attributes and methods
|
||||
|
||||
Core roles can only require methods with specific names chosen by the role. Now
|
||||
your roles can demand that the class specifies a method name you wish the role to
|
||||
instrument, or which attributes to dump to a file.
|
||||
|
||||
parameter instrument_method => (
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
role {
|
||||
my $p = shift;
|
||||
around $p->instrument_method => sub { ... };
|
||||
};
|
||||
|
||||
=item Arbitrary execution choices
|
||||
|
||||
Your role may be able to provide configuration in how the role's methods
|
||||
operate. For example, you can tell the role whether to save intermediate
|
||||
states.
|
||||
|
||||
parameter save_intermediate => (
|
||||
isa => 'Bool',
|
||||
default => 0,
|
||||
);
|
||||
|
||||
role {
|
||||
my $p = shift;
|
||||
method process => sub {
|
||||
...
|
||||
if ($p->save_intermediate) { ... }
|
||||
...
|
||||
};
|
||||
};
|
||||
|
||||
=item Deciding a backend
|
||||
|
||||
Your role may be able to freeze and thaw your instances using L<YAML>, L<JSON>,
|
||||
L<Storable>. Which backend to use can be a parameter.
|
||||
|
||||
parameter format => (
|
||||
isa => (enum ['Storable', 'YAML', 'JSON']),
|
||||
default => 'Storable',
|
||||
);
|
||||
|
||||
role {
|
||||
my $p = shift;
|
||||
if ($p->format eq 'Storable') {
|
||||
method freeze => \&Storable::freeze;
|
||||
method thaw => \&Storable::thaw;
|
||||
}
|
||||
elsif ($p->format eq 'YAML') {
|
||||
method freeze => \&YAML::Dump;
|
||||
method thaw => \&YAML::Load;
|
||||
}
|
||||
...
|
||||
};
|
||||
|
||||
=item Additional validation
|
||||
|
||||
Ordinary roles can require that its consumers have a particular list of method
|
||||
names. Since parameterized roles have direct access to its consumer, you can inspect it and throw errors if the consumer does not meet your needs.
|
||||
|
||||
role {
|
||||
my $p = shift;
|
||||
my %args = @_;
|
||||
my $consumer = $args{consumer};
|
||||
|
||||
$consumer->find_attribute_by_name('stack')
|
||||
or confess "You must have a 'stack' attribute";
|
||||
|
||||
my $push = $consumer->find_method_by_name('push')
|
||||
or confess "You must have a 'push' method";
|
||||
|
||||
my $params = $push->parsed_signature->positional_params->params;
|
||||
@$params == 1
|
||||
or confess "Your push method must take a single parameter";
|
||||
|
||||
$params->[0]->sigil eq '$'
|
||||
or confess "Your push parameter must be a scalar";
|
||||
|
||||
...
|
||||
};
|
||||
|
||||
=back
|
||||
|
||||
=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
|
||||
264
database/perl/vendor/lib/MooseX/Traits.pm
vendored
Normal file
264
database/perl/vendor/lib/MooseX/Traits.pm
vendored
Normal file
@@ -0,0 +1,264 @@
|
||||
package MooseX::Traits; # git description: v0.12-22-g1b6e7ce
|
||||
# ABSTRACT: Automatically apply roles at object creation time
|
||||
|
||||
our $VERSION = '0.13';
|
||||
|
||||
use Moose::Role;
|
||||
|
||||
use MooseX::Traits::Util qw(new_class_with_traits);
|
||||
|
||||
use warnings;
|
||||
use warnings::register;
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
has '_trait_namespace' => (
|
||||
# no accessors or init_arg
|
||||
init_arg => undef,
|
||||
isa => 'Str',
|
||||
is => 'bare',
|
||||
);
|
||||
|
||||
sub with_traits {
|
||||
my ($class, @traits) = @_;
|
||||
|
||||
my $new_class = new_class_with_traits(
|
||||
$class,
|
||||
@traits,
|
||||
);
|
||||
|
||||
return $new_class->name;
|
||||
}
|
||||
|
||||
# somewhat deprecated, but use if you want to
|
||||
sub new_with_traits {
|
||||
my $class = shift;
|
||||
|
||||
my ($hashref, %args) = 0;
|
||||
if (ref($_[0]) eq 'HASH') {
|
||||
%args = %{ +shift };
|
||||
$hashref = 1;
|
||||
} else {
|
||||
%args = @_;
|
||||
}
|
||||
|
||||
my $traits = delete $args{traits} || [];
|
||||
|
||||
my $new_class = $class->with_traits(ref $traits ? @$traits : $traits );
|
||||
|
||||
my $constructor = $new_class->meta->constructor_name;
|
||||
confess "$class ($new_class) does not have a constructor defined via the MOP?"
|
||||
if !$constructor;
|
||||
|
||||
return $new_class->$constructor($hashref ? \%args : %args);
|
||||
|
||||
}
|
||||
|
||||
# this code is broken and should never have been added. i probably
|
||||
# won't delete it, but it is definitely not up-to-date with respect to
|
||||
# other features, and never will be.
|
||||
#
|
||||
# runtime role application is fundamentally broken. if you really
|
||||
# need it, write it yourself, but consider applying the roles before
|
||||
# you create an instance.
|
||||
|
||||
#pod =for Pod::Coverage apply_traits
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub apply_traits {
|
||||
my ($self, $traits, $rebless_params) = @_;
|
||||
|
||||
# disable this warning with "use MooseX::Traits; no warnings 'MooseX::Traits'"
|
||||
warnings::warnif('apply_traits is deprecated due to being fundamentally broken. '.
|
||||
q{disable this warning with "no warnings 'MooseX::Traits'"});
|
||||
|
||||
# arrayify
|
||||
my @traits = $traits;
|
||||
@traits = @$traits if ref $traits;
|
||||
|
||||
if (@traits) {
|
||||
@traits = MooseX::Traits::Util::resolve_traits(
|
||||
$self, @traits,
|
||||
);
|
||||
|
||||
for my $trait (@traits){
|
||||
$trait->meta->apply($self, rebless_params => $rebless_params || {});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
no Moose::Role;
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Traits - Automatically apply roles at object creation time
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.13
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Given some roles:
|
||||
|
||||
package Role;
|
||||
use Moose::Role;
|
||||
has foo => ( is => 'ro', isa => 'Int' required => 1 );
|
||||
|
||||
And a class:
|
||||
|
||||
package Class;
|
||||
use Moose;
|
||||
with 'MooseX::Traits';
|
||||
|
||||
Apply the roles to the class at C<new> time:
|
||||
|
||||
my $class = Class->with_traits('Role')->new( foo => 42 );
|
||||
|
||||
Then use your customized class:
|
||||
|
||||
$class->isa('Class'); # true
|
||||
$class->does('Role'); # true
|
||||
$class->foo; # 42
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Often you want to create components that can be added to a class
|
||||
arbitrarily. This module makes it easy for the end user to use these
|
||||
components. Instead of requiring the user to create a named class
|
||||
with the desired roles applied, or apply roles to the instance
|
||||
one-by-one, he can just create a new class from yours with
|
||||
C<with_traits>, and then instantiate that.
|
||||
|
||||
There is also C<new_with_traits>, which exists for compatibility
|
||||
reasons. It accepts a C<traits> parameter, creates a new class with
|
||||
those traits, and then instantiates it.
|
||||
|
||||
Class->new_with_traits( traits => [qw/Foo Bar/], foo => 42, bar => 1 )
|
||||
|
||||
returns exactly the same object as
|
||||
|
||||
Class->with_traits(qw/Foo Bar/)->new( foo => 42, bar => 1 )
|
||||
|
||||
would. But you can also store the result of C<with_traits>, and call
|
||||
other methods:
|
||||
|
||||
my $c = Class->with_traits(qw/Foo Bar/);
|
||||
$c->new( foo => 42 );
|
||||
$c->whatever( foo => 1234 );
|
||||
|
||||
And so on.
|
||||
|
||||
=for Pod::Coverage apply_traits
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item B<< $class->with_traits( @traits ) >>
|
||||
|
||||
Return a new class with the traits applied. Use like:
|
||||
|
||||
=item B<< $class->new_with_traits(%args, traits => \@traits) >>
|
||||
|
||||
C<new_with_traits> can also take a hashref, e.g.:
|
||||
|
||||
my $instance = $class->new_with_traits({ traits => \@traits, foo => 'bar' });
|
||||
|
||||
=back
|
||||
|
||||
=head1 ATTRIBUTES YOUR CLASS GETS
|
||||
|
||||
This role will add the following attributes to the consuming class.
|
||||
|
||||
=head2 _trait_namespace
|
||||
|
||||
You can override the value of this attribute with C<default> to
|
||||
automatically prepend a namespace to the supplied traits. (This can
|
||||
be overridden by prefixing the trait name with C<+>.)
|
||||
|
||||
Example:
|
||||
|
||||
package Another::Trait;
|
||||
use Moose::Role;
|
||||
has 'bar' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
package Another::Class;
|
||||
use Moose;
|
||||
with 'MooseX::Traits';
|
||||
has '+_trait_namespace' => ( default => 'Another' );
|
||||
|
||||
my $instance = Another::Class->new_with_traits(
|
||||
traits => ['Trait'], # "Another::Trait", not "Trait"
|
||||
bar => 'bar',
|
||||
);
|
||||
$instance->does('Trait') # false
|
||||
$instance->does('Another::Trait') # true
|
||||
|
||||
my $instance2 = Another::Class->new_with_traits(
|
||||
traits => ['+Trait'], # "Trait", not "Another::Trait"
|
||||
);
|
||||
$instance2->does('Trait') # true
|
||||
$instance2->does('Another::Trait') # false
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Jonathan Rockway <jrockway@cpan.org>
|
||||
|
||||
=head1 CONTRIBUTORS
|
||||
|
||||
=for stopwords Karen Etheridge Florian Ragwitz Tomas Doran Hans Dieter Pearcey Rafael Kitover Stevan Little Alexander Hartmaier
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Tomas Doran <bobtfish@bobtfish.net>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@weftsoar.net>
|
||||
|
||||
=item *
|
||||
|
||||
Rafael Kitover <rkitover@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Stevan Little <stevan.little@iinteractive.com>
|
||||
|
||||
=item *
|
||||
|
||||
Alexander Hartmaier <abraxxa@cpan.org>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2008 by Infinity Interactive, Inc. http://www.iinteractive.com.
|
||||
|
||||
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
|
||||
87
database/perl/vendor/lib/MooseX/Traits/Util.pm
vendored
Normal file
87
database/perl/vendor/lib/MooseX/Traits/Util.pm
vendored
Normal file
@@ -0,0 +1,87 @@
|
||||
package MooseX::Traits::Util;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '0.13';
|
||||
|
||||
use Sub::Exporter -setup => {
|
||||
exports => ['new_class_with_traits'],
|
||||
};
|
||||
|
||||
use Class::Load ();
|
||||
use Carp ();
|
||||
|
||||
# note: "$class" throughout is "class name" or "instance of class
|
||||
# name"
|
||||
|
||||
sub check_class {
|
||||
my $class = shift;
|
||||
|
||||
Carp::confess "We can't interact with traits for a class ($class) ".
|
||||
"that does not do MooseX::Traits" unless $class->does('MooseX::Traits');
|
||||
}
|
||||
|
||||
sub transform_trait {
|
||||
my ($class, $name) = @_;
|
||||
return $1 if $name =~ /^[+](.+)$/;
|
||||
|
||||
check_class($class);
|
||||
|
||||
my $namespace = $class->meta->find_attribute_by_name('_trait_namespace');
|
||||
my $base;
|
||||
if($namespace->has_default){
|
||||
$base = $namespace->default;
|
||||
if(ref $base eq 'CODE'){
|
||||
$base = $base->();
|
||||
}
|
||||
}
|
||||
|
||||
return $name unless $base;
|
||||
return join '::', $base, $name;
|
||||
}
|
||||
|
||||
sub resolve_traits {
|
||||
my ($class, @traits) = @_;
|
||||
|
||||
check_class($class);
|
||||
|
||||
return map {
|
||||
my $orig = $_;
|
||||
if(!ref $orig){
|
||||
my $transformed = transform_trait($class, $orig);
|
||||
Class::Load::load_class($transformed);
|
||||
$transformed;
|
||||
}
|
||||
else {
|
||||
$orig;
|
||||
}
|
||||
} @traits;
|
||||
}
|
||||
|
||||
my $anon_serial = 0;
|
||||
|
||||
sub new_class_with_traits {
|
||||
my ($class, @traits) = @_;
|
||||
|
||||
check_class($class);
|
||||
|
||||
my $meta;
|
||||
@traits = resolve_traits($class, @traits);
|
||||
if (@traits) {
|
||||
$meta = $class->meta->create(
|
||||
join(q{::} => 'MooseX::Traits::__ANON__::SERIAL', ++$anon_serial),
|
||||
superclasses => [ $class->meta->name ],
|
||||
roles => \@traits,
|
||||
cache => 1,
|
||||
);
|
||||
}
|
||||
|
||||
# if no traits were given just return the class meta
|
||||
return $meta ? $meta : $class->meta;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=for Pod::Coverage check_class new_class_with_traits resolve_traits transform_trait
|
||||
|
||||
=cut
|
||||
1049
database/perl/vendor/lib/MooseX/Types.pm
vendored
Normal file
1049
database/perl/vendor/lib/MooseX/Types.pm
vendored
Normal file
File diff suppressed because it is too large
Load Diff
390
database/perl/vendor/lib/MooseX/Types/Base.pm
vendored
Normal file
390
database/perl/vendor/lib/MooseX/Types/Base.pm
vendored
Normal file
@@ -0,0 +1,390 @@
|
||||
package MooseX::Types::Base;
|
||||
# ABSTRACT: Type library base class
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use Moose;
|
||||
|
||||
use Carp::Clan qw( ^MooseX::Types );
|
||||
use Sub::Exporter qw( build_exporter );
|
||||
use Moose::Util::TypeConstraints qw( find_type_constraint );
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod You normally won't need to interact with this class by yourself. It is
|
||||
#pod merely a collection of functionality that type libraries need to
|
||||
#pod interact with moose and the rest of the L<MooseX::Types> module.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
my $UndefMsg = q{Unable to find type '%s' in library '%s'};
|
||||
|
||||
#pod =head1 METHODS
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
#pod =head2 import
|
||||
#pod
|
||||
#pod Provides the import mechanism for your library. See
|
||||
#pod L<MooseX::Types/"LIBRARY USAGE"> for syntax details on this.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub import {
|
||||
my ($class, @args) = @_;
|
||||
|
||||
# filter or create options hash for S:E
|
||||
my $options = (@args and (ref($args[0]) eq 'HASH')) ? $args[0] : undef;
|
||||
|
||||
# preserve additional options, to ensure types are installed into the type library's namespace
|
||||
my %ex_spec = %{ $options || {} };
|
||||
delete @ex_spec{ qw(-wrapper -into -full) };
|
||||
|
||||
unless ($options) {
|
||||
$options = {};
|
||||
unshift @args, $options;
|
||||
}
|
||||
|
||||
# all types known to us
|
||||
my @types = $class->type_names;
|
||||
|
||||
# determine the wrapper, -into is supported for compatibility reasons
|
||||
my $wrapper = $options->{ -wrapper } || 'MooseX::Types';
|
||||
|
||||
$args[0]->{into} = $options->{ -into }
|
||||
if exists $options->{ -into };
|
||||
|
||||
my %ex_util;
|
||||
|
||||
TYPE:
|
||||
for my $type_short (@types) {
|
||||
|
||||
# find type name and object, create undefined message
|
||||
my $type_full = $class->get_type($type_short)
|
||||
or croak "No fully qualified type name stored for '$type_short'";
|
||||
my $type_cons = find_type_constraint($type_full);
|
||||
my $undef_msg = sprintf($UndefMsg, $type_short, $class);
|
||||
|
||||
# the type itself
|
||||
push @{ $ex_spec{exports} },
|
||||
$type_short,
|
||||
sub {
|
||||
bless $wrapper->type_export_generator($type_short, $type_full),
|
||||
'MooseX::Types::EXPORTED_TYPE_CONSTRAINT';
|
||||
};
|
||||
|
||||
# the check helper
|
||||
my $check_name = "is_${type_short}";
|
||||
push @{ $ex_spec{exports} },
|
||||
$check_name,
|
||||
sub { $wrapper->check_export_generator($type_short, $type_full, $undef_msg) };
|
||||
|
||||
# only export coercion helper if full (for libraries) or coercion is defined
|
||||
next TYPE
|
||||
unless $options->{ -full }
|
||||
or ($type_cons and $type_cons->has_coercion);
|
||||
|
||||
my $coercion_name = "to_${type_short}";
|
||||
push @{ $ex_spec{exports} },
|
||||
$coercion_name,
|
||||
sub { $wrapper->coercion_export_generator($type_short, $type_full, $undef_msg) };
|
||||
$ex_util{ $type_short }{to}++; # shortcut to remember this exists
|
||||
}
|
||||
|
||||
# create S:E exporter and increase export level unless specified explicitly
|
||||
my $exporter = build_exporter \%ex_spec;
|
||||
$options->{into_level}++
|
||||
unless $options->{into};
|
||||
|
||||
# remember requested symbols to determine what helpers to auto-export
|
||||
my %was_requested =
|
||||
map { ($_ => 1) }
|
||||
grep { not ref }
|
||||
@args;
|
||||
|
||||
# determine which additional symbols (helpers) to export along
|
||||
my %add;
|
||||
EXPORT:
|
||||
for my $type (grep { exists $was_requested{ $_ } } @types) {
|
||||
$add{ "is_$type" }++
|
||||
unless $was_requested{ "is_$type" };
|
||||
next EXPORT
|
||||
unless exists $ex_util{ $type }{to};
|
||||
$add{ "to_$type" }++
|
||||
unless $was_requested{ "to_$type" };
|
||||
}
|
||||
|
||||
# and on to the real exporter
|
||||
my @new_args = (@args, keys %add);
|
||||
return $class->$exporter(@new_args);
|
||||
}
|
||||
|
||||
#pod =head2 get_type
|
||||
#pod
|
||||
#pod This returns a type from the library's store by its name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub get_type {
|
||||
my ($class, $type) = @_;
|
||||
|
||||
# useful message if the type couldn't be found
|
||||
croak "Unknown type '$type' in library '$class'"
|
||||
unless $class->has_type($type);
|
||||
|
||||
# return real name of the type
|
||||
return $class->type_storage->{ $type };
|
||||
}
|
||||
|
||||
#pod =head2 type_names
|
||||
#pod
|
||||
#pod Returns a list of all known types by their name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub type_names {
|
||||
my ($class) = @_;
|
||||
|
||||
# return short names of all stored types
|
||||
return keys %{ $class->type_storage };
|
||||
}
|
||||
|
||||
#pod =head2 add_type
|
||||
#pod
|
||||
#pod Adds a new type to the library.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub add_type {
|
||||
my ($class, $type) = @_;
|
||||
|
||||
# store type with library prefix as real name
|
||||
$class->type_storage->{ $type } = "${class}::${type}";
|
||||
}
|
||||
|
||||
#pod =head2 has_type
|
||||
#pod
|
||||
#pod Returns true or false depending on if this library knows a type by that
|
||||
#pod name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub has_type {
|
||||
my ($class, $type) = @_;
|
||||
|
||||
# check if we stored a type under that name
|
||||
return ! ! $class->type_storage->{ $type };
|
||||
}
|
||||
|
||||
#pod =head2 type_storage
|
||||
#pod
|
||||
#pod Returns the library's type storage hash reference. You shouldn't use this
|
||||
#pod method directly unless you know what you are doing. It is not an internal
|
||||
#pod method because overriding it makes virtual libraries very easy.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub type_storage {
|
||||
my ($class) = @_;
|
||||
|
||||
# return a reference to the storage in ourself
|
||||
{ no strict 'refs';
|
||||
return \%{ $class . '::__MOOSEX_TYPELIBRARY_STORAGE' };
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 registered_class_types
|
||||
#pod
|
||||
#pod Returns the class types registered within this library. Don't use directly.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub registered_class_types {
|
||||
my ($class) = @_;
|
||||
|
||||
{
|
||||
no strict 'refs';
|
||||
return \%{ $class . '::__MOOSEX_TYPELIBRARY_CLASS_TYPES' };
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 register_class_type
|
||||
#pod
|
||||
#pod Register a C<class_type> for use in this library by class name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub register_class_type {
|
||||
my ($class, $type) = @_;
|
||||
|
||||
croak "Not a class_type"
|
||||
unless $type->isa('Moose::Meta::TypeConstraint::Class');
|
||||
|
||||
$class->registered_class_types->{$type->class} = $type;
|
||||
}
|
||||
|
||||
#pod =head2 get_registered_class_type
|
||||
#pod
|
||||
#pod Get a C<class_type> registered in this library by name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub get_registered_class_type {
|
||||
my ($class, $name) = @_;
|
||||
|
||||
$class->registered_class_types->{$name};
|
||||
}
|
||||
|
||||
#pod =head2 registered_role_types
|
||||
#pod
|
||||
#pod Returns the role types registered within this library. Don't use directly.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub registered_role_types {
|
||||
my ($class) = @_;
|
||||
|
||||
{
|
||||
no strict 'refs';
|
||||
return \%{ $class . '::__MOOSEX_TYPELIBRARY_ROLE_TYPES' };
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 register_role_type
|
||||
#pod
|
||||
#pod Register a C<role_type> for use in this library by role name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub register_role_type {
|
||||
my ($class, $type) = @_;
|
||||
|
||||
croak "Not a role_type"
|
||||
unless $type->isa('Moose::Meta::TypeConstraint::Role');
|
||||
|
||||
$class->registered_role_types->{$type->role} = $type;
|
||||
}
|
||||
|
||||
#pod =head2 get_registered_role_type
|
||||
#pod
|
||||
#pod Get a C<role_type> registered in this library by role name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub get_registered_role_type {
|
||||
my ($class, $name) = @_;
|
||||
|
||||
$class->registered_role_types->{$name};
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod L<MooseX::Types::Moose>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::Base - Type library base class
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
You normally won't need to interact with this class by yourself. It is
|
||||
merely a collection of functionality that type libraries need to
|
||||
interact with moose and the rest of the L<MooseX::Types> module.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 import
|
||||
|
||||
Provides the import mechanism for your library. See
|
||||
L<MooseX::Types/"LIBRARY USAGE"> for syntax details on this.
|
||||
|
||||
=head2 get_type
|
||||
|
||||
This returns a type from the library's store by its name.
|
||||
|
||||
=head2 type_names
|
||||
|
||||
Returns a list of all known types by their name.
|
||||
|
||||
=head2 add_type
|
||||
|
||||
Adds a new type to the library.
|
||||
|
||||
=head2 has_type
|
||||
|
||||
Returns true or false depending on if this library knows a type by that
|
||||
name.
|
||||
|
||||
=head2 type_storage
|
||||
|
||||
Returns the library's type storage hash reference. You shouldn't use this
|
||||
method directly unless you know what you are doing. It is not an internal
|
||||
method because overriding it makes virtual libraries very easy.
|
||||
|
||||
=head2 registered_class_types
|
||||
|
||||
Returns the class types registered within this library. Don't use directly.
|
||||
|
||||
=head2 register_class_type
|
||||
|
||||
Register a C<class_type> for use in this library by class name.
|
||||
|
||||
=head2 get_registered_class_type
|
||||
|
||||
Get a C<class_type> registered in this library by name.
|
||||
|
||||
=head2 registered_role_types
|
||||
|
||||
Returns the role types registered within this library. Don't use directly.
|
||||
|
||||
=head2 register_role_type
|
||||
|
||||
Register a C<role_type> for use in this library by role name.
|
||||
|
||||
=head2 get_registered_role_type
|
||||
|
||||
Get a C<role_type> registered in this library by role name.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<MooseX::Types::Moose>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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
|
||||
159
database/perl/vendor/lib/MooseX/Types/CheckedUtilExports.pm
vendored
Normal file
159
database/perl/vendor/lib/MooseX/Types/CheckedUtilExports.pm
vendored
Normal file
@@ -0,0 +1,159 @@
|
||||
package MooseX::Types::CheckedUtilExports;
|
||||
# ABSTRACT: Wrap L<Moose::Util::TypeConstraints> to be safer for L<MooseX::Types>
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Moose::Util::TypeConstraints ();
|
||||
use Moose::Exporter;
|
||||
use Carp 'carp';
|
||||
use Sub::Install;
|
||||
use namespace::autoclean;
|
||||
|
||||
my $StringFoundMsg =
|
||||
q{WARNING: String found where Type expected (did you use a => instead of a , ?)};
|
||||
|
||||
my @exports = qw/type subtype maybe_type duck_type enum coerce from as/;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod Prevents errors like:
|
||||
#pod
|
||||
#pod subtype Foo =>
|
||||
#pod ...
|
||||
#pod
|
||||
#pod Which should be written as:
|
||||
#pod
|
||||
#pod subtype Foo,
|
||||
#pod ...
|
||||
#pod
|
||||
#pod When using L<MooseX::Types>. Exported by that module.
|
||||
#pod
|
||||
#pod Exports checked versions of the following subs:
|
||||
#pod
|
||||
#pod C<type> C<subtype> C<maybe_type> C<duck_type> C<enum> C<coerce> C<from> C<as>
|
||||
#pod
|
||||
#pod While C<class_type> and C<role_type> will also register the type in the library.
|
||||
#pod
|
||||
#pod From L<Moose::Util::TypeConstraints>. See that module for syntax.
|
||||
#pod
|
||||
#pod =for Pod::Coverage class_type role_type
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
for my $export (@exports) {
|
||||
no strict 'refs';
|
||||
|
||||
Sub::Install::install_sub({
|
||||
into => __PACKAGE__,
|
||||
as => $export,
|
||||
code => sub {
|
||||
my $caller = shift;
|
||||
|
||||
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
|
||||
|
||||
carp $StringFoundMsg
|
||||
unless ref($_[0]) ||
|
||||
$_[0] =~ /\b::\b/ || # qualified type
|
||||
$caller->get_registered_class_type($_[0]) ||
|
||||
$caller->get_registered_role_type($_[0]);
|
||||
|
||||
goto &{"Moose::Util::TypeConstraints::$export"};
|
||||
}
|
||||
});
|
||||
}
|
||||
|
||||
Moose::Exporter->setup_import_methods(
|
||||
with_caller => [ @exports, 'class_type', 'role_type' ]
|
||||
);
|
||||
|
||||
sub class_type {
|
||||
my $caller = shift;
|
||||
|
||||
$caller->register_class_type(
|
||||
Moose::Util::TypeConstraints::class_type(@_)
|
||||
);
|
||||
}
|
||||
|
||||
sub role_type ($;$) {
|
||||
my ($caller, $name, $opts) = @_;
|
||||
|
||||
$caller->register_role_type(
|
||||
Moose::Util::TypeConstraints::role_type($name, $opts)
|
||||
);
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod L<MooseX::Types>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::CheckedUtilExports - Wrap L<Moose::Util::TypeConstraints> to be safer for L<MooseX::Types>
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Prevents errors like:
|
||||
|
||||
subtype Foo =>
|
||||
...
|
||||
|
||||
Which should be written as:
|
||||
|
||||
subtype Foo,
|
||||
...
|
||||
|
||||
When using L<MooseX::Types>. Exported by that module.
|
||||
|
||||
Exports checked versions of the following subs:
|
||||
|
||||
C<type> C<subtype> C<maybe_type> C<duck_type> C<enum> C<coerce> C<from> C<as>
|
||||
|
||||
While C<class_type> and C<role_type> will also register the type in the library.
|
||||
|
||||
From L<Moose::Util::TypeConstraints>. See that module for syntax.
|
||||
|
||||
=for Pod::Coverage class_type role_type
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<MooseX::Types>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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
|
||||
283
database/perl/vendor/lib/MooseX/Types/Combine.pm
vendored
Normal file
283
database/perl/vendor/lib/MooseX/Types/Combine.pm
vendored
Normal file
@@ -0,0 +1,283 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
package MooseX::Types::Combine;
|
||||
# ABSTRACT: Combine type libraries for exporting
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use Module::Runtime 'use_module';
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 SYNOPSIS
|
||||
#pod
|
||||
#pod package CombinedTypeLib;
|
||||
#pod
|
||||
#pod use base 'MooseX::Types::Combine';
|
||||
#pod
|
||||
#pod __PACKAGE__->provide_types_from(qw/TypeLib1 TypeLib2/);
|
||||
#pod
|
||||
#pod package UserClass;
|
||||
#pod
|
||||
#pod use CombinedTypeLib qw/Type1 Type2 ... /;
|
||||
#pod
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod Allows you to create a single class that will allow you to export types from
|
||||
#pod multiple type libraries:
|
||||
#pod
|
||||
#pod package TransportTypes;
|
||||
#pod
|
||||
#pod use base 'MooseX::Types::Combine';
|
||||
#pod
|
||||
#pod __PACKAGE__->provide_types_from(qw/ MotorizedTypes UnmotorizedTypes /);
|
||||
#pod
|
||||
#pod 1;
|
||||
#pod
|
||||
#pod In this example all types defined in C<MotorizedTypes> and C<UnmotorizedTypes>
|
||||
#pod are available through the C<TransportTypes> combined type library.
|
||||
#pod
|
||||
#pod package SkiingTrip;
|
||||
#pod
|
||||
#pod use Moose;
|
||||
#pod
|
||||
#pod use TransportTypes qw( CarType SkisType );
|
||||
#pod
|
||||
#pod has car => ( is => 'ro', isa => CarType, required => 1 );
|
||||
#pod has ski_rack => ( is => 'ro', isa => ArrayRef[SkisType], required => 1 );
|
||||
#pod ...
|
||||
#pod
|
||||
#pod Libraries on the right end of the list passed to L</provide_types_from> take
|
||||
#pod precedence over those on the left in case of conflicts. So, in the above
|
||||
#pod example if both the C<MotorizedTypes> and C<UnmotorizedTypes> libraries provided
|
||||
#pod a C<Bike> type, you'd get the bicycle from C<UnmotorizedTypes> not the
|
||||
#pod motorbike from C<MorotizedTypes>.
|
||||
#pod
|
||||
#pod You can also further combine combined type libraries with additional type
|
||||
#pod libraries or other combined type libraries in the same way to provide even
|
||||
#pod larger type libraries:
|
||||
#pod
|
||||
#pod package MeetingTransportTypes;
|
||||
#pod
|
||||
#pod use base 'MooseX::Types::Combine';
|
||||
#pod
|
||||
#pod __PACKAGE__->provide_types_from(qw/ TransportTypes TelepresenceTypes /);
|
||||
#pod
|
||||
#pod 1;
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub import {
|
||||
my ($class, @types) = @_;
|
||||
my $caller = caller;
|
||||
|
||||
my $where_to_import_to = $caller;
|
||||
if (ref $types[0] eq 'HASH') {
|
||||
my $extra = shift @types;
|
||||
$where_to_import_to = $extra->{-into} if exists $extra->{-into};
|
||||
}
|
||||
|
||||
my %types = $class->_provided_types;
|
||||
|
||||
if ( grep { $_ eq ':all' } @types ) {
|
||||
$_->import( { -into => $where_to_import_to }, q{:all} )
|
||||
for $class->provide_types_from;
|
||||
return;
|
||||
}
|
||||
|
||||
my %from;
|
||||
for my $type (@types) {
|
||||
unless ($types{$type}) {
|
||||
my @type_libs = $class->provide_types_from;
|
||||
|
||||
die
|
||||
"$caller asked for a type ($type) which is not found in any of the"
|
||||
. " type libraries (@type_libs) combined by $class\n";
|
||||
}
|
||||
|
||||
push @{ $from{ $types{$type} } }, $type;
|
||||
}
|
||||
|
||||
$_->import({ -into => $where_to_import_to }, @{ $from{ $_ } })
|
||||
for keys %from;
|
||||
}
|
||||
|
||||
#pod =head1 CLASS METHODS
|
||||
#pod
|
||||
#pod =head2 provide_types_from
|
||||
#pod
|
||||
#pod Sets or returns a list of type libraries (or combined type libraries) to
|
||||
#pod re-export from.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub provide_types_from {
|
||||
my ($class, @libs) = @_;
|
||||
|
||||
my $store =
|
||||
do { no strict 'refs'; \@{ "${class}::__MOOSEX_TYPELIBRARY_LIBRARIES" } };
|
||||
|
||||
if (@libs) {
|
||||
$class->_check_type_lib($_) for @libs;
|
||||
@$store = @libs;
|
||||
|
||||
my %types = map {
|
||||
my $lib = $_;
|
||||
map +( $_ => $lib ), $lib->type_names
|
||||
} @libs;
|
||||
|
||||
$class->_provided_types(%types);
|
||||
}
|
||||
|
||||
@$store;
|
||||
}
|
||||
|
||||
sub _check_type_lib {
|
||||
my ($class, $lib) = @_;
|
||||
|
||||
use_module($lib);
|
||||
|
||||
die "Cannot use $lib in a combined type library, it does not provide any types"
|
||||
unless $lib->can('type_names');
|
||||
}
|
||||
|
||||
sub _provided_types {
|
||||
my ($class, %types) = @_;
|
||||
|
||||
my $types =
|
||||
do { no strict 'refs'; \%{ "${class}::__MOOSEX_TYPELIBRARY_TYPES" } };
|
||||
|
||||
%$types = %types
|
||||
if keys %types;
|
||||
|
||||
%$types;
|
||||
}
|
||||
|
||||
#pod =head2 type_names
|
||||
#pod
|
||||
#pod Returns a list of all known types by their name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub type_names {
|
||||
my ($class) = @_;
|
||||
|
||||
my %types = $class->_provided_types();
|
||||
return keys %types;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod L<MooseX::Types>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::Combine - Combine type libraries for exporting
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package CombinedTypeLib;
|
||||
|
||||
use base 'MooseX::Types::Combine';
|
||||
|
||||
__PACKAGE__->provide_types_from(qw/TypeLib1 TypeLib2/);
|
||||
|
||||
package UserClass;
|
||||
|
||||
use CombinedTypeLib qw/Type1 Type2 ... /;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Allows you to create a single class that will allow you to export types from
|
||||
multiple type libraries:
|
||||
|
||||
package TransportTypes;
|
||||
|
||||
use base 'MooseX::Types::Combine';
|
||||
|
||||
__PACKAGE__->provide_types_from(qw/ MotorizedTypes UnmotorizedTypes /);
|
||||
|
||||
1;
|
||||
|
||||
In this example all types defined in C<MotorizedTypes> and C<UnmotorizedTypes>
|
||||
are available through the C<TransportTypes> combined type library.
|
||||
|
||||
package SkiingTrip;
|
||||
|
||||
use Moose;
|
||||
|
||||
use TransportTypes qw( CarType SkisType );
|
||||
|
||||
has car => ( is => 'ro', isa => CarType, required => 1 );
|
||||
has ski_rack => ( is => 'ro', isa => ArrayRef[SkisType], required => 1 );
|
||||
...
|
||||
|
||||
Libraries on the right end of the list passed to L</provide_types_from> take
|
||||
precedence over those on the left in case of conflicts. So, in the above
|
||||
example if both the C<MotorizedTypes> and C<UnmotorizedTypes> libraries provided
|
||||
a C<Bike> type, you'd get the bicycle from C<UnmotorizedTypes> not the
|
||||
motorbike from C<MorotizedTypes>.
|
||||
|
||||
You can also further combine combined type libraries with additional type
|
||||
libraries or other combined type libraries in the same way to provide even
|
||||
larger type libraries:
|
||||
|
||||
package MeetingTransportTypes;
|
||||
|
||||
use base 'MooseX::Types::Combine';
|
||||
|
||||
__PACKAGE__->provide_types_from(qw/ TransportTypes TelepresenceTypes /);
|
||||
|
||||
1;
|
||||
|
||||
=head1 CLASS METHODS
|
||||
|
||||
=head2 provide_types_from
|
||||
|
||||
Sets or returns a list of type libraries (or combined type libraries) to
|
||||
re-export from.
|
||||
|
||||
=head2 type_names
|
||||
|
||||
Returns a list of all known types by their name.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<MooseX::Types>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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
|
||||
149
database/perl/vendor/lib/MooseX/Types/Moose.pm
vendored
Normal file
149
database/perl/vendor/lib/MooseX/Types/Moose.pm
vendored
Normal file
@@ -0,0 +1,149 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
package MooseX::Types::Moose;
|
||||
# ABSTRACT: Type exports that match the types shipped with L<Moose>
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use MooseX::Types;
|
||||
use Moose::Util::TypeConstraints ();
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 SYNOPSIS
|
||||
#pod
|
||||
#pod package Foo;
|
||||
#pod use Moose;
|
||||
#pod use MooseX::Types::Moose qw( ArrayRef Int Str );
|
||||
#pod use Carp qw( croak );
|
||||
#pod
|
||||
#pod has 'name',
|
||||
#pod is => 'rw',
|
||||
#pod isa => Str;
|
||||
#pod
|
||||
#pod has 'ids',
|
||||
#pod is => 'rw',
|
||||
#pod isa => ArrayRef[Int];
|
||||
#pod
|
||||
#pod sub add {
|
||||
#pod my ($self, $x, $y) = @_;
|
||||
#pod croak 'First arg not an Int' unless is_Int($x);
|
||||
#pod croak 'Second arg not an Int' unless is_Int($y);
|
||||
#pod return $x + $y;
|
||||
#pod }
|
||||
#pod
|
||||
#pod 1;
|
||||
#pod
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This package contains a virtual library for L<MooseX::Types> that
|
||||
#pod is able to export all types known to L<Moose>. See L<MooseX::Types>
|
||||
#pod for general usage information.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
# all available builtin types as short and long name
|
||||
my %BuiltIn_Storage
|
||||
= map { ($_) x 2 }
|
||||
Moose::Util::TypeConstraints->list_all_builtin_type_constraints;
|
||||
|
||||
#pod =head1 METHODS
|
||||
#pod
|
||||
#pod =head2 type_storage
|
||||
#pod
|
||||
#pod Overrides L<MooseX::Types::Base>' C<type_storage> to provide a hash
|
||||
#pod reference containing all built-in L<Moose> types.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
# use prepopulated builtin hash as type storage
|
||||
sub type_storage { \%BuiltIn_Storage }
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod L<Moose>,
|
||||
#pod L<Moose::Util::TypeConstraints>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::Moose - Type exports that match the types shipped with L<Moose>
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
package Foo;
|
||||
use Moose;
|
||||
use MooseX::Types::Moose qw( ArrayRef Int Str );
|
||||
use Carp qw( croak );
|
||||
|
||||
has 'name',
|
||||
is => 'rw',
|
||||
isa => Str;
|
||||
|
||||
has 'ids',
|
||||
is => 'rw',
|
||||
isa => ArrayRef[Int];
|
||||
|
||||
sub add {
|
||||
my ($self, $x, $y) = @_;
|
||||
croak 'First arg not an Int' unless is_Int($x);
|
||||
croak 'Second arg not an Int' unless is_Int($y);
|
||||
return $x + $y;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package contains a virtual library for L<MooseX::Types> that
|
||||
is able to export all types known to L<Moose>. See L<MooseX::Types>
|
||||
for general usage information.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 type_storage
|
||||
|
||||
Overrides L<MooseX::Types::Base>' C<type_storage> to provide a hash
|
||||
reference containing all built-in L<Moose> types.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Moose>,
|
||||
L<Moose::Util::TypeConstraints>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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
|
||||
1796
database/perl/vendor/lib/MooseX/Types/Structured.pm
vendored
Normal file
1796
database/perl/vendor/lib/MooseX/Types/Structured.pm
vendored
Normal file
File diff suppressed because it is too large
Load Diff
45
database/perl/vendor/lib/MooseX/Types/Structured/MessageStack.pm
vendored
Normal file
45
database/perl/vendor/lib/MooseX/Types/Structured/MessageStack.pm
vendored
Normal file
@@ -0,0 +1,45 @@
|
||||
package ## Hide from PAUSE
|
||||
MooseX::Types::Structured::MessageStack;
|
||||
|
||||
our $VERSION = '0.36';
|
||||
|
||||
use Moose;
|
||||
|
||||
has 'level' => (
|
||||
traits => ['Counter'],
|
||||
is => 'ro',
|
||||
isa => 'Num',
|
||||
required => 0,
|
||||
default => 0,
|
||||
handles => {
|
||||
inc_level => 'inc',
|
||||
dec_level => 'dec',
|
||||
},
|
||||
);
|
||||
|
||||
has 'messages' => (
|
||||
traits => ['Array'],
|
||||
is => 'ro',
|
||||
isa => 'ArrayRef[HashRef]',
|
||||
required => 1,
|
||||
default => sub { [] },
|
||||
handles => {
|
||||
has_messages => 'count',
|
||||
add_message => 'push',
|
||||
all_messages => 'elements',
|
||||
},
|
||||
);
|
||||
|
||||
sub as_string {
|
||||
my @messages = (shift)->all_messages;
|
||||
my @flattened_msgs = map {
|
||||
"\n". (" " x $_->{level}) ."[+] " . $_->{message};
|
||||
} reverse @messages;
|
||||
|
||||
return join("", @flattened_msgs);
|
||||
}
|
||||
|
||||
no Moose;
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
|
||||
1;
|
||||
25
database/perl/vendor/lib/MooseX/Types/Structured/OverflowHandler.pm
vendored
Normal file
25
database/perl/vendor/lib/MooseX/Types/Structured/OverflowHandler.pm
vendored
Normal file
@@ -0,0 +1,25 @@
|
||||
package ## Hide from PAUSE
|
||||
MooseX::Types::Structured::OverflowHandler;
|
||||
|
||||
our $VERSION = '0.36';
|
||||
|
||||
use Moose;
|
||||
|
||||
use overload '""' => 'name', fallback => 1;
|
||||
|
||||
has type_constraint => (
|
||||
is => 'ro',
|
||||
isa => 'Moose::Meta::TypeConstraint',
|
||||
required => 1,
|
||||
handles => [qw/check/],
|
||||
);
|
||||
|
||||
sub name {
|
||||
my ($self) = @_;
|
||||
return 'slurpy(' . $self->type_constraint->name . ')';
|
||||
}
|
||||
|
||||
no Moose;
|
||||
__PACKAGE__->meta->make_immutable;
|
||||
|
||||
1;
|
||||
304
database/perl/vendor/lib/MooseX/Types/TypeDecorator.pm
vendored
Normal file
304
database/perl/vendor/lib/MooseX/Types/TypeDecorator.pm
vendored
Normal file
@@ -0,0 +1,304 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
package MooseX::Types::TypeDecorator;
|
||||
# ABSTRACT: Wraps Moose::Meta::TypeConstraint objects with added features
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use Carp::Clan '^MooseX::Types';
|
||||
use Moose::Util::TypeConstraints ();
|
||||
use Moose::Meta::TypeConstraint::Union;
|
||||
use Scalar::Util qw(blessed);
|
||||
use namespace::autoclean 0.16;
|
||||
|
||||
use overload(
|
||||
'0+' => sub {
|
||||
my $self = shift @_;
|
||||
my $tc = $self->{__type_constraint};
|
||||
return 0+$tc;
|
||||
},
|
||||
# workaround for perl 5.8.5 bug
|
||||
'==' => sub { 0+$_[0] == 0+$_[1] },
|
||||
'""' => sub {
|
||||
my $self = shift @_;
|
||||
if(blessed $self) {
|
||||
return $self->__type_constraint->name;
|
||||
} else {
|
||||
return "$self";
|
||||
}
|
||||
},
|
||||
bool => sub { 1 },
|
||||
'|' => sub {
|
||||
|
||||
## It's kind of ugly that we need to know about Union Types, but this
|
||||
## is needed for syntax compatibility. Maybe someday we'll all just do
|
||||
## Or[Str,Str,Int]
|
||||
|
||||
my @args = @_[0,1]; ## arg 3 is special, see the overload docs.
|
||||
my @tc = grep {blessed $_} map {
|
||||
blessed $_ ? $_ :
|
||||
Moose::Util::TypeConstraints::find_or_parse_type_constraint($_)
|
||||
|| __PACKAGE__->_throw_error( "$_ is not a type constraint")
|
||||
} @args;
|
||||
|
||||
( scalar @tc == scalar @args)
|
||||
|| __PACKAGE__->_throw_error(
|
||||
"one of your type constraints is bad. Passed: ". join(', ', @args) ." Got: ". join(', ', @tc));
|
||||
|
||||
( scalar @tc >= 2 )
|
||||
|| __PACKAGE__->_throw_error("You must pass in at least 2 type names to make a union");
|
||||
|
||||
my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
|
||||
return Moose::Util::TypeConstraints::register_type_constraint($union);
|
||||
},
|
||||
fallback => 1,
|
||||
);
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This is a decorator object that contains an underlying type constraint. We use
|
||||
#pod this to control access to the type constraint and to add some features.
|
||||
#pod
|
||||
#pod =head1 METHODS
|
||||
#pod
|
||||
#pod This class defines the following methods.
|
||||
#pod
|
||||
#pod =head2 new
|
||||
#pod
|
||||
#pod Old school instantiation
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
if (ref($proto)) {
|
||||
return $proto->_try_delegate('new', @_);
|
||||
}
|
||||
my $class = $proto;
|
||||
if(my $arg = shift @_) {
|
||||
if(blessed $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
|
||||
return bless {'__type_constraint'=>$arg}, $class;
|
||||
} elsif(
|
||||
blessed $arg &&
|
||||
$arg->isa('MooseX::Types::UndefinedType')
|
||||
) {
|
||||
## stub in case we'll need to handle these types differently
|
||||
return bless {'__type_constraint'=>$arg}, $class;
|
||||
} elsif(blessed $arg) {
|
||||
__PACKAGE__->_throw_error("Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType'), not ". blessed $arg);
|
||||
} else {
|
||||
__PACKAGE__->_throw_error("Argument cannot be '$arg'");
|
||||
}
|
||||
} else {
|
||||
__PACKAGE__->_throw_error("This method [new] requires a single argument.");
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 __type_constraint ($type_constraint)
|
||||
#pod
|
||||
#pod Set/Get the type_constraint.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub __type_constraint {
|
||||
my $self = shift @_;
|
||||
if(blessed $self) {
|
||||
if(defined(my $tc = shift @_)) {
|
||||
$self->{__type_constraint} = $tc;
|
||||
}
|
||||
return $self->{__type_constraint};
|
||||
} else {
|
||||
__PACKAGE__->_throw_error('cannot call __type_constraint as a class method');
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 C<isa>
|
||||
#pod
|
||||
#pod handle C<< $self->isa >> since C<AUTOLOAD> can't - this tries both the type constraint,
|
||||
#pod and for a class type, the class.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub isa {
|
||||
my $self = shift;
|
||||
return
|
||||
blessed $self
|
||||
? $self->__type_constraint->isa(@_)
|
||||
|| $self->_try_delegate( 'isa', @_ )
|
||||
: $self->SUPER::isa(@_);
|
||||
}
|
||||
|
||||
#pod =head2 can
|
||||
#pod
|
||||
#pod handle $self->can since AUTOLOAD can't.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub can {
|
||||
my $self = shift;
|
||||
|
||||
return blessed $self
|
||||
? $self->_try_delegate( 'can', @_ )
|
||||
: $self->SUPER::can(@_);
|
||||
}
|
||||
|
||||
#pod =head2 _throw_error
|
||||
#pod
|
||||
#pod properly delegate error messages
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub _throw_error {
|
||||
shift;
|
||||
require Moose;
|
||||
unshift @_, 'Moose';
|
||||
goto &Moose::throw_error;
|
||||
}
|
||||
|
||||
#pod =head2 DESTROY
|
||||
#pod
|
||||
#pod We might need it later
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub DESTROY {
|
||||
return;
|
||||
}
|
||||
|
||||
#pod =head2 AUTOLOAD
|
||||
#pod
|
||||
#pod Delegate to the decorator target, unless this is a class type, in which
|
||||
#pod case it will try to delegate to the type object, then if that fails try
|
||||
#pod the class. The method 'new' is special cased to only be permitted on
|
||||
#pod the class; if there is no class, or it does not provide a new method,
|
||||
#pod an exception will be thrown.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub AUTOLOAD {
|
||||
my ($self, @args) = @_;
|
||||
my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
|
||||
|
||||
## We delegate with this method in an attempt to support a value of
|
||||
## __type_constraint which is also AUTOLOADing, in particular the class
|
||||
## MooseX::Types::UndefinedType which AUTOLOADs during autovivication.
|
||||
|
||||
$self->_try_delegate($method, @args);
|
||||
}
|
||||
|
||||
sub _try_delegate {
|
||||
my ($self, $method, @args) = @_;
|
||||
my $tc = $self->__type_constraint;
|
||||
my $class;
|
||||
if ($tc->can('is_subtype_of')) { # Union can't
|
||||
my $search_tc = $tc;
|
||||
while (1) {
|
||||
if ($search_tc->isa('Moose::Meta::TypeConstraint::Class')) {
|
||||
$class = $search_tc->class;
|
||||
last;
|
||||
}
|
||||
$search_tc = $search_tc->parent;
|
||||
last unless $search_tc && $search_tc->is_subtype_of('Object');
|
||||
}
|
||||
}
|
||||
|
||||
my $inv = do {
|
||||
if ($method eq 'new') {
|
||||
die "new called on type decorator for non-class-type ".$tc->name
|
||||
unless $class;
|
||||
die "new called on class type decorator ".$tc->name."\n"
|
||||
." for class ${class}\n"
|
||||
." which does not provide a new method - did you forget to load it?"
|
||||
unless $class->can('new');
|
||||
$class
|
||||
} elsif ($class && !$tc->can($method)) {
|
||||
$class
|
||||
} else {
|
||||
$tc
|
||||
}
|
||||
};
|
||||
|
||||
$inv->$method(@args);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::TypeDecorator - Wraps Moose::Meta::TypeConstraint objects with added features
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a decorator object that contains an underlying type constraint. We use
|
||||
this to control access to the type constraint and to add some features.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
This class defines the following methods.
|
||||
|
||||
=head2 new
|
||||
|
||||
Old school instantiation
|
||||
|
||||
=head2 __type_constraint ($type_constraint)
|
||||
|
||||
Set/Get the type_constraint.
|
||||
|
||||
=head2 C<isa>
|
||||
|
||||
handle C<< $self->isa >> since C<AUTOLOAD> can't - this tries both the type constraint,
|
||||
and for a class type, the class.
|
||||
|
||||
=head2 can
|
||||
|
||||
handle $self->can since AUTOLOAD can't.
|
||||
|
||||
=head2 _throw_error
|
||||
|
||||
properly delegate error messages
|
||||
|
||||
=head2 DESTROY
|
||||
|
||||
We might need it later
|
||||
|
||||
=head2 AUTOLOAD
|
||||
|
||||
Delegate to the decorator target, unless this is a class type, in which
|
||||
case it will try to delegate to the type object, then if that fails try
|
||||
the class. The method 'new' is special cased to only be permitted on
|
||||
the class; if there is no class, or it does not provide a new method,
|
||||
an exception will be thrown.
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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
|
||||
204
database/perl/vendor/lib/MooseX/Types/UndefinedType.pm
vendored
Normal file
204
database/perl/vendor/lib/MooseX/Types/UndefinedType.pm
vendored
Normal file
@@ -0,0 +1,204 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
package MooseX::Types::UndefinedType;
|
||||
# ABSTRACT: a fallback type for when a type cannot be found
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use Moose::Util::TypeConstraints ();
|
||||
use Carp::Clan '^MooseX::Types';
|
||||
use namespace::autoclean 0.16;
|
||||
|
||||
use overload '""' => sub { shift->name },
|
||||
fallback => 1;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod Whenever a type handle function (e.g. C<Int()> can't find a type
|
||||
#pod constraint under its full name, it assumes it has not yet been defined.
|
||||
#pod It will then return an instance of this class, handling only
|
||||
#pod stringification, name and possible identification of undefined types.
|
||||
#pod
|
||||
#pod Later, when you try to use the Undefined Type Constraint, autovivification will
|
||||
#pod be attempted.
|
||||
#pod
|
||||
#pod =head1 METHODS
|
||||
#pod
|
||||
#pod =head2 new
|
||||
#pod
|
||||
#pod Takes a full type name as argument and returns an instance of this
|
||||
#pod class.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub new {
|
||||
return bless { name => $_[1] }, $_[0];
|
||||
}
|
||||
|
||||
#pod =head2 name
|
||||
#pod
|
||||
#pod Returns the stored type name.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub name {
|
||||
return $_[0]->{name};
|
||||
}
|
||||
|
||||
#pod =head2 __autovivify
|
||||
#pod
|
||||
#pod Try to see if the type constraint has yet been defined and if so create it.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub __autovivify {
|
||||
my ($self) = @_;
|
||||
if(my $tc = $self->{instance}) {
|
||||
return $tc;
|
||||
} elsif( my $new_tc = Moose::Util::TypeConstraints::find_type_constraint($self->name)) {
|
||||
$self->{instance} = $new_tc;
|
||||
return $new_tc;
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 can_be_inlined
|
||||
#pod
|
||||
#pod Make sure that if a type hasn't been defined yet when Moose wants to inline it,
|
||||
#pod we don't allow inlining.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub can_be_inlined {
|
||||
my $self = shift;
|
||||
if(my $type_constraint = $self->__autovivify) {
|
||||
return $type_constraint->can_be_inlined;
|
||||
} else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 AUTOLOAD
|
||||
#pod
|
||||
#pod Try to autovivify and delegate
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub AUTOLOAD {
|
||||
my ($self, @args) = @_;
|
||||
my ($method) = our $AUTOLOAD =~ /([^:]+)$/;
|
||||
|
||||
if(my $type_constraint = $self->__autovivify) {
|
||||
return $type_constraint->$method(@args);
|
||||
} else {
|
||||
croak "Method '$method' is not supported for " . $self->name;
|
||||
}
|
||||
}
|
||||
|
||||
#pod =head2 DESTROY
|
||||
#pod
|
||||
#pod Moose::Meta::TypeConstraint::Parameterizable complains if this isn't here. TODO
|
||||
#pod to find out why.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub DESTROY {
|
||||
return;
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod L<MooseX::Types::Moose>,
|
||||
#pod L<Moose::Util::TypeConstraints>,
|
||||
#pod L<Moose::Meta::TypeConstraint>,
|
||||
#pod L<Carp::Clan>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::UndefinedType - a fallback type for when a type cannot be found
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Whenever a type handle function (e.g. C<Int()> can't find a type
|
||||
constraint under its full name, it assumes it has not yet been defined.
|
||||
It will then return an instance of this class, handling only
|
||||
stringification, name and possible identification of undefined types.
|
||||
|
||||
Later, when you try to use the Undefined Type Constraint, autovivification will
|
||||
be attempted.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 new
|
||||
|
||||
Takes a full type name as argument and returns an instance of this
|
||||
class.
|
||||
|
||||
=head2 name
|
||||
|
||||
Returns the stored type name.
|
||||
|
||||
=head2 __autovivify
|
||||
|
||||
Try to see if the type constraint has yet been defined and if so create it.
|
||||
|
||||
=head2 can_be_inlined
|
||||
|
||||
Make sure that if a type hasn't been defined yet when Moose wants to inline it,
|
||||
we don't allow inlining.
|
||||
|
||||
=head2 AUTOLOAD
|
||||
|
||||
Try to autovivify and delegate
|
||||
|
||||
=head2 DESTROY
|
||||
|
||||
Moose::Meta::TypeConstraint::Parameterizable complains if this isn't here. TODO
|
||||
to find out why.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<MooseX::Types::Moose>,
|
||||
L<Moose::Util::TypeConstraints>,
|
||||
L<Moose::Meta::TypeConstraint>,
|
||||
L<Carp::Clan>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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
|
||||
191
database/perl/vendor/lib/MooseX/Types/Util.pm
vendored
Normal file
191
database/perl/vendor/lib/MooseX/Types/Util.pm
vendored
Normal file
@@ -0,0 +1,191 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
package MooseX::Types::Util;
|
||||
# ABSTRACT: Common utility functions for the distribution
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use Scalar::Util 'blessed';
|
||||
use base 'Exporter';
|
||||
use namespace::autoclean;
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod This package the exportable functions that many parts in
|
||||
#pod L<MooseX::Types> might need.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
our @EXPORT_OK = qw( filter_tags has_available_type_export );
|
||||
|
||||
#pod =head1 FUNCTIONS
|
||||
#pod
|
||||
#pod =head2 filter_tags
|
||||
#pod
|
||||
#pod Takes a list and returns two references. The first is a hash reference
|
||||
#pod containing the tags as keys and the number of their appearance as values.
|
||||
#pod The second is an array reference containing all other elements.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub filter_tags {
|
||||
my (@list) = @_;
|
||||
my (%tags, @other);
|
||||
for (@list) {
|
||||
if (/^:(.*)$/) {
|
||||
$tags{ $1 }++;
|
||||
next;
|
||||
}
|
||||
push @other, $_;
|
||||
}
|
||||
return \%tags, \@other;
|
||||
}
|
||||
|
||||
#pod =head2 has_available_type_export
|
||||
#pod
|
||||
#pod TypeConstraint | Undef = has_available_type_export($package, $name);
|
||||
#pod
|
||||
#pod This function allows you to introspect if a given type export is available
|
||||
#pod I<at this point in time>. This means that the C<$package> must have imported
|
||||
#pod a type constraint with the name C<$name>, and it must be still in its symbol
|
||||
#pod table.
|
||||
#pod
|
||||
#pod Two arguments are expected:
|
||||
#pod
|
||||
#pod =over 4
|
||||
#pod
|
||||
#pod =item $package
|
||||
#pod
|
||||
#pod The name of the package to introspect.
|
||||
#pod
|
||||
#pod =item $name
|
||||
#pod
|
||||
#pod The name of the type export to introspect.
|
||||
#pod
|
||||
#pod =back
|
||||
#pod
|
||||
#pod B<Note> that the C<$name> is the I<exported> name of the type, not the declared
|
||||
#pod one. This means that if you use L<Sub::Exporter>s functionality to rename an import
|
||||
#pod like this:
|
||||
#pod
|
||||
#pod use MyTypes Str => { -as => 'MyStr' };
|
||||
#pod
|
||||
#pod you would have to introspect this type like this:
|
||||
#pod
|
||||
#pod has_available_type_export $package, 'MyStr';
|
||||
#pod
|
||||
#pod The return value will be either the type constraint that belongs to the export
|
||||
#pod or an undefined value.
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub has_available_type_export {
|
||||
my ($package, $name) = @_;
|
||||
|
||||
my $sub = $package->can($name)
|
||||
or return undef;
|
||||
|
||||
return undef
|
||||
unless blessed $sub && $sub->isa('MooseX::Types::EXPORTED_TYPE_CONSTRAINT');
|
||||
|
||||
return $sub->();
|
||||
}
|
||||
|
||||
#pod =head1 SEE ALSO
|
||||
#pod
|
||||
#pod L<MooseX::Types::Moose>, L<Exporter>
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::Util - Common utility functions for the distribution
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package the exportable functions that many parts in
|
||||
L<MooseX::Types> might need.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 filter_tags
|
||||
|
||||
Takes a list and returns two references. The first is a hash reference
|
||||
containing the tags as keys and the number of their appearance as values.
|
||||
The second is an array reference containing all other elements.
|
||||
|
||||
=head2 has_available_type_export
|
||||
|
||||
TypeConstraint | Undef = has_available_type_export($package, $name);
|
||||
|
||||
This function allows you to introspect if a given type export is available
|
||||
I<at this point in time>. This means that the C<$package> must have imported
|
||||
a type constraint with the name C<$name>, and it must be still in its symbol
|
||||
table.
|
||||
|
||||
Two arguments are expected:
|
||||
|
||||
=over 4
|
||||
|
||||
=item $package
|
||||
|
||||
The name of the package to introspect.
|
||||
|
||||
=item $name
|
||||
|
||||
The name of the type export to introspect.
|
||||
|
||||
=back
|
||||
|
||||
B<Note> that the C<$name> is the I<exported> name of the type, not the declared
|
||||
one. This means that if you use L<Sub::Exporter>s functionality to rename an import
|
||||
like this:
|
||||
|
||||
use MyTypes Str => { -as => 'MyStr' };
|
||||
|
||||
you would have to introspect this type like this:
|
||||
|
||||
has_available_type_export $package, 'MyStr';
|
||||
|
||||
The return value will be either the type constraint that belongs to the export
|
||||
or an undefined value.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<MooseX::Types::Moose>, L<Exporter>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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
|
||||
95
database/perl/vendor/lib/MooseX/Types/Wrapper.pm
vendored
Normal file
95
database/perl/vendor/lib/MooseX/Types/Wrapper.pm
vendored
Normal file
@@ -0,0 +1,95 @@
|
||||
package MooseX::Types::Wrapper;
|
||||
# ABSTRACT: Wrap exports from a library
|
||||
|
||||
our $VERSION = '0.50';
|
||||
|
||||
use Moose;
|
||||
use Carp::Clan qw( ^MooseX::Types );
|
||||
use Module::Runtime 'use_module';
|
||||
|
||||
use namespace::autoclean;
|
||||
|
||||
extends 'MooseX::Types';
|
||||
|
||||
#pod =head1 DESCRIPTION
|
||||
#pod
|
||||
#pod See L<MooseX::Types/SYNOPSIS> for detailed usage.
|
||||
#pod
|
||||
#pod =head1 METHODS
|
||||
#pod
|
||||
#pod =head2 import
|
||||
#pod
|
||||
#pod =cut
|
||||
|
||||
sub import {
|
||||
my ($class, @args) = @_;
|
||||
my %libraries = @args == 1 ? (Moose => $args[0]) : @args;
|
||||
|
||||
for my $l (keys %libraries) {
|
||||
|
||||
croak qq($class expects an array reference as import spec)
|
||||
unless ref $libraries{ $l } eq 'ARRAY';
|
||||
|
||||
my $library_class
|
||||
= ($l eq 'Moose' ? 'MooseX::Types::Moose' : $l );
|
||||
use_module($library_class);
|
||||
|
||||
$library_class->import({
|
||||
-into => scalar(caller),
|
||||
-wrapper => $class,
|
||||
}, @{ $libraries{ $l } });
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
MooseX::Types::Wrapper - Wrap exports from a library
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.50
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
See L<MooseX::Types/SYNOPSIS> for detailed usage.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 import
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<MooseX::Types>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=MooseX-Types>
|
||||
(or L<bug-MooseX-Types@rt.cpan.org|mailto:bug-MooseX-Types@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
|
||||
|
||||
Robert "phaylon" Sedlacek <rs@474.at>
|
||||
|
||||
=head1 COPYRIGHT AND LICENCE
|
||||
|
||||
This software is copyright (c) 2007 by Robert "phaylon" Sedlacek.
|
||||
|
||||
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