From: gfx Date: Mon, 26 Jul 2010 11:47:33 +0000 (+0900) Subject: Remove long deprecated methods in M::M::Attribute X-Git-Tag: 0.64~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2fbd75234412ce7d2fcfe2b32f6d76a01077b482;p=gitmo%2FMouse.git Remove long deprecated methods in M::M::Attribute --- diff --git a/Changes b/Changes index 67049de..a65cc3c 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,15 @@ Revision history for Mouse +0.64 + [BUG FIXES] + * Build failure on 5.13.3 + + [CHANGES] + * Illegal inheritance options for clone_and_inherit_options() + is now a black list, not a white list (Moose 1.09 feature) + * Remove long deprecated methods in Mouse::Meta::Attribute: + clone_parent, get_parent_args, canonicalize_args, create + 0.63 Tue Jul 20 19:26:30 2010 [CHANGES] * Resolve RT#59460: Test::Requires is not a required prerequisite unless diff --git a/lib/Mouse/Exporter.pm b/lib/Mouse/Exporter.pm index aae3bdf..e1b42b3 100644 --- a/lib/Mouse/Exporter.pm +++ b/lib/Mouse/Exporter.pm @@ -39,15 +39,10 @@ sub setup_import_methods{ export_to_level => sub { my($package, $level, undef, @args) = @_; # the third argument is redundant - - Carp::carp("$package->export_to_level has been deprecated." - ." Use $package->import({ into_level => LEVEL }) instead"); $package->import({ into_level => $level + 1 }, @args); }, export => sub { my($package, $into, @args) = @_; - Carp::carp("$package->export has been deprecated." - ." Use $package->import({ into => PACKAGE }) instead"); $package->import({ into => $into }, @args); }, ); diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index aa92e70..37973a0 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -52,11 +52,6 @@ sub new { my $args = $class->Mouse::Object::BUILDARGS(@_); - # XXX: for backward compatibility (with method modifiers) - if($class->can('canonicalize_args') != \&canonicalize_args){ - %{$args} = $class->canonicalize_args($name, %{$args}); - } - $class->_process_options($name, $args); $args->{name} = $name; @@ -135,27 +130,6 @@ sub interpolate_class{ return( $class, @traits ); } -sub canonicalize_args{ # DEPRECATED - #my($self, $name, %args) = @_; - my($self, undef, %args) = @_; - - Carp::cluck("$self->canonicalize_args has been deprecated." - . "Use \$self->_process_options instead."); - - return %args; -} - -sub create { # DEPRECATED - #my($self, $class, $name, %args) = @_; - my($self) = @_; - - Carp::cluck("$self->create has been deprecated." - . "Use \$meta->add_attribute and \$attr->install_accessors instead."); - - # noop - return $self; -} - sub _coerce_and_verify { #my($self, $value, $instance) = @_; my($self, $value) = @_; @@ -230,33 +204,6 @@ sub clone_and_inherit_options{ return $attribute_class->new($self->name, $args); } -sub clone_parent { # DEPRECATED - my $self = shift; - my $class = shift; - my $name = shift; - my %args = ($self->get_parent_args($class, $name), @_); - - Carp::cluck("$self->clone_parent has been deprecated." - . "Use \$meta->add_attribute and \$attr->install_accessors instead."); - - $self->clone_and_inherited_args($class, $name, %args); -} - -sub get_parent_args { # DEPRECATED - my $self = shift; - my $class = shift; - my $name = shift; - - for my $super ($class->linearized_isa) { - my $super_attr = $super->can("meta") && $super->meta->get_attribute($name) - or next; - return %{ $super_attr->_create_args }; - } - - $self->throw_error("Could not find an attribute by the name of '$name' to inherit from"); -} - - sub get_read_method { return $_[0]->reader || $_[0]->accessor } @@ -355,11 +302,6 @@ sub install_accessors{ } } - if($attribute->can('create') != \&create){ - # backword compatibility - $attribute->create($metaclass, $attribute->name, %{$attribute}); - } - return; } diff --git a/t/990_deprecated/044-attribute-metaclass.t b/t/990_deprecated/044-attribute-metaclass.t deleted file mode 100644 index 8a3eb9f..0000000 --- a/t/990_deprecated/044-attribute-metaclass.t +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 2; -use lib 't/lib'; - -do { - local $SIG{__WARN__} = sub{ $_[0] =~ /deprecated/ or warn @_ }; - - package MouseX::AttributeHelpers::Number; - use Mouse; - extends 'Mouse::Meta::Attribute'; - - sub create { - my ($self, @args) = @_; - my $attr = $self->SUPER::create(@args); - my %provides = %{$attr->{provides}}; - my $method_constructors = { - add => sub { - my ($attr, $name) = @_; - return sub { - $_[0]->$name( $_[0]->$name() + $_[1]) - }; - }, - }; - while (my ($name, $aliased) = each %provides) { - $attr->associated_class->add_method( - $aliased => $method_constructors->{$name}->($attr, $attr->name) - ); - } - return $attr; - }; - - around 'canonicalize_args' => sub { - my ($next, $self, $name, %args) = @_; - - %args = $next->($self, $name, %args); - $args{is} = 'rw' unless exists $args{is}; - - return %args; - }; - - package # hide me from search.cpan.org - Mouse::Meta::Attribute::Custom::Number; - sub register_implementation { 'MouseX::AttributeHelpers::Number' } - - 1; - - package Klass; - use Mouse; - - has 'number' => ( - metaclass => 'Number', - isa => 'Int', - provides => { - 'add' => 'add_number' - }, - ); -}; - -can_ok 'Klass', 'add_number', 'number'; -my $k = Klass->new(number => 3); -$k->add_number(4); -is $k->number, 7; - diff --git a/t/990_deprecated/047-attribute-metaclass-role.t b/t/990_deprecated/047-attribute-metaclass-role.t deleted file mode 100644 index a4b1945..0000000 --- a/t/990_deprecated/047-attribute-metaclass-role.t +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 7; -use lib 't/lib'; - -do { - local $SIG{__WARN__} = sub{ $_[0] =~ /deprecated/ or warn @_ }; - - package MouseX::AttributeHelpers::Number; - use Mouse; - extends 'Mouse::Meta::Attribute'; - - sub create { - my ($self, @args) = @_; - my $attr = $self->SUPER::create(@args); - my %provides = %{$attr->{provides}}; - my $method_constructors = { - add => sub { - my ($attr, $name) = @_; - return sub { - $_[0]->$name( $_[0]->$name() + $_[1]) - }; - }, - }; - while (my ($name, $aliased) = each %provides) { - $attr->associated_class->add_method( - $aliased => $method_constructors->{$name}->($attr, $attr->name) - ); - } - return $attr; - }; - - package # hide me from search.cpan.org - Mouse::Meta::Attribute::Custom::Number; - sub register_implementation { 'MouseX::AttributeHelpers::Number' } - - 1; - - package Foo; - use Mouse::Role; - - has 'i' => ( - metaclass => 'Number', - is => 'rw', - isa => 'Int', - provides => { - 'add' => 'add_number' - }, - ); - sub f_m {} - - package Bar; - use Mouse::Role; - - has 'j' => ( - metaclass => 'Number', - is => 'rw', - isa => 'Int', - provides => { - 'add' => 'add_number_j' - }, - ); - sub b_m {} - - package Klass1; - use Mouse; - with 'Foo'; - - package Klass2; - use Mouse; - with 'Foo', 'Bar'; - -}; - -{ - # normal - can_ok 'Klass1', 'add_number'; - my $k = Klass1->new(i=>3); - $k->add_number(4); - is $k->i, 7; -} - -{ - # combine - can_ok 'Klass2', 'f_m'; - can_ok 'Klass2', 'b_m'; - can_ok 'Klass2', 'add_number'; - can_ok 'Klass2', 'add_number_j'; - my $k = Klass2->new(i=>3); - $k->add_number(4); - is $k->i, 7; -} - -