From: gfx <gfuji@cpan.org>
Date: Sun, 27 Sep 2009 07:53:12 +0000 (+0900)
Subject: Fix an issue that breaks a backward compatibility.
X-Git-Tag: 0.36~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0449307510ab4425a6b340fee9bf85824eb994b1;p=gitmo%2FMouse.git

Fix an issue that breaks a backward compatibility.
---

diff --git a/Changes b/Changes
index 1c19eda..dfeb1c7 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Mouse
 
+0.36 Sun Sep 27 16:53:06 2009
+    * Fix an issue that breaks backward compatibility (gfx)
+      - MouseX::Attribute does work, although make tests doesn't pass
+
 0.35 Sat Sep 26 12:38:27 2009
     * Work around Test::Exception 0.27_0x by including authorized ver. (gfx)
 
diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index a9a8431..d3eaa3c 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -12,6 +12,12 @@ use Mouse::Meta::Method::Accessor;
 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)
@@ -119,10 +125,6 @@ sub _process_options{
             || $class->throw_error("You cannot have lazy attribute ($name) without specifying a default value for it");
     }
 
-    # XXX: for backward compatibility (with method modifiers)
-    if($class->can('canonicalize_args') != \&canonicalize_args){
-        %{$args} = $class->canonicalize_args($name, %{$args});
-    }
     return;
 }
 
@@ -242,7 +244,8 @@ sub canonicalize_args{
     my ($self, $name, %args) = @_;
 
     Carp::cluck("$self->canonicalize_args has been deprecated."
-        . "Use \$self->_process_options instead.");
+        . "Use \$self->_process_options instead.")
+            if _MOUSE_VERBOSE;
 
     return %args;
 }
@@ -251,7 +254,8 @@ sub create {
     my ($self, $class, $name, %args) = @_;
 
     Carp::cluck("$self->create has been deprecated."
-        . "Use \$meta->add_attribute and \$attr->install_accessors instead.");
+        . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
+            if _MOUSE_VERBOSE;
 
     # noop
     return $self;
@@ -308,8 +312,8 @@ sub clone_parent {
     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.");
-
+        . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
+        if _MOUSE_VERBOSE;
 
     $self->clone_and_inherited_args($class, $name, %args);
 }
@@ -328,6 +332,12 @@ sub get_parent_args {
     $self->throw_error("Could not find an attribute by the name of '$name' to inherit from");
 }
 
+sub associate_method{
+    my ($attribute, $method) = @_;
+    $attribute->{associated_methods}++;
+    return;
+}
+
 sub install_accessors{
     my($attribute) = @_;
 
diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index b973e42..ca8676a 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -4,7 +4,7 @@ use warnings;
 
 use Scalar::Util qw/blessed weaken/;
 
-use Mouse::Util qw/get_linear_isa not_supported/;
+use Mouse::Util qw/:meta get_linear_isa not_supported/;
 
 use Mouse::Meta::Method::Constructor;
 use Mouse::Meta::Method::Destructor;
@@ -125,7 +125,7 @@ sub add_attribute {
     $self->{attributes}{$attr->name} = $attr;
     $attr->install_accessors();
 
-    if(!$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){
+    if(_MOUSE_VERBOSE && !$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){
         Carp::cluck(qq{Attribute (}.$attr->name.qq{) of class }.$self->name.qq{ has no associated methods (did you mean to provide an "is" argument?)});
     }
     return $attr;
@@ -250,7 +250,8 @@ sub clone_object {
 sub clone_instance {
     my ($class, $instance, %params) = @_;
 
-    Carp::cluck('clone_instance has been deprecated. Use clone_object instead');
+    Carp::cluck('clone_instance has been deprecated. Use clone_object instead')
+        if _MOUSE_VERBOSE;
     return $class->clone_object($instance, %params);
 }
 
diff --git a/lib/Mouse/Meta/Role.pm b/lib/Mouse/Meta/Role.pm
index 03fb20b..1fb7758 100644
--- a/lib/Mouse/Meta/Role.pm
+++ b/lib/Mouse/Meta/Role.pm
@@ -2,7 +2,7 @@ package Mouse::Meta::Role;
 use strict;
 use warnings;
 
-use Mouse::Util qw(not_supported english_list);
+use Mouse::Util qw(:meta not_supported english_list);
 use Mouse::Meta::Module;
 our @ISA = qw(Mouse::Meta::Module);
 
diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index a348700..e86da70 100644
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -6,6 +6,8 @@ use Exporter;
 
 use Carp qw(confess);
 
+use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};
+
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(
     find_meta
@@ -23,10 +25,11 @@ our @EXPORT_OK = qw(
     not_supported
 
     does meta dump
+    _MOUSE_VERBOSE
 );
 our %EXPORT_TAGS = (
     all  => \@EXPORT_OK,
-    meta => [qw(does meta dump)],
+    meta => [qw(does meta dump _MOUSE_VERBOSE)],
 );
 
 # Moose::Util compatible utilities