From: gfx Date: Wed, 23 Sep 2009 03:40:08 +0000 (+0900) Subject: Fix init_meta and related stuff X-Git-Tag: 0.33~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=382b73403849d7883496723918c10acf129e3a9d Fix init_meta and related stuff --- diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 34108fb..44a0c7e 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -98,40 +98,29 @@ sub override { } sub init_meta { - # This used to be called as a function. This hack preserves - # backwards compatibility. - if ( $_[0] ne __PACKAGE__ ) { - return __PACKAGE__->init_meta( - for_class => $_[0], - base_class => $_[1], - metaclass => $_[2], - ); - } - shift; my %args = @_; my $class = $args{for_class} - or Carp::croak( - "Cannot call init_meta without specifying a for_class"); + or confess("Cannot call init_meta without specifying a for_class"); my $base_class = $args{base_class} || 'Mouse::Object'; my $metaclass = $args{metaclass} || 'Mouse::Meta::Class'; - Carp::croak("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.") + confess("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.") unless $metaclass->isa('Mouse::Meta::Class'); - + # make a subtype for each Mouse class Mouse::Util::TypeConstraints::class_type($class) unless Mouse::Util::TypeConstraints::find_type_constraint($class); my $meta = $metaclass->initialize($class); - $meta->superclasses($base_class) - unless $meta->superclasses; $meta->add_method(meta => sub{ - return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]); + return $metaclass->initialize(ref($_[0]) || $_[0]); }); + $meta->superclasses($base_class) + unless $meta->superclasses; return $meta; } @@ -159,7 +148,7 @@ sub import { return; } - Mouse->init_meta( + $class->init_meta( for_class => $caller, ); diff --git a/lib/Squirrel.pm b/lib/Squirrel.pm index 565a3e2..a9e4024 100644 --- a/lib/Squirrel.pm +++ b/lib/Squirrel.pm @@ -5,15 +5,17 @@ use warnings; sub _choose_backend { if ( $INC{"Moose.pm"} ) { return { + backend => 'Moose', import => \&Moose::import, unimport => \&Moose::unimport, - } + }; } else { require Mouse; return { + backend => 'Mouse', import => \&Mouse::import, unimport => \&Mouse::unimport, - } + }; } } @@ -24,18 +26,22 @@ sub _handlers { my $caller = caller(1); - $pkgs{$caller} = $class->_choose_backend - unless $pkgs{$caller}; + $pkgs{$caller} ||== $class->_choose_backend; } sub import { require Carp; Carp::carp("Squirrel is deprecated. Please use Any::Moose instead. It fixes a number of design problems that Squirrel has."); - goto $_[0]->_handlers->{import}; + + my $handlers = shift->_handlers; + unshift @_, $handlers->{backend}; + goto &{$handlers->{import}}; } sub unimport { - goto $_[0]->_handlers->{unimport}; + my $handlers = shift->_handlers; + unshift @_, $handlers->{backend}; + goto &{$handlers->{unimport}}; } 1; @@ -58,7 +64,7 @@ Squirrel - Use L, unless L is already loaded. =head1 DEPRECATION -L is being deprecated. L provides the same functionality, +L is deprecated. L provides the same functionality, but better. :) =head1 DESCRIPTION diff --git a/lib/Squirrel/Role.pm b/lib/Squirrel/Role.pm index 56a7b3c..4a0941b 100644 --- a/lib/Squirrel/Role.pm +++ b/lib/Squirrel/Role.pm @@ -2,39 +2,25 @@ package Squirrel::Role; use strict; use warnings; +use base qw(Squirrel); + sub _choose_backend { if ( $INC{"Moose/Role.pm"} ) { return { + backend => 'Moose::Role', import => \&Moose::Role::import, - unimport => defined &Moose::Role::unimport ? \&Moose::Role::unimport : sub {}, + unimport => \&Moose::Role::unimport, } - } else { + } + else { require Mouse::Role; return { + backend => 'Mouse::Role', import => \&Mouse::Role::import, unimport => \&Mouse::Role::unimport, } } } -my %pkgs; - -sub _handlers { - my $class = shift; - - my $caller = caller(1); - - $pkgs{$caller} = $class->_choose_backend - unless $pkgs{$caller}; -} - -sub import { - goto $_[0]->_handlers->{import}; -} - -sub unimport { - goto $_[0]->_handlers->{unimport}; -} - 1;