From: gfx Date: Sun, 20 Dec 2009 06:44:58 +0000 (+0900) Subject: Remove deprecated stuff X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=64397f9ae9f1971da37dcd218253071637f592a8;p=gitmo%2FMouse.git Remove deprecated stuff --- diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 714ee8f..3df565a 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -8,11 +8,6 @@ use Mouse::Meta::TypeConstraint; sub _process_options{ my($class, $name, $args) = @_; - # XXX: for backward compatibility (with method modifiers) - if($class->can('canonicalize_args') != \&canonicalize_args){ - %{$args} = $class->canonicalize_args($name, %{$args}); - } - # taken from Class::MOP::Attribute::new defined($name) @@ -156,11 +151,6 @@ sub new { sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor } sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor } -sub _create_args { # DEPRECATED - $_[0]->{_create_args} = $_[1] if @_ > 1; - $_[0]->{_create_args} -} - sub interpolate_class{ my($class, $args) = @_; @@ -195,25 +185,6 @@ sub interpolate_class{ return( $class, @traits ); } -sub canonicalize_args{ # DEPRECATED - my ($self, $name, %args) = @_; - - Carp::cluck("$self->canonicalize_args has been deprecated." - . "Use \$self->_process_options instead."); - - return %args; -} - -sub create { # DEPRECATED - my ($self, $class, $name, %args) = @_; - - 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) = @_; @@ -249,15 +220,6 @@ sub _throw_type_constraint_error { ); } -sub coerce_constraint { # DEPRECATED - my $type = $_[0]->{type_constraint} - or return $_[1]; - - Carp::cluck("coerce_constraint() has been deprecated, which was an internal utility anyway"); - - return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $type, $_[1]); -} - sub clone_and_inherit_options{ my($self, %args) = @_; @@ -273,33 +235,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 } @@ -393,11 +328,6 @@ sub install_accessors{ } } - if($attribute->can('create') != \&create){ - # backword compatibility - $attribute->create($metaclass, $attribute->name, %{$attribute}); - } - return; } diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 0700ec3..8fb8335 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -14,11 +14,6 @@ if(Mouse::Util::MOUSE_XS){ *CLONE = sub { Mouse::Util::__register_metaclass_storage(\%METAS, 1) }; } -sub _metaclass_cache { # DEPRECATED - my($class, $name) = @_; - return $METAS{$name}; -} - sub initialize { my($class, $package_name, @args) = @_; @@ -62,26 +57,8 @@ sub name; sub namespace; -# The followings are Class::MOP specific methods - -#sub version { no strict 'refs'; ${shift->name.'::VERSION'} } -#sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} } -#sub identifier { -# my $self = shift; -# return join '-' => ( -# $self->name, -# ($self->version || ()), -# ($self->authority || ()), -# ); -#} - # add_attribute is an abstract method -sub get_attribute_map { # DEPRECATED - Carp::cluck('get_attribute_map() has been deprecated'); - return $_[0]->{attributes}; -} - sub has_attribute { exists $_[0]->{attributes}->{$_[1]} } sub get_attribute { $_[0]->{attributes}->{$_[1]} } sub remove_attribute { delete $_[0]->{attributes}->{$_[1]} } diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index 34f64cd..ebb71dd 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -67,11 +67,6 @@ BEGIN { ); } - sub optimized_constraints { # DEPRECATED - Carp::cluck('optimized_constraints() has been deprecated'); - return \%TYPE; - } - my @builtins = keys %TYPE; sub list_all_builtin_type_constraints { @builtins } @@ -199,15 +194,6 @@ sub duck_type { ); } -sub typecast_constraints { # DEPRECATED - my($class, $pkg, $type, $value) = @_; - Carp::croak("wrong arguments count") unless @_ == 4; - - Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway"); - - return $type->coerce($value); -} - sub enum { my($name, %valid); diff --git a/t/990_deprecated/044-attribute-metaclass.t b/t/990_deprecated/044-attribute-metaclass.t deleted file mode 100644 index 01786eb..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; -} - -