package Mouse::Util;
use strict;
use warnings;
-use base 'Exporter';
-
+use base qw/Exporter/;
+use Carp;
+
+our @EXPORT_OK = qw(
+ blessed
+ get_linear_isa
+ looks_like_number
+ openhandle
+ reftype
+ weaken
+);
+our %EXPORT_TAGS = (
+ all => \@EXPORT_OK,
+);
+
+# We only have to do this nastiness if we haven't loaded XS version of
+# Mouse.pm, so check if we're running under PurePerl or not
BEGIN {
our %dependencies = (
'Scalar::Util' => {
},
# ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
},
-# VVVVV CODE TAKEN FROM TEST::EXCEPTION VVVVV
- 'Test::Exception' => do {
-
- my $Tester;
-
- my $is_exception = sub {
- my $exception = shift;
- return ref $exception || $exception ne '';
- };
-
- my $exception_as_string = sub {
- my ( $prefix, $exception ) = @_;
- return "$prefix normal exit" unless $is_exception->( $exception );
- my $class = ref $exception;
- $exception = "$class ($exception)"
- if $class && "$exception" !~ m/^\Q$class/;
- chomp $exception;
- return "$prefix $exception";
- };
- my $try_as_caller = sub {
- my $coderef = shift;
- eval { $coderef->() };
- $@;
- };
-
- {
- 'throws_ok' => sub (&$;$) {
- my ( $coderef, $expecting, $description ) = @_;
- Carp::croak "throws_ok: must pass exception class/object or regex"
- unless defined $expecting;
- $description = $exception_as_string->( "threw", $expecting )
- unless defined $description;
- my $exception = $try_as_caller->($coderef);
-
- $Tester ||= Test::Builder->new;
-
- my $regex = $Tester->maybe_regex( $expecting );
- my $ok = $regex
- ? ( $exception =~ m/$regex/ )
- : eval {
- $exception->isa( ref $expecting ? ref $expecting : $expecting )
- };
- $Tester->ok( $ok, $description );
- unless ( $ok ) {
- $Tester->diag( $exception_as_string->( "expecting:", $expecting ) );
- $Tester->diag( $exception_as_string->( "found:", $exception ) );
- };
- $@ = $exception;
- return $ok;
- },
- 'lives_ok' => sub (&;$) {
- my ( $coderef, $description ) = @_;
- my $exception = $try_as_caller->( $coderef );
-
- $Tester ||= Test::Builder->new;
-
- my $ok = $Tester->ok( ! $is_exception->( $exception ), $description );
- $Tester->diag( $exception_as_string->( "died:", $exception ) ) unless $ok;
- $@ = $exception;
- return $ok;
- },
- },
- },
);
our %loaded;
our @EXPORT_OK = map { keys %$_ } values %dependencies;
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
- test => [qw/throws_ok lives_ok/],
+ test => [qw/throws_ok lives_ok dies_ok/],
);
- for my $module_name (keys %dependencies) {
+ for my $module (keys %dependencies) {
+ my ($module_name, $version) = split ' ', $module;
+
my $loaded = do {
local $SIG{__DIE__} = 'DEFAULT';
- eval "require $module_name; 1";
+ eval "use $module (); 1";
};
$loaded{$module_name} = $loaded;
- for my $method_name (keys %{ $dependencies{ $module_name } }) {
- my $producer = $dependencies{$module_name}{$method_name};
+ for my $method_name (keys %{ $dependencies{ $module } }) {
+ my $producer = $dependencies{$module}{$method_name};
my $implementation;
if (ref($producer) eq 'HASH') {
}
}
+sub apply_all_roles {
+ my $meta = Mouse::Meta::Class->initialize(shift);
+
+ my @roles;
+ my $max = scalar(@_);
+ for (my $i = 0; $i < $max ; $i++) {
+ if ($i + 1 < $max && ref($_[$i + 1])) {
+ push @roles, [ $_[$i++] => $_[$i] ];
+ } else {
+ push @roles, [ $_[$i] => {} ];
+ }
+ }
+
+ foreach my $role_spec (@roles) {
+ Mouse::load_class( $role_spec->[0] );
+ }
+
+ ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
+ || croak("You can only consume roles, "
+ . $_->[0]
+ . " is not a Moose role")
+ foreach @roles;
+
+ if ( scalar @roles == 1 ) {
+ my ( $role, $params ) = @{ $roles[0] };
+ $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
+ }
+ else {
+ Mouse::Meta::Role->combine_apply($meta, @roles);
+ }
+
+}
+
1;
__END__