X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FUtils.pm;h=c27dc52fb1f44d680e6ec9aa2c1bf899f0ee7e2d;hb=1007dce21baa268def01d39281fbfbe41d51aa8e;hp=a258bb3942e2266a65ff179ecbf6bf86c663041e;hpb=45287c815973a11dea92e12cbefeca656fffa912;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
index a258bb3..c27dc52 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;
 
@@ -219,7 +220,8 @@ sub ddl_parser_instance {
     });
 
 # this is disabled until RT#74593 is resolved
-=begin for general sadness
+
+=begin sadness
 
     unless ($parsers_libdir) {
 
@@ -279,6 +281,9 @@ sub ddl_parser_instance {
     }
 
     return $precompiled_mod->new;
+
+=end sadness
+
 =cut
 
 }
@@ -334,6 +339,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
@@ -482,6 +496,33 @@ Takes a version string (X.Y.Z) or perl style (XX.YYYZZZ) and a target ('perl'
 or 'native') transforms the string to the given target style.
 to
 
+=head2 throw
+
+Throws the provided string as an object that will stringify back to the
+original string.  This stops it from being mangled by L<Moo>'s C<isa>
+code.
+
+=head2 ex2err
+
+Wraps an attribute accessor to catch any exception raised using
+L</throw> and store them in C<< $self->error() >>, finally returning
+undef.  A reference to this function can be passed directly to
+L<Moo/around>.
+
+    around foo => \&ex2err;
+
+    around bar => sub {
+        my ($orig, $self) = (shift, shift);
+        return ex2err($orig, $self, @_) if @_;
+        ...
+    };
+
+=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>,