X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FUtils.pm;h=ffcf6f38b1e6e9d8ba65ad92c60d1050729f36f1;hb=f8783818bc9182e3ee8feabcc4a33ac59d370c9c;hp=fa67a7b3a178a6c785cc4cc0541ec3b821edb5b2;hpb=3757b980808fa4e91e010450515fa88b55e5b334;p=dbsrgits%2FSQL-Translator.git

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>,