From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Thu, 30 Aug 2012 23:31:14 +0000 (+0100)
Subject: Carp instead of dying if arguments are passed to read-only accessors
X-Git-Tag: v0.11013_01~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8783818bc9182e3ee8feabcc4a33ac59d370c9c;p=dbsrgits%2FSQL-Translator.git

Carp instead of dying if arguments are passed to read-only accessors
---

diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm
index 9398b35..199fef4 100644
--- a/lib/SQL/Translator.pm
+++ b/lib/SQL/Translator.pm
@@ -17,7 +17,7 @@ use IO::Dir;
 use Sub::Quote qw(quote_sub);
 use SQL::Translator::Producer;
 use SQL::Translator::Schema;
-use SQL::Translator::Utils qw(throw ex2err);
+use SQL::Translator::Utils qw(throw ex2err carp_ro);
 
 $DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
 
@@ -136,6 +136,8 @@ around producer => sub {
 
 has producer_type => ( is => 'rwp', init_arg => undef );
 
+around producer_type => carp_ro('producer_type');
+
 has producer_args => ( is => 'rw', default => quote_sub(q{ +{} }) );
 
 around producer_args => sub {
@@ -157,6 +159,8 @@ around parser => sub {
 
 has parser_type => ( is => 'rwp', init_arg => undef );
 
+around parser_type => carp_ro('parser_type');
+
 has parser_args => ( is => 'rw', default => quote_sub(q{ +{} }) );
 
 around parser_args => sub {
diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm
index a4e4110..3fec27a 100644
--- a/lib/SQL/Translator/Schema/Field.pm
+++ b/lib/SQL/Translator/Schema/Field.pm
@@ -25,7 +25,7 @@ C<SQL::Translator::Schema::Field> is the field object.
 use Moo 1.000003;
 use SQL::Translator::Schema::Constants;
 use SQL::Translator::Types qw(schema_obj);
-use SQL::Translator::Utils qw(parse_list_arg ex2err throw);
+use SQL::Translator::Utils qw(parse_list_arg ex2err throw carp_ro);
 use Sub::Quote qw(quote_sub);
 
 extends 'SQL::Translator::Schema::Object';
@@ -321,6 +321,8 @@ Determine whether the field has a UNIQUE constraint or not.
 
 has is_unique => ( is => 'lazy', init_arg => undef );
 
+around is_unique => carp_ro('is_unique');
+
 sub _build_is_unique {
     my ( $self ) = @_;
 
diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
index fa67a7b..ffcf6f3 100644
--- a/lib/SQL/Translator/Utils.pm
+++ b/lib/SQL/Translator/Utils.pm
@@ -6,6 +6,7 @@ use Digest::SHA qw( sha1_hex );
 use File::Spec;
 use Scalar::Util qw(blessed);
 use Try::Tiny;
+use Carp qw(carp);
 
 our $VERSION = '1.59';
 our $DEFAULT_COMMENT = '-- ';
@@ -15,7 +16,7 @@ our @EXPORT_OK = qw(
     debug normalize_name header_comment parse_list_arg truncate_id_uniquely
     $DEFAULT_COMMENT parse_mysql_version parse_dbms_version
     ddl_parser_instance
-    throw ex2err
+    throw ex2err carp_ro
 );
 use constant COLLISION_TAG_LENGTH => 8;
 
@@ -334,6 +335,15 @@ sub ex2err {
     };
 }
 
+sub carp_ro {
+    my ($name) = @_;
+    return sub {
+        my ($orig, $self) = (shift, shift);
+        carp "'$name' is a read-only accessor" if @_;
+        return $self->$orig;
+    };
+}
+
 1;
 
 =pod
@@ -503,6 +513,12 @@ L<Moo/around>.
         ...
     };
 
+=head2 carp_ro
+
+Takes a field name and returns a reference to a function can be used
+L<around|Moo/around> a read-only accessor to make it L<carp|Carp/carp>
+instead of die when passed an argument.
+
 =head1 AUTHORS
 
 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,