r55601 - in /branches/upstream/libmoosex-traits-perl/current: ./ inc/Module/ inc/Module/Install/ lib/MooseX/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Apr 7 14:54:43 UTC 2010
Author: jawnsy-guest
Date: Wed Apr 7 14:54:35 2010
New Revision: 55601
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=55601
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-traits-perl (0.09)
Added:
branches/upstream/libmoosex-traits-perl/current/README
branches/upstream/libmoosex-traits-perl/current/t/with-traits.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/inc/Module/Install.pm
branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Base.pm
branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Can.pm
branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Fetch.pm
branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Makefile.pm
branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Metadata.pm
branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Win32.pm
branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/WriteAll.pm
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=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/Changes (original)
+++ branches/upstream/libmoosex-traits-perl/current/Changes Wed Apr 7 14:54:35 2010
@@ -1,3 +1,7 @@
+0.09 Tue Apr 6 22:51:40 CDT 2010
+ - Class->with_traits(...)->new is now preferred over
+ Class->new_with_traits(...).
+
0.08 Sat Feb 13 17:05:23 GMT 2010
- Allow you to pass traits => 'OneTrait' rather than having to say
traits => ['OneTrait'] to help when getting traits from things that
Modified: branches/upstream/libmoosex-traits-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/MANIFEST?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-traits-perl/current/MANIFEST Wed Apr 7 14:54:35 2010
@@ -13,6 +13,7 @@
MANIFEST This list of files
MANIFEST.SKIP
META.yml
+README
t/00-load.t
t/author/pod-coverage.t
t/author/pod.t
@@ -20,3 +21,4 @@
t/class.t
t/parameterized.t
t/subclass.t
+t/with-traits.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=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-traits-perl/current/META.yml Wed Apr 7 14:54:35 2010
@@ -1,7 +1,7 @@
---
abstract: 'automatically apply roles at object creation time'
author:
- - 'Jonathan Rockway C<< <jrockway at cpan.org> >>'
+ - 'and CONTRIBUTORS'
build_requires:
ExtUtils::MakeMaker: 6.42
Moose: 0
@@ -11,7 +11,7 @@
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.910'
+generated_by: 'Module::Install version 0.92'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -29,4 +29,4 @@
namespace::autoclean: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.08
+version: 0.09
Added: branches/upstream/libmoosex-traits-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/README?rev=55601&op=file
==============================================================================
(empty)
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install.pm Wed Apr 7 14:54:35 2010
@@ -28,7 +28,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.91';
+ $VERSION = '0.92';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -348,17 +348,24 @@
return $call;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
sub _readperl {
my $string = Module::Install::_read($_[0]);
@@ -379,18 +386,26 @@
return $string;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
@@ -427,4 +442,4 @@
1;
-# Copyright 2008 - 2009 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Base.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Base.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Base.pm Wed Apr 7 14:54:35 2010
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
}
# Suspend handler for "redefined" warnings
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Can.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Can.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Can.pm Wed Apr 7 14:54:35 2010
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Fetch.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Fetch.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Fetch.pm Wed Apr 7 14:54:35 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Makefile.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Makefile.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Makefile.pm Wed Apr 7 14:54:35 2010
@@ -7,7 +7,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -34,6 +34,17 @@
}
}
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
sub makemaker_args {
my $self = shift;
my $args = ( $self->{makemaker_args} ||= {} );
@@ -44,7 +55,7 @@
# For mm args that take multiple space-seperated args,
# append an argument to the current list.
sub makemaker_append {
- my $self = sShift;
+ my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{name} = defined $args->{$name}
@@ -130,12 +141,13 @@
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
- $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
+ $self->build_requires( 'ExtUtils::MakeMaker' => $v );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
}
@@ -152,42 +164,62 @@
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
+ if ( $self->makemaker(6.10) ) {
$args->{NO_META} = 1;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
- # Merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
- map { @$_ }
+ map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
- ($self->configure_requires, $self->build_requires, $self->requires)
+ ($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
- # merge both kinds of requires into prereq_pm
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
foreach my $bundle (@{ $self->bundles }) {
my ($file, $dir) = @$bundle;
push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
+ delete $build_prereq->{$file}; #Delete from build prereqs only
}
+ }
+
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
}
$args->{INSTALLDIRS} = $self->installdirs;
@@ -265,4 +297,4 @@
__END__
-#line 394
+#line 426
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Metadata.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Metadata.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Metadata.pm Wed Apr 7 14:54:35 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -230,6 +230,8 @@
die("The path '$file' does not exist, or is not a file");
}
+ $self->{values}{all_from} = $file;
+
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
@@ -385,11 +387,10 @@
}
}
-sub perl_version_from {
- my $self = shift;
+sub _extract_perl_version {
if (
- Module::Install::_read($_[0]) =~ m/
- ^
+ $_[0] =~ m/
+ ^\s*
(?:use|require) \s*
v?
([\d_\.]+)
@@ -398,6 +399,16 @@
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
@@ -425,13 +436,12 @@
}
}
-sub license_from {
- my $self = shift;
+sub _extract_license {
if (
- Module::Install::_read($_[0]) =~ m/
+ $_[0] =~ m/
(
=head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
+ (?:licen[cs]e|licensing|copyrights?|legal)\b
.*?
)
(=head\\d.*|=cut.*|)
@@ -439,7 +449,8 @@
/ixms ) {
my $license_text = $1;
my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
+ 'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
@@ -456,20 +467,32 @@
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
+ $pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
- $self->license($license);
- return 1;
+ return $license;
}
}
- }
-
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
+ } else {
+ return;
+ }
+}
+
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
}
sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ my @links = $_[0] =~ m#L<(
+ \Qhttp://rt.cpan.org/\E[^>]+|
+ \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
+ \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
my %links;
@links{@links}=();
@links=keys %links;
@@ -485,7 +508,7 @@
return 0;
}
if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
+ warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Win32.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Win32.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/Win32.pm Wed Apr 7 14:54:35 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.92';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/WriteAll.pm?rev=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/WriteAll.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/inc/Module/Install/WriteAll.pm Wed Apr 7 14:54:35 2010
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';;
+ $VERSION = '0.92';;
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
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=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits.pm (original)
+++ branches/upstream/libmoosex-traits-perl/current/lib/MooseX/Traits.pm Wed Apr 7 14:54:35 2010
@@ -8,7 +8,7 @@
use namespace::autoclean;
-our $VERSION = '0.08';
+our $VERSION = '0.09';
our $AUTHORITY = 'id:JROCKWAY';
has '_trait_namespace' => (
@@ -18,6 +18,18 @@
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;
@@ -30,13 +42,15 @@
}
my $traits = delete $args{traits} || [];
- my $new_class = new_class_with_traits($class, @{ ref($traits) ? $traits : [ $traits ] } );
-
- my $constructor = $new_class->constructor_name;
+
+ 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->name->$constructor($hashref ? \%args : %args);
+ return $new_class->$constructor($hashref ? \%args : %args);
+
}
# this code is broken and should never have been added. i probably
@@ -95,7 +109,7 @@
Apply the roles to the class at C<new> time:
- my $class = Class->new_with_traits( traits => ['Role'], foo => 42 );
+ my $class = Class->with_traits('Role')->new( foo => 42 );
Then use your customized class:
@@ -103,29 +117,41 @@
$class->does('Role'); # true
$class->foo; # 42
-To apply traits to an existing instance:
-
- $self->apply_traits([qw/Role1 Role2/], { rebless_params => 'go here' });
-
=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 applying roles to the instance
-one-by-one, he can just pass a C<traits> parameter to the class's
-C<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 C<apply_traits>,
-arguments for initializing attributes in consumed roles can be in C<%$self>
-(useful for e.g. L<Catalyst> components.)
+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 compatability
+reasons. It accepts a C<traits> parameter, creates a new class with
+those traits, and then insantiates 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.
=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) >>
@@ -173,11 +199,25 @@
$instance2->does('Trait') # true
$instance2->does('Another::Trait') # false
-=head1 AUTHOR
+=head1 AUTHORS and CONTRIBUTORS
Jonathan Rockway C<< <jrockway at cpan.org> >>
Stevan Little C<< <stevan.little at iinteractive.com> >>
+
+Tomas Doran C<< <bobtfish at bobtfish.net> >>
+
+Matt S. Trout C<< <mst at shadowcatsystems.co.uk> >>
+
+Jesse Luehrs C<< <doy at tozt dot net> >>
+
+Shawn Moore C<< <sartak at bestpractical.com> >>
+
+Florian Ragwitz C<< <rafl at debian.org> >>
+
+Chris Prather C<< <chris at prather.org> >>
+
+Yuval Kogman C<< <nothingmuch at woobling.org> >>
=head1 COPYRIGHT AND LICENSE
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=55601&op=diff
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/t/basic.t (original)
+++ branches/upstream/libmoosex-traits-perl/current/t/basic.t Wed Apr 7 14:54:35 2010
@@ -1,9 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 37;
+use Test::More;
use Test::Exception;
-
-use MooseX::Traits; # for "no warnings ..."
{ package Trait;
use Moose::Role;
@@ -40,37 +38,36 @@
}
throws_ok {
- Class->new_with_traits( traits => ['Trait'] );
+ Class->with_traits('Trait')->new;
} qr/required/, 'foo is required';
{
- my $instance = Class->new_with_traits;
+ my $instance = Class->with_traits->new;
isa_ok $instance, 'Class';
ok !$instance->can('foo'), 'this one cannot foo';
}
{
- my $instance = Class->new_with_traits( traits => [] );
+ my $instance = Class->with_traits()->new;
isa_ok $instance, 'Class';
ok !$instance->can('foo'), 'this one cannot foo either';
}
{
- my $instance = Another::Class->new_with_traits( traits => ['Trait'], bar => 'bar' );
+ my $instance = Another::Class->with_traits( 'Trait' )->new( bar => 'bar' );
isa_ok $instance, 'Another::Class';
can_ok $instance, 'bar';
is $instance->bar, 'bar';
}
# try hashref form
{
- my $instance = Another::Class->new_with_traits({ traits => ['Trait'], bar => 'bar' });
+ my $instance = Another::Class->with_traits('Trait')->new({ bar => 'bar' });
isa_ok $instance, 'Another::Class';
can_ok $instance, 'bar';
is $instance->bar, 'bar';
}
{
- my $instance = Another::Class->new_with_traits(
- traits => ['Trait', '+Trait'],
- foo => 'foo',
- bar => 'bar',
+ my $instance = Another::Class->with_traits('Trait', '+Trait')->new(
+ foo => 'foo',
+ bar => 'bar',
);
isa_ok $instance, 'Another::Class';
can_ok $instance, 'foo';
@@ -79,40 +76,4 @@
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');
-
- lives_ok {
- $instance->apply_traits('Trait' => { foo => 'bar' } );
- };
-
- isa_ok $instance, 'Class';
- can_ok $instance, 'foo';
- is $instance->foo, 'bar';
-}
-
-{
- no warnings 'MooseX::Traits';
-
- my $instance = Class->new;
- isa_ok $instance, 'Class';
- ok !$instance->can('foo');
- ok !$instance->can('bar');
-
- lives_ok {
- $instance->apply_traits(['Trait', 'Another::Trait']
- => { foo => 'bar', bar => 'baz' } );
- };
-
- isa_ok $instance, 'Class';
- can_ok $instance, 'foo';
- can_ok $instance, 'bar';
- is $instance->foo, 'bar';
- is $instance->bar, 'baz';
-}
+done_testing;
Added: branches/upstream/libmoosex-traits-perl/current/t/with-traits.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-traits-perl/current/t/with-traits.t?rev=55601&op=file
==============================================================================
--- branches/upstream/libmoosex-traits-perl/current/t/with-traits.t (added)
+++ branches/upstream/libmoosex-traits-perl/current/t/with-traits.t Wed Apr 7 14:54:35 2010
@@ -1,0 +1,118 @@
+use strict;
+use warnings;
+use Test::More tests => 37;
+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' );
+
+}
+
+foreach my $trait ( 'Trait', ['Trait' ] ) {
+ my $instance = Class->new_with_traits( traits => $trait, foo => 'hello' );
+ isa_ok $instance, 'Class';
+ can_ok $instance, 'foo';
+ is $instance->foo, 'hello';
+}
+
+throws_ok {
+ Class->new_with_traits( traits => ['Trait'] );
+} qr/required/, 'foo is required';
+
+{
+ my $instance = Class->new_with_traits;
+ isa_ok $instance, 'Class';
+ ok !$instance->can('foo'), 'this one cannot foo';
+}
+{
+ my $instance = Class->new_with_traits( traits => [] );
+ isa_ok $instance, 'Class';
+ ok !$instance->can('foo'), 'this one cannot foo either';
+}
+{
+ my $instance = Another::Class->new_with_traits( traits => ['Trait'], bar => 'bar' );
+ isa_ok $instance, 'Another::Class';
+ can_ok $instance, 'bar';
+ is $instance->bar, 'bar';
+}
+# try hashref form
+{
+ my $instance = Another::Class->new_with_traits({ traits => ['Trait'], bar => 'bar' });
+ isa_ok $instance, 'Another::Class';
+ can_ok $instance, 'bar';
+ is $instance->bar, 'bar';
+}
+{
+ my $instance = Another::Class->new_with_traits(
+ traits => ['Trait', '+Trait'],
+ foo => 'foo',
+ bar => 'bar',
+ );
+ isa_ok $instance, 'Another::Class';
+ can_ok $instance, 'foo';
+ can_ok $instance, 'bar';
+ is $instance->foo, 'foo';
+ 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');
+
+ lives_ok {
+ $instance->apply_traits('Trait' => { foo => 'bar' } );
+ };
+
+ isa_ok $instance, 'Class';
+ can_ok $instance, 'foo';
+ is $instance->foo, 'bar';
+}
+
+{
+ no warnings 'MooseX::Traits';
+
+ my $instance = Class->new;
+ isa_ok $instance, 'Class';
+ ok !$instance->can('foo');
+ ok !$instance->can('bar');
+
+ lives_ok {
+ $instance->apply_traits(['Trait', 'Another::Trait']
+ => { foo => 'bar', bar => 'baz' } );
+ };
+
+ isa_ok $instance, 'Class';
+ can_ok $instance, 'foo';
+ can_ok $instance, 'bar';
+ is $instance->foo, 'bar';
+ is $instance->bar, 'baz';
+}
More information about the Pkg-perl-cvs-commits
mailing list