From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 20 Jul 2010 04:37:49 +0000 (-0500)
Subject: implement a with_traits helper function
X-Git-Tag: 1.09~49
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d26f567140084090bb1cc0ccec35b7d21d45cf7c;p=gitmo%2FMoose.git

implement a with_traits helper function
---

diff --git a/Changes b/Changes
index 62405bf..e7e2721 100644
--- a/Changes
+++ b/Changes
@@ -16,6 +16,8 @@ for, noteworthy changes.
     safety and leave these on. Reported by David Wheeler. RT #58310. (Dave
     Rolsky)
 
+  * New with_traits helper function in Moose::Util. (doy)
+
   [BUG FIXES]
 
   * Accessors will now not be inlined if the instance metaclass isn't
diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index c25eae6..115aa8f 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -18,6 +18,7 @@ my @exports = qw[
     search_class_by_role
     ensure_all_roles
     apply_all_roles
+    with_traits
     get_all_init_args
     get_all_attribute_values
     resolve_metatrait_alias
@@ -136,6 +137,16 @@ sub _apply_all_roles {
     }
 }
 
+sub with_traits {
+    my ($class, @roles) = @_;
+    return $class unless @roles;
+    return Moose::Meta::Class->create_anon_class(
+        superclasses => [$class],
+        roles        => \@roles,
+        cache        => 1,
+    )->name;
+}
+
 # instance deconstruction ...
 
 sub get_all_attribute_values {
@@ -345,6 +356,11 @@ each of which can be followed by an optional hash reference of options
 This function is similar to L</apply_all_roles>, but only applies roles that
 C<$applicant> does not already consume.
 
+=item B<with_traits($class_name, @role_names)>
+
+This function creates a new class from C<$class_name> with each of
+C<@role_names> applied. It returns the name of the new class.
+
 =item B<get_all_attribute_values($meta, $instance)>
 
 Returns a hash reference containing all of the C<$instance>'s
diff --git a/t/400_moose_util/009_with_traits.t b/t/400_moose_util/009_with_traits.t
new file mode 100644
index 0000000..e03a424
--- /dev/null
+++ b/t/400_moose_util/009_with_traits.t
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Moose;
+
+use Moose ();
+use Moose::Util qw(with_traits);
+
+{
+    package Foo;
+    use Moose;
+}
+
+{
+    package Foo::Role;
+    use Moose::Role;
+}
+
+{
+    package Foo::Role2;
+    use Moose::Role;
+}
+
+{
+    my $traited_class = with_traits('Foo', 'Foo::Role');
+    ok($traited_class->meta->is_anon_class, "we get an anon class");
+    isa_ok($traited_class, 'Foo');
+    does_ok($traited_class, 'Foo::Role');
+}
+
+{
+    my $traited_class = with_traits('Foo', 'Foo::Role', 'Foo::Role2');
+    ok($traited_class->meta->is_anon_class, "we get an anon class");
+    isa_ok($traited_class, 'Foo');
+    does_ok($traited_class, 'Foo::Role');
+    does_ok($traited_class, 'Foo::Role2');
+}
+
+{
+    my $traited_class = with_traits('Foo');
+    is($traited_class, 'Foo', "don't apply anything if we don't get any traits");
+}
+
+{
+    my $traited_class = with_traits('Foo', 'Foo::Role');
+    my $traited_class2 = with_traits('Foo', 'Foo::Role');
+    is($traited_class, $traited_class2, "get the same class back when passing the same roles");
+}
+
+done_testing;