r42370 - in /branches/upstream/libmoosex-traits-perl/current: Changes MANIFEST META.yml Makefile.PL README lib/MooseX/Traits.pm lib/MooseX/Traits/ lib/MooseX/Traits/Util.pm t/basic.t t/class.t t/parameterized.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Aug 21 22:35:28 UTC 2009
Author: jawnsy-guest
Date: Fri Aug 21 22:35:22 2009
New Revision: 42370
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=42370
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-traits-perl (0.07)
Added:
branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits/
branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits/Util.pm
branches/upstream/libmoosex-traits-perl/current/t/class.t
branches/upstream/libmoosex-traits-perl/current/t/parameterized.t
Modified:
branches/upstream/libmoosex-traits-perl/current/Changes
branches/upstream/libmoosex-traits-perl/current/MANIFEST
branches/upstream/libmoosex-traits-perl/current/META.yml
branches/upstream/libmoosex-traits-perl/current/Makefile.PL
branches/upstream/libmoosex-traits-perl/current/README
branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits.pm
branches/upstream/libmoosex-traits-perl/current/t/basic.t
Modified: branches/upstream/libmoosex-traits-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/Changes?rev=42370&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/Changes (original)
+++ branches/upstream/libmoosex-traits-perl/current/Changes Fri Aug 21 22:35:22 2009
@@ -1,3 +1,8 @@
+0.07 Sun Aug 16 10:38:47 CDT 2009
+ - deprecate apply_traits ("no warnings" to disable warning)
+ - add MooseX::Traits::Util so that other modules can resolve trait names
+ - add new_class_with_traits util function to create classes with traits
+
0.06 Mon Jun 29 00:30:58 CEST 2009
- use "is => bare" on newer moosen (Closes: RT#47011) (hdp)
- depend on a Moose version that provides
Modified: branches/upstream/libmoosex-traits-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/MANIFEST?rev=42370&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-traits-perl/current/MANIFEST Fri Aug 21 22:35:22 2009
@@ -9,6 +9,7 @@
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/MooseX/Traits.pm
+lib/MooseX/Traits/Util.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
@@ -18,4 +19,6 @@
t/author/pod-coverage.t
t/author/pod.t
t/basic.t
+t/class.t
+t/parameterized.t
t/subclass.t
Modified: branches/upstream/libmoosex-traits-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/META.yml?rev=42370&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-traits-perl/current/META.yml Fri Aug 21 22:35:22 2009
@@ -25,6 +25,8 @@
Class::MOP: 0.84
Moose: 0.84
Moose::Role: 0
+ Sub::Exporter: 0
+ namespace::autoclean: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.06
+version: 0.07
Modified: branches/upstream/libmoosex-traits-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/Makefile.PL?rev=42370&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/Makefile.PL (original)
+++ branches/upstream/libmoosex-traits-perl/current/Makefile.PL Fri Aug 21 22:35:22 2009
@@ -6,6 +6,8 @@
requires 'Class::MOP' => '0.84';
requires 'Moose' => '0.84';
requires 'Moose::Role';
+requires 'Sub::Exporter';
+requires 'namespace::autoclean';
build_requires 'Moose';
build_requires 'Test::Exception';
Modified: branches/upstream/libmoosex-traits-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/README?rev=42370&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/README (original)
+++ branches/upstream/libmoosex-traits-perl/current/README Fri Aug 21 22:35:22 2009
@@ -1,105 +1,0 @@
-NAME
- MooseX::Traits - automatically apply roles at object creation time
-
-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 "new" time:
-
- my $class = Class->new_with_traits( traits => ['Role'], foo => 42 );
-
- Then use your customized class:
-
- $class->isa('Class'); # true
- $class->does('Role'); # true
- $class->foo; # 42
-
- To apply traits to an existing instance:
-
- $self->apply_traits([qw/Role1 Role2/], { rebless_params => 'go here' });
-
-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 applying roles to the instance one-by-one,
- he can just pass a "traits" parameter to the class's "new_with_traits"
- constructor. This role will then apply the roles in one go, cache the
- resulting class (for efficiency), and return a new instance. Arguments
- meant to initialize the applied roles' attributes can also be passed to
- the constructor.
-
- Alternatively, traits can be applied to an instance with "apply_traits",
- arguments for initializing attributes in consumed roles can be in %$self
- (useful for e.g. Catalyst components.)
-
-METHODS
- $class->new_with_traits(%args, traits => \@traits)
- "new_with_traits" can also take a hashref, e.g.:
-
- my $instance = $class->new_with_traits({ traits => \@traits, foo => 'bar' });
-
- $instance->apply_traits($trait => \%args)
- $instance->apply_traits(\@traits => \%args)
-
-ATTRIBUTES YOUR CLASS GETS
- This role will add the following attributes to the consuming class.
-
- _trait_namespace
- You can override the value of this attribute with "default" to
- automatically prepend a namespace to the supplied traits. (This can be
- overridden by prefixing the trait name with "+".)
-
- 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
-
-AUTHOR
- Jonathan Rockway "<jrockway at cpan.org>"
-
- Stevan Little "<stevan.little at iinteractive.com>"
-
- Rafael Kitover "<rkitover at cpan.org>"
-
-COPYRIGHT AND LICENSE
- Copyright 2008 Infinity Interactive, Inc.
-
- <http://www.iinteractive.com>
-
- This library is free software; you can redistribute it and/or modify it
- under the same terms as Perl itself.
-
Modified: branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits.pm?rev=42370&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits.pm Fri Aug 21 22:35:22 2009
@@ -1,7 +1,14 @@
package MooseX::Traits;
use Moose::Role;
-our $VERSION = '0.06';
+use MooseX::Traits::Util qw(new_class_with_traits);
+
+use warnings;
+use warnings::register;
+
+use namespace::autoclean;
+
+our $VERSION = '0.07';
our $AUTHORITY = 'id:JROCKWAY';
has '_trait_namespace' => (
@@ -10,35 +17,6 @@
isa => 'Str',
is => 'bare',
);
-
-# note: "$class" throughout is "class name" or "instance of class
-# name"
-
-my $transform_trait = sub {
- my ($class, $name) = @_;
- 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 $1 if $name =~ /^[+](.+)$/;
- return join '::', $base, $name;
-};
-
-my $resolve_traits = sub {
- my ($class, @traits) = @_;
-
- return map {
- my $transformed = $class->$transform_trait($_);
- Class::MOP::load_class($transformed);
- $transformed;
- } @traits;
-};
sub new_with_traits {
my $class = shift;
@@ -51,37 +29,38 @@
%args = @_;
}
- if (my $traits = delete $args{traits}) {
- if(@$traits){
- $traits = [$class->$resolve_traits(@$traits)];
+ my $new_class = new_class_with_traits($class, @{ delete $args{traits} || [] });
- my $meta = $class->meta->create_anon_class(
- superclasses => [ $class->meta->name ],
- roles => $traits,
- cache => 1,
- );
-
- $meta->add_method('meta' => sub { $meta });
- $class = $meta->name;
- }
- }
-
- my $constructor = $class->meta->constructor_name;
- confess "$class does not have a constructor defined via the MOP?"
+ my $constructor = $new_class->constructor_name;
+ confess "$class ($new_class) does not have a constructor defined via the MOP?"
if !$constructor;
- return $class->$constructor($hashref ? \%args : %args);
+ return $new_class->name->$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.
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 = $self->$resolve_traits(@traits);
+ @traits = MooseX::Traits::Util::resolve_traits(
+ $self, @traits,
+ );
for my $trait (@traits){
$trait->meta->apply($self, rebless_params => $rebless_params || {});
@@ -153,10 +132,6 @@
my $instance = $class->new_with_traits({ traits => \@traits, foo => 'bar' });
-=item B<< $instance->apply_traits($trait => \%args) >>
-
-=item B<< $instance->apply_traits(\@traits => \%args) >>
-
=back
=head1 ATTRIBUTES YOUR CLASS GETS
@@ -203,8 +178,6 @@
Stevan Little C<< <stevan.little at iinteractive.com> >>
-Rafael Kitover C<< <rkitover at cpan.org> >>
-
=head1 COPYRIGHT AND LICENSE
Copyright 2008 Infinity Interactive, Inc.
Added: branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits/Util.pm?rev=42370&op=file
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits/Util.pm (added)
+++ branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits/Util.pm Fri Aug 21 22:35:22 2009
@@ -1,0 +1,78 @@
+package MooseX::Traits::Util;
+use strict;
+use warnings;
+
+use Sub::Exporter -setup => {
+ exports => ['new_class_with_traits'],
+};
+
+use Carp qw(confess);
+
+# note: "$class" throughout is "class name" or "instance of class
+# name"
+
+sub check_class {
+ my $class = shift;
+
+ 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) = @_;
+
+ 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 $1 if $name =~ /^[+](.+)$/;
+ 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::MOP::load_class($transformed);
+ $transformed;
+ }
+ else {
+ $orig;
+ }
+ } @traits;
+}
+
+sub new_class_with_traits {
+ my ($class, @traits) = @_;
+
+ check_class($class);
+
+ my $meta;
+ @traits = resolve_traits($class, @traits);
+ if (@traits) {
+ $meta = $class->meta->create_anon_class(
+ superclasses => [ $class->meta->name ],
+ roles => \@traits,
+ cache => 1,
+ );
+ $meta->add_method('meta' => sub { $meta });
+ }
+
+ # if no traits were given just return the class meta
+ return $meta ? $meta : $class->meta;
+}
+
+1;
Modified: branches/upstream/libmoosex-traits-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/t/basic.t?rev=42370&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/t/basic.t (original)
+++ branches/upstream/libmoosex-traits-perl/current/t/basic.t Fri Aug 21 22:35:22 2009
@@ -2,6 +2,8 @@
use warnings;
use Test::More tests => 34;
use Test::Exception;
+
+use MooseX::Traits; # for "no warnings ..."
{ package Trait;
use Moose::Role;
@@ -77,7 +79,11 @@
is $instance->bar, 'bar';
}
+# deprecated features! do not use!
+
{
+ no warnings 'MooseX::Traits';
+
my $instance = Class->new;
isa_ok $instance, 'Class';
ok !$instance->can('foo');
@@ -92,6 +98,8 @@
}
{
+ no warnings 'MooseX::Traits';
+
my $instance = Class->new;
isa_ok $instance, 'Class';
ok !$instance->can('foo');
Added: branches/upstream/libmoosex-traits-perl/current/t/class.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/t/class.t?rev=42370&op=file
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/t/class.t (added)
+++ branches/upstream/libmoosex-traits-perl/current/t/class.t Fri Aug 21 22:35:22 2009
@@ -1,0 +1,54 @@
+use strict;
+use warnings;
+use Test::More tests => 6;
+use Test::Exception;
+
+use MooseX::Traits; # for "no warnings ..."
+
+{ package Trait;
+ use Moose::Role;
+ has 'foo' => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+ );
+
+ package Class;
+ use Moose;
+ with 'MooseX::Traits';
+
+ 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' );
+
+}
+
+use MooseX::Traits::Util qw(new_class_with_traits);
+
+dies_ok {
+ new_class_with_traits( 'OH NOES', 'Foo' );
+} ' NOES is not a MX::Traits class';
+
+dies_ok {
+ new_class_with_traits( 'Moose::Meta::Class', 'Foo' );
+} 'Moose::Meta::Class is not a MX::Traits class';
+
+my $class;
+lives_ok {
+ $class = new_class_with_traits( 'Class' => 'Trait', 'Another::Trait' );
+} 'new_class_with_traits works';
+
+ok $class;
+
+my $instance = $class->name->new( foo => '42', bar => '24' );
+is $instance->foo, 42;
+is $instance->bar, 24;
Added: branches/upstream/libmoosex-traits-perl/current/t/parameterized.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/t/parameterized.t?rev=42370&op=file
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/t/parameterized.t (added)
+++ branches/upstream/libmoosex-traits-perl/current/t/parameterized.t Fri Aug 21 22:35:22 2009
@@ -1,0 +1,99 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ plan 'skip_all', 'testing parameterized roles requires MooseX::Role::Parameterized'
+ unless eval 'require MooseX::Role::Parameterized; 1';
+
+ plan tests => 11;
+}
+
+{
+ package Role;
+ use Moose::Role;
+
+ has 'gorge' => (
+ is => 'ro',
+ required => 1,
+ );
+}
+
+{
+ package PRole;
+ use MooseX::Role::Parameterized;
+
+ parameter 'foo' => (
+ is => 'ro',
+ required => 1,
+ );
+
+ role {
+ my $p = shift;
+
+ has $p->foo => (
+ is => 'ro',
+ required => 1,
+ );
+ }
+}
+
+{
+ package Class;
+ use Moose;
+
+ with 'MooseX::Traits';
+}
+
+lives_ok {
+ Class->new;
+} 'making class is OK';
+
+lives_ok {
+ Class->new_with_traits;
+} 'making class with no traits is OK';
+
+my $a;
+
+lives_ok {
+ $a = Class->new_with_traits(
+ traits => ['PRole' => { foo => 'OHHAI' }],
+ OHHAI => 'I FIXED THAT FOR YOU',
+ );
+} 'prole is applied OK';
+
+isa_ok $a, 'Class';
+is $a->OHHAI, 'I FIXED THAT FOR YOU', 'OHHAI accessor works';
+
+lives_ok {
+ undef $a;
+ $a = Class->new_with_traits(
+ traits => ['PRole' => { foo => 'OHHAI' }, 'Role'],
+ OHHAI => 'I FIXED THAT FOR YOU',
+ gorge => 'three rivers',
+ );
+} 'prole is applied OK along with a normal role';
+
+can_ok $a, 'OHHAI', 'gorge';
+
+lives_ok {
+ undef $a;
+ $a = Class->new_with_traits(
+ traits => ['Role', 'PRole' => { foo => 'OHHAI' }],
+ OHHAI => 'I FIXED THAT FOR YOU',
+ gorge => 'columbia river',
+ );
+} 'prole is applied OK along with a normal role (2)';
+
+can_ok $a, 'OHHAI', 'gorge';
+
+lives_ok {
+ undef $a;
+ $a = Class->new_with_traits(
+ traits => ['Role' => { bullshit => 'params', go => 'here' }],
+ gorge => 'i should have just called this foo',
+ );
+} 'regular roles with args can be applied, but args are ignored';
+
+can_ok $a, 'gorge';
More information about the Pkg-perl-cvs-commits
mailing list