From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 14 Jan 2011 10:52:02 +0000 (+0100)
Subject: Ditch Carp::Clan for our own thing
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=70c288086248e5a4008490df22a56632341f2473;p=dbsrgits%2FDBIx-Class-Historic.git

Ditch Carp::Clan for our own thing
---

diff --git a/Changes b/Changes
index debc2ad..ae28dcb 100644
--- a/Changes
+++ b/Changes
@@ -35,6 +35,8 @@ Revision history for DBIx::Class
           of SQL::Abstract >= 1.73
 
     * Misc
+        - Rewire all warnings to a new Carp-like implementation internal
+          to DBIx::Class, and remove the Carp::Clan dependency
         - Only load Class::C3 and friends if necessary ($] < 5.010)
         - Greatly reduced loading of non-essential modules to aid startup
           time (mainly benefiting CGI users)
diff --git a/Makefile.PL b/Makefile.PL
index 824a047..f11a5ea 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -56,7 +56,6 @@ my $test_requires = {
 };
 
 my $runtime_requires = {
-  'Carp::Clan'               => '6.0',
   'Class::Accessor::Grouped' => '0.10002',
   'Class::C3::Componentised' => '1.0009',
   'Class::Inspector'         => '1.24',
@@ -253,6 +252,7 @@ no_index directory => $_ for (qw|
 |);
 no_index package => $_ for (qw/
   DBIx::Class::Storage::DBIHacks
+  DBIx::Class::Carp
 /);
 
 WriteAll();
diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 0649793..4551941 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -28,6 +28,9 @@ use vars qw($VERSION);
 use base qw/DBIx::Class::Componentised DBIx::Class::AccessorGroup/;
 use DBIx::Class::StartupCheck;
 
+__PACKAGE__->mk_group_accessors(inherited => '_skip_namespace_frames');
+__PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny');
+
 sub mk_classdata {
   shift->mk_classaccessor(@_);
 }
diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm
index aba3691..59b0081 100644
--- a/lib/DBIx/Class/Admin.pm
+++ b/lib/DBIx/Class/Admin.pm
@@ -2,9 +2,8 @@ package DBIx::Class::Admin;
 
 # check deps
 BEGIN {
-  use Carp::Clan qw/^DBIx::Class/;
   use DBIx::Class;
-  croak('The following modules are required for DBIx::Class::Admin ' . DBIx::Class::Optional::Dependencies->req_missing_for ('admin') )
+  die('The following modules are required for DBIx::Class::Admin ' . DBIx::Class::Optional::Dependencies->req_missing_for ('admin') )
     unless DBIx::Class::Optional::Dependencies->req_ok_for ('admin');
 }
 
@@ -403,7 +402,7 @@ sub install {
     print "return is $ret\n" if (!$self->quiet);
   }
   elsif ($schema->get_db_version() and $self->force ) {
-    carp "Forcing install may not be a good idea";
+    warn "Forcing install may not be a good idea\n";
     if($self->_confirm() ) {
       $self->schema->_set_db_version({ version => $version});
     }
diff --git a/lib/DBIx/Class/CDBICompat.pm b/lib/DBIx/Class/CDBICompat.pm
index 41160c0..0dddff3 100644
--- a/lib/DBIx/Class/CDBICompat.pm
+++ b/lib/DBIx/Class/CDBICompat.pm
@@ -3,7 +3,6 @@ package DBIx::Class::CDBICompat;
 use strict;
 use warnings;
 use base qw/DBIx::Class::Core DBIx::Class::DB/;
-use Carp::Clan qw/^DBIx::Class/;
 
 # Modules CDBICompat needs that DBIx::Class does not.
 my @Extra_Modules = qw(
@@ -16,7 +15,7 @@ my @didnt_load;
 for my $module (@Extra_Modules) {
     push @didnt_load, $module unless eval qq{require $module};
 }
-croak("@{[ join ', ', @didnt_load ]} are missing and are required for CDBICompat")
+__PACKAGE__->throw_exception("@{[ join ', ', @didnt_load ]} are missing and are required for CDBICompat")
     if @didnt_load;
 
 
diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm
new file mode 100644
index 0000000..e2af539
--- /dev/null
+++ b/lib/DBIx/Class/Carp.pm
@@ -0,0 +1,154 @@
+package DBIx::Class::Carp;
+
+use strict;
+use warnings;
+
+use Carp ();
+use namespace::clean ();
+
+sub __find_caller {
+  my ($skip_pattern, $class) = @_;
+
+  my $skip_class_data = $class->_skip_namespace_frames
+    if ($class and $class->can('_skip_namespace_frames'));
+
+  $skip_pattern = qr/$skip_pattern|$skip_class_data/
+    if $skip_class_data;
+
+  my $fr_num = 1; # skip us and the calling carp*
+  my @f;
+  while (@f = caller($fr_num++)) {
+    last unless $f[0] =~ $skip_pattern;
+  }
+
+  my ($ln, $calling) = @f # if empty - nothing matched - full stack
+    ? ( "at $f[1] line $f[2]", $f[3] )
+    : ( Carp::longmess(), '{UNKNOWN}' )
+  ;
+
+  return (
+    $ln,
+    $calling =~ /::/ ? "$calling(): " : "$calling: ", # cargo-cult from Carp::Clan
+  );
+};
+
+my $warn = sub {
+  my ($ln, @warn) = @_;
+  @warn = "Warning: something's wrong" unless @warn;
+
+  # back-compat with Carp::Clan - a warning ending with \n does
+  # not include caller info
+  warn (
+    @warn,
+    $warn[-1] =~ /\n$/ ? '' : " $ln\n"
+  );
+};
+
+sub import {
+  my (undef, $skip_pattern) = @_;
+  my $into = caller;
+
+  $skip_pattern = $skip_pattern
+    ? qr/ ^ $into $ | $skip_pattern /xo
+    : qr/ ^ $into $ /xo
+  ;
+
+  no strict 'refs';
+
+  *{"${into}::carp"} = sub {
+    $warn->(
+      __find_caller($skip_pattern, $into),
+      @_
+    );
+  };
+
+  my $fired;
+  *{"${into}::carp_once"} = sub {
+    return if $fired;
+    $fired = 1;
+
+    $warn->(
+      __find_caller($skip_pattern, $into),
+      @_,
+    );
+  };
+
+  my $seen;
+  *{"${into}::carp_unique"} = sub {
+    my ($ln, $calling) = __find_caller($skip_pattern, $into);
+    my $msg = join ('', $calling, @_);
+
+    # unique carping with a hidden caller makes no sense
+    $msg =~ s/\n+$//;
+
+    return if $seen->{$ln}{$msg};
+    $seen->{$ln}{$msg} = 1;
+
+    $warn->(
+      $ln,
+      $msg,
+    );
+  };
+
+  # cleanup after ourselves
+  namespace::clean->import(-cleanee => $into, qw/carp carp_once carp_unique/);
+}
+
+sub unimport {
+  die (__PACKAGE__ . " does not implement unimport yet\n");
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Carp - Provides advanced Carp::Clan-like warning functions for DBIx::Class internals
+
+=head1 DESCRIPTION
+
+Documentation is lacking on purpose - this an experiment not yet fit for
+mass consumption. If you use this do not count on any kind of stability,
+in fact don't even count on this module's continuing existence (it has
+been noindexed for a reason).
+
+In addition to the classic interface:
+
+  use DBIx::Class::Carp '^DBIx::Class'
+
+this module also supports a class-data based way to specify the exclusion
+regex. A message is only carped from a callsite that matches neither the
+closed over string, nor the value of L</_skip_namespace_frames> as declared
+on the B<first> callframe origin.
+
+=head1 CLASS ATTRIBUTES
+
+=head2 _skip_namespace_frames
+
+A classdata attribute holding the stringified regex matching callsites that
+should be skipped by the carp methods below. An empty string C<q{}> is treated
+like no setting/C<undef> (the distinction is necessary due to semantics of the
+class data accessors provided by L<Class::Accessor::Grouped>)
+
+=head1 EXPORTED FUNCTIONS
+
+This module export the following 3 functions. Only warning related C<carp*>
+is being handled here, for C<croak>-ing you must use
+L<DBIx::Class::Schema/throw_exception> or L<DBIx::Class::Exception>.
+
+=head2 carp
+
+Carps message with the file/line of the first callsite not matching
+L</_skip_namespace_frames> nor the closed-over arguments to
+C<use DBIx::Class::Carp>.
+
+=head2 carp_unique
+
+Like L</carp> but warns once for every distinct callsite (subject to the
+same ruleset as L</carp>).
+
+=head2 carp_once
+
+Like L</carp> but warns only once for the life of the perl interpreter
+(regardless of callsite).
+
+=cut
diff --git a/lib/DBIx/Class/Componentised.pm b/lib/DBIx/Class/Componentised.pm
index 7e398ca..be0d668 100644
--- a/lib/DBIx/Class/Componentised.pm
+++ b/lib/DBIx/Class/Componentised.pm
@@ -7,11 +7,7 @@ use warnings;
 use base 'Class::C3::Componentised';
 use mro 'c3';
 
-use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/;
-use namespace::clean;
-
-
-my $warned;
+use DBIx::Class::Carp '^DBIx::Class|^Class::C3::Componentised';
 
 # this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column
 # if and only if it is placed before something overriding store_column
@@ -40,8 +36,8 @@ sub inject_base {
     for (qw/DBIx::Class::UTF8Columns DBIx::Class::ForceUTF8/) {
       if ($comp->isa ($_) ) {
         $keep_checking = 0; # no use to check from this point on
-        carp "Use of $_ is strongly discouraged. See documentation of DBIx::Class::UTF8Columns for more info\n"
-          unless ($warned->{UTF8Columns}++ || $ENV{DBIC_UTF8COLUMNS_OK});
+        carp_once "Use of $_ is strongly discouraged. See documentation of DBIx::Class::UTF8Columns for more info\n"
+          unless $ENV{DBIC_UTF8COLUMNS_OK};
         last;
       }
     }
diff --git a/lib/DBIx/Class/Exception.pm b/lib/DBIx/Class/Exception.pm
index 6c8d0e9..3c2aa9b 100644
--- a/lib/DBIx/Class/Exception.pm
+++ b/lib/DBIx/Class/Exception.pm
@@ -3,9 +3,7 @@ package DBIx::Class::Exception;
 use strict;
 use warnings;
 
-use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
-use Try::Tiny;
-use namespace::clean;
+use DBIx::Class::Carp ();
 
 use overload
     '""' => sub { shift->{msg} },
@@ -19,8 +17,7 @@ DBIx::Class::Exception - Exception objects for DBIx::Class
 
 Exception objects of this class are used internally by
 the default error handling of L<DBIx::Class::Schema/throw_exception>
-to prevent confusing and/or redundant re-application of L<Carp>'s
-stack trace information.
+and derivatives.
 
 These objects stringify to the contained error message, and use
 overload fallback to give natural boolean/numeric values.
@@ -39,8 +36,7 @@ This is meant for internal use by L<DBIx::Class>'s C<throw_exception>
 code, and shouldn't be used directly elsewhere.
 
 Expects a scalar exception message.  The optional argument
-C<$stacktrace> tells it to use L<Carp/longmess> instead of
-L<Carp::Clan/croak>.
+C<$stacktrace> tells it to output a full trace similar to L<Carp/confess>.
 
   DBIx::Class::Exception->throw('Foo');
   try { ... } catch { DBIx::Class::Exception->throw(shift) }
@@ -53,9 +49,18 @@ sub throw {
     # Don't re-encapsulate exception objects of any kind
     die $msg if ref($msg);
 
-    # use Carp::Clan's croak if we're not stack tracing
+    # all exceptions include a caller
+    $msg =~ s/\n$//;
+
     if(!$stacktrace) {
-        try { croak $msg } catch { $msg = shift };
+        # skip all frames that match the original caller, or any of
+        # the dbic-wide classdata patterns
+        my ($ln, $calling) = DBIx::Class::Carp::__find_caller(
+          '^' . caller() . '$',
+          'DBIx::Class',
+        );
+
+        $msg = "${calling}${msg} ${ln}\n";
     }
     else {
         $msg = Carp::longmess($msg);
diff --git a/lib/DBIx/Class/InflateColumn/DateTime.pm b/lib/DBIx/Class/InflateColumn/DateTime.pm
index 7b7e144..1b72ac6 100644
--- a/lib/DBIx/Class/InflateColumn/DateTime.pm
+++ b/lib/DBIx/Class/InflateColumn/DateTime.pm
@@ -3,7 +3,7 @@ package DBIx::Class::InflateColumn::DateTime;
 use strict;
 use warnings;
 use base qw/DBIx::Class/;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use Try::Tiny;
 use namespace::clean;
 
diff --git a/lib/DBIx/Class/InflateColumn/File.pm b/lib/DBIx/Class/InflateColumn/File.pm
index 634bafc..3b17cd2 100644
--- a/lib/DBIx/Class/InflateColumn/File.pm
+++ b/lib/DBIx/Class/InflateColumn/File.pm
@@ -6,7 +6,7 @@ use base 'DBIx::Class';
 use File::Path;
 use File::Copy;
 use Path::Class;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use namespace::clean;
 
 carp 'InflateColumn::File has entered a deprecation cycle. This component '
diff --git a/lib/DBIx/Class/Optional/Dependencies.pm b/lib/DBIx/Class/Optional/Dependencies.pm
index 9caf05b..81b3ee6 100644
--- a/lib/DBIx/Class/Optional/Dependencies.pm
+++ b/lib/DBIx/Class/Optional/Dependencies.pm
@@ -473,6 +473,7 @@ sub _check_deps {
     if (keys %errors) {
       my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
       $missing .= " (see $class for details)" if $reqs->{$group}{pod};
+      $missing .= "\n";
       $res = {
         status => 0,
         errorlist => \%errors,
diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm
index 39155a7..f6e59fa 100644
--- a/lib/DBIx/Class/Relationship/CascadeActions.pm
+++ b/lib/DBIx/Class/Relationship/CascadeActions.pm
@@ -3,8 +3,7 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
-use namespace::clean;
+use DBIx::Class::Carp;
 
 our %_pod_inherit_config = 
   (
diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index 3f1160d..00bffdb 100644
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -3,7 +3,7 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use Try::Tiny;
 use namespace::clean;
 
diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm
index 0b4ad56..b93959f 100644
--- a/lib/DBIx/Class/Relationship/ManyToMany.pm
+++ b/lib/DBIx/Class/Relationship/ManyToMany.pm
@@ -4,7 +4,7 @@ package # hide from PAUSE
 use strict;
 use warnings;
 
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use Sub::Name qw/subname/;
 use Scalar::Util qw/blessed/;
 
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 5ded4b7..e4c3efb 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -3,7 +3,7 @@ package DBIx::Class::ResultSet;
 use strict;
 use warnings;
 use base qw/DBIx::Class/;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use DBIx::Class::Exception;
 use DBIx::Class::ResultSetColumn;
 use Scalar::Util qw/blessed weaken/;
@@ -296,7 +296,6 @@ always return a resultset, even in list context.
 
 =cut
 
-my $callsites_warned;
 sub search_rs {
   my $self = shift;
 
@@ -405,15 +404,7 @@ sub search_rs {
   } if @_;
 
   if( @_ > 1 and ! $rsrc->result_class->isa('DBIx::Class::CDBICompat') ) {
-    # determine callsite obeying Carp::Clan rules (fucking ugly but don't have better ideas)
-    my $callsite = do {
-      my $w;
-      local $SIG{__WARN__} = sub { $w = shift };
-      carp;
-      $w
-    };
-    carp 'search( %condition ) is deprecated, use search( \%condition ) instead'
-      unless $callsites_warned->{$callsite}++;
+    carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead';
   }
 
   for ($old_where, $call_cond) {
@@ -792,7 +783,6 @@ sub _qualify_cond_columns {
   return \%aliased;
 }
 
-my $callsites_warned_ucond;
 sub _build_unique_cond {
   my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
 
@@ -829,20 +819,13 @@ sub _build_unique_cond {
       and
     my @undefs = grep { ! defined $final_cond->{$_} } (keys %$final_cond)
   ) {
-    my $callsite = do {
-      my $w;
-      local $SIG{__WARN__} = sub { $w = shift };
-      carp;
-      $w
-    };
-
-    carp ( sprintf (
+    carp_unique ( sprintf (
       "NULL/undef values supplied for requested unique constraint '%s' (NULL "
     . 'values in column(s): %s). This is almost certainly not what you wanted, '
     . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
       $constraint_name,
       join (', ', map { "'$_'" } @undefs),
-    )) unless $callsites_warned_ucond->{$callsite}++;
+    ));
   }
 
   return $final_cond;
@@ -1071,7 +1054,7 @@ instead. An example conversion is:
 
 sub search_like {
   my $class = shift;
-  carp (
+  carp_unique (
     'search_like() is deprecated and will be removed in DBIC version 0.09.'
    .' Instead use ->search({ x => { -like => "y%" } })'
    .' (note the outer pair of {}s - they are important!)'
@@ -3362,7 +3345,7 @@ sub _resolved_attrs {
   # subquery (since a group_by is present)
   if (delete $attrs->{distinct}) {
     if ($attrs->{group_by}) {
-      carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
+      carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
     }
     else {
       # distinct affects only the main selection part, not what prefetch may
diff --git a/lib/DBIx/Class/ResultSetColumn.pm b/lib/DBIx/Class/ResultSetColumn.pm
index 8c2962c..e97355e 100644
--- a/lib/DBIx/Class/ResultSetColumn.pm
+++ b/lib/DBIx/Class/ResultSetColumn.pm
@@ -4,10 +4,8 @@ use strict;
 use warnings;
 
 use base 'DBIx::Class';
-
+use DBIx::Class::Carp;
 use DBIx::Class::Exception;
-use Carp::Clan qw/^DBIx::Class/;
-use namespace::clean;
 
 # not importing first() as it will clash with our own method
 use List::Util ();
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index f0f4fdd..dffe6ad 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -7,7 +7,7 @@ use DBIx::Class::ResultSet;
 use DBIx::Class::ResultSourceHandle;
 
 use DBIx::Class::Exception;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use Try::Tiny;
 use List::Util 'first';
 use Scalar::Util qw/weaken isweak/;
diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm
index 08acbb2..0fcf590 100644
--- a/lib/DBIx/Class/SQLMaker.pm
+++ b/lib/DBIx/Class/SQLMaker.pm
@@ -35,13 +35,14 @@ Currently the enhancements to L<SQL::Abstract> are:
 use base qw/
   DBIx::Class::SQLMaker::LimitDialects
   SQL::Abstract
-  Class::Accessor::Grouped
+  DBIx::Class
 /;
 use mro 'c3';
 use strict;
 use warnings;
 use Sub::Name 'subname';
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract|^Try::Tiny/;
+use DBIx::Class::Carp;
+use DBIx::Class::Exception;
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
@@ -54,9 +55,13 @@ sub _quote_chars {
   ;
 }
 
+# FIXME when we bring in the storage weaklink, check its schema
+# weaklink and channel through $schema->throw_exception
+sub throw_exception { DBIx::Class::Exception->throw($_[1]) }
+
 BEGIN {
   # reinstall the belch()/puke() functions of SQL::Abstract with custom versions
-  # that use Carp::Clan instead of plain Carp (they do not like each other much)
+  # that use DBIx::Class::Carp/DBIx::Class::Exception instead of plain Carp
   no warnings qw/redefine/;
 
   *SQL::Abstract::belch = subname 'SQL::Abstract::belch' => sub (@) {
@@ -66,7 +71,7 @@ BEGIN {
 
   *SQL::Abstract::puke = subname 'SQL::Abstract::puke' => sub (@) {
     my($func) = (caller(1))[3];
-    croak "[$func] Fatal: ", @_;
+    __PACKAGE__->throw_exception("[$func] Fatal: " . join ('',  @_));
   };
 
   # Current SQLA pollutes its namespace - clean for the time being
@@ -100,7 +105,7 @@ sub _where_op_IDENT {
   my $self = shift;
   my ($op, $rhs) = splice @_, -2;
   if (ref $rhs) {
-    croak "-$op takes a single scalar argument (a quotable identifier)";
+    $self->throw_exception("-$op takes a single scalar argument (a quotable identifier)");
   }
 
   # in case we are called as a top level special op (no '=')
@@ -122,7 +127,7 @@ sub _where_op_VALUE {
   my $lhs = shift;
 
   my @bind = [
-    ($lhs || $self->{_nested_func_lhs} || croak "Unable to find bindtype for -value $rhs"),
+    ($lhs || $self->{_nested_func_lhs} || $self->throw_exception("Unable to find bindtype for -value $rhs") ),
     $rhs
   ];
 
@@ -138,19 +143,10 @@ sub _where_op_VALUE {
   ;
 }
 
-my $callsites_warned;
 sub _where_op_NEST {
-  # determine callsite obeying Carp::Clan rules (fucking ugly but don't have better ideas)
-  my $callsite = do {
-    my $w;
-    local $SIG{__WARN__} = sub { $w = shift };
-    carp;
-    $w
-  };
-
-  carp ("-nest in search conditions is deprecated, you most probably wanted:\n"
+  carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n"
       .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
-  ) unless $callsites_warned->{$callsite}++;
+  );
 
   shift->next::method(@_);
 }
@@ -163,13 +159,13 @@ sub select {
   $fields = $self->_recurse_fields($fields);
 
   if (defined $offset) {
-    croak ('A supplied offset must be a non-negative integer')
+    $self->throw_exception('A supplied offset must be a non-negative integer')
       if ( $offset =~ /\D/ or $offset < 0 );
   }
   $offset ||= 0;
 
   if (defined $limit) {
-    croak ('A supplied limit must be a positive integer')
+    $self->throw_exception('A supplied limit must be a positive integer')
       if ( $limit =~ /\D/ or $limit <= 0 );
   }
   elsif ($offset) {
@@ -188,9 +184,9 @@ sub select {
         ||
       do {
         my $dialect = $self->limit_dialect
-          or croak "Unable to generate SQL-limit - no limit dialect specified on $self, and no emulate_limit method found";
+          or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self, and no emulate_limit method found" );
         $self->can ("_$dialect")
-          or croak (__PACKAGE__ . " does not implement the requested dialect '$dialect'");
+          or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'");
       }
     ;
 
@@ -222,7 +218,7 @@ my $for_syntax = {
 };
 sub _lock_select {
   my ($self, $type) = @_;
-  my $sql = $for_syntax->{$type} || croak "Unknown SELECT .. FOR type '$type' requested";
+  my $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" );
   return " $sql";
 }
 
@@ -270,11 +266,11 @@ sub _recurse_fields {
 
     # there should be only one pair
     if (@toomany) {
-      croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
+      $self->throw_exception( "Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) );
     }
 
     if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
-      croak (
+      $self->throw_exception (
         'The select => { distinct => ... } syntax is not supported for multiple columns.'
        .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
        .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
@@ -297,7 +293,7 @@ sub _recurse_fields {
     return $$fields->[0];
   }
   else {
-    croak($ref . qq{ unexpected in _recurse_fields()})
+    $self->throw_exception( $ref . qq{ unexpected in _recurse_fields()} );
   }
 }
 
@@ -421,7 +417,7 @@ sub _from_chunk_to_sql {
         ( grep { $_ !~ /^\-/ } keys %$fromspec )
       );
 
-      croak "Only one table/as pair expected in from-spec but an exra '$toomuch' key present"
+      $self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" )
         if defined $toomuch;
 
       ($self->_from_chunk_to_sql($table), $self->_quote($as) );
@@ -440,7 +436,7 @@ sub _join_condition {
     for (keys %$cond) {
       my $v = $cond->{$_};
       if (ref $v) {
-        croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
+        $self->throw_exception (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
             if ref($v) ne 'SCALAR';
         $j{$_} = $v;
       }
@@ -452,7 +448,7 @@ sub _join_condition {
   } elsif (ref $cond eq 'ARRAY') {
     return join(' OR ', map { $self->_join_condition($_) } @$cond);
   } else {
-    croak "Can't handle this yet!";
+    die "Can't handle this yet!";
   }
 }
 
diff --git a/lib/DBIx/Class/SQLMaker/LimitDialects.pm b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
index 1c30436..00f7cb5 100644
--- a/lib/DBIx/Class/SQLMaker/LimitDialects.pm
+++ b/lib/DBIx/Class/SQLMaker/LimitDialects.pm
@@ -3,7 +3,6 @@ package DBIx::Class::SQLMaker::LimitDialects;
 use warnings;
 use strict;
 
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract|^Try::Tiny/;
 use List::Util 'first';
 use namespace::clean;
 
@@ -54,7 +53,7 @@ use namespace::clean;
       @order = @$order,     last CASE if $ref eq 'ARRAY';
       @order = ( $order ),  last CASE unless $ref;
       @order = ( $$order ), last CASE if $ref eq 'SCALAR';
-      croak __PACKAGE__ . ": Unsupported data struct $ref for ORDER BY";
+      $self->throw_exception(__PACKAGE__ . ": Unsupported data struct $ref for ORDER BY");
     }
 
     my ( $order_by_up, $order_by_down );
@@ -62,11 +61,11 @@ use namespace::clean;
     foreach my $spec ( @order )
     {
         my @spec = split ' ', $spec;
-        croak( "bad column order spec: $spec" ) if @spec > 2;
+        $self->throw_exception("bad column order spec: $spec") if @spec > 2;
         push( @spec, 'ASC' ) unless @spec == 2;
         my ( $col, $up ) = @spec; # or maybe down
         $up = uc( $up );
-        croak( "bad direction: $up" ) unless $up =~ /^(?:ASC|DESC)$/;
+        $self->throw_exception("bad direction: $up") unless $up =~ /^(?:ASC|DESC)$/;
         $order_by_up .= ", $col $up";
         my $down = $up eq 'ASC' ? 'DESC' : 'ASC';
         $order_by_down .= ", $col $down";
@@ -152,7 +151,7 @@ sub _RowNumberOver {
 
   # mangle the input sql as we will be replacing the selector
   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
-    or croak "Unrecognizable SELECT: $sql";
+    or $self->throw_exception("Unrecognizable SELECT: $sql");
 
   # get selectors, and scan the order_by (if any)
   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
@@ -222,7 +221,7 @@ sub _SkipFirst {
   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 
   $sql =~ s/^ \s* SELECT \s+ //ix
-    or croak "Unrecognizable SELECT: $sql";
+    or $self->throw_exception("Unrecognizable SELECT: $sql");
 
   return sprintf ('SELECT %s%s%s%s',
     $offset
@@ -247,7 +246,7 @@ sub _FirstSkip {
   my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
 
   $sql =~ s/^ \s* SELECT \s+ //ix
-    or croak "Unrecognizable SELECT: $sql";
+    or $self->throw_exception("Unrecognizable SELECT: $sql");
 
   return sprintf ('SELECT %s%s%s%s',
     sprintf ('FIRST %u ', $rows),
@@ -276,7 +275,7 @@ sub _RowNum {
 
   # mangle the input sql as we will be replacing the selector
   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
-    or croak "Unrecognizable SELECT: $sql";
+    or $self->throw_exception("Unrecognizable SELECT: $sql");
 
   my ($insel, $outsel) = $self->_subqueried_limit_attrs ($rs_attrs);
 
@@ -332,7 +331,7 @@ sub _Top {
 
   # mangle the input sql as we will be replacing the selector
   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
-    or croak "Unrecognizable SELECT: $sql";
+    or $self->throw_exception("Unrecognizable SELECT: $sql");
 
   # get selectors
   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
@@ -486,7 +485,7 @@ sub _GenericSubQ {
 
   # mangle the input sql as we will be replacing the selector
   $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
-    or croak "Unrecognizable SELECT: $sql";
+    or $self->throw_exception("Unrecognizable SELECT: $sql");
 
   my ($order_by, @rest) = do {
     local $self->{quote_char};
@@ -503,7 +502,7 @@ sub _GenericSubQ {
       ( ref $order_by eq 'ARRAY' and @$order_by == 1 )
     )
   ) {
-    croak (
+    $self->throw_exception (
       'Generic Subquery Limit does not work on resultsets without an order, or resultsets '
     . 'with complex order criteria (multicolumn and/or functions). Provide a single, '
     . 'unique-column order criteria.'
@@ -521,11 +520,13 @@ sub _GenericSubQ {
     $rs_attrs->{from}, [$order_by, $unq_sort_col]
   );
 
-  my $ord_colinfo = $inf->{$order_by} || croak "Unable to determine source of order-criteria '$order_by'";
+  my $ord_colinfo = $inf->{$order_by} || $self->throw_exception("Unable to determine source of order-criteria '$order_by'");
 
   if ($ord_colinfo->{-result_source}->name ne $root_tbl_name) {
-    croak "Generic Subquery Limit order criteria can be only based on the root-source '"
-        . $root_rsrc->source_name . "' (aliased as '$rs_attrs->{alias}')";
+    $self->throw_exception(sprintf
+      "Generic Subquery Limit order criteria can be only based on the root-source '%s'"
+    . " (aliased as '%s')", $root_rsrc->source_name, $rs_attrs->{alias},
+    );
   }
 
   # make sure order column is qualified
@@ -540,8 +541,9 @@ sub _GenericSubQ {
       last;
     }
   }
-  croak "Generic Subquery Limit order criteria column '$order_by' must be unique (no unique constraint found)"
-    unless $is_u;
+  $self->throw_exception(
+    "Generic Subquery Limit order criteria column '$order_by' must be unique (no unique constraint found)"
+  ) unless $is_u;
 
   my ($in_sel, $out_sel, $alias_map, $extra_order_sel)
     = $self->_subqueried_limit_attrs ($rs_attrs);
@@ -601,8 +603,9 @@ EOS
 sub _subqueried_limit_attrs {
   my ($self, $rs_attrs) = @_;
 
-  croak 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
-    unless ref ($rs_attrs) eq 'HASH';
+  $self->throw_exception(
+    'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
+  ) unless ref ($rs_attrs) eq 'HASH';
 
   my ($re_sep, $re_alias) = map { quotemeta $_ } ( $self->{name_sep}, $rs_attrs->{alias} );
 
@@ -622,7 +625,7 @@ sub _subqueried_limit_attrs {
           ||
         $rs_attrs->{as}[$i]
           ||
-        croak "Select argument $i ($s) without corresponding 'as'"
+        $self->throw_exception("Select argument $i ($s) without corresponding 'as'")
       ,
     };
 
diff --git a/lib/DBIx/Class/SQLMaker/MySQL.pm b/lib/DBIx/Class/SQLMaker/MySQL.pm
index 4eefc9d..fdb2d6b 100644
--- a/lib/DBIx/Class/SQLMaker/MySQL.pm
+++ b/lib/DBIx/Class/SQLMaker/MySQL.pm
@@ -2,8 +2,6 @@ package # Hide from PAUSE
   DBIx::Class::SQLMaker::MySQL;
 
 use base qw( DBIx::Class::SQLMaker );
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
-use namespace::clean;
 
 #
 # MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES
@@ -42,7 +40,8 @@ my $for_syntax = {
 sub _lock_select {
    my ($self, $type) = @_;
 
-   my $sql = $for_syntax->{$type} || croak "Unknown SELECT .. FOR type '$type' requested";
+   my $sql = $for_syntax->{$type}
+    || $self->throw_exception("Unknown SELECT .. FOR type '$type' requested");
 
    return " $sql";
 }
diff --git a/lib/DBIx/Class/SQLMaker/Oracle.pm b/lib/DBIx/Class/SQLMaker/Oracle.pm
index 3285811..c7b36c5 100644
--- a/lib/DBIx/Class/SQLMaker/Oracle.pm
+++ b/lib/DBIx/Class/SQLMaker/Oracle.pm
@@ -5,12 +5,10 @@ use warnings;
 use strict;
 
 use base qw( DBIx::Class::SQLMaker );
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
-use namespace::clean;
 
 BEGIN {
   use DBIx::Class::Optional::Dependencies;
-  croak('The following extra modules are required for Oracle-based Storages ' . DBIx::Class::Optional::Dependencies->req_missing_for ('id_shortener') )
+  die('The following extra modules are required for Oracle-based Storages ' . DBIx::Class::Optional::Dependencies->req_missing_for ('id_shortener') . "\n" )
     unless DBIx::Class::Optional::Dependencies->req_ok_for ('id_shortener');
 }
 
@@ -138,7 +136,7 @@ sub _shorten_identifier {
   return $to_shorten
     if length($to_shorten) <= $max_len;
 
-  croak 'keywords needs to be an arrayref'
+  $self->throw_exception("'keywords' needs to be an arrayref")
     if defined $keywords && ref $keywords ne 'ARRAY';
 
   # if no keywords are passed use the identifier as one
@@ -228,7 +226,7 @@ sub _insert_returning {
   });
 
   my $rc_ref = $options->{returning_container}
-    or croak ('No returning container supplied for IR values');
+    or $self->throw_exception('No returning container supplied for IR values');
 
   @$rc_ref = (undef) x @f_names;
 
diff --git a/lib/DBIx/Class/SQLMaker/OracleJoins.pm b/lib/DBIx/Class/SQLMaker/OracleJoins.pm
index 2d3ae29..a9a9267 100644
--- a/lib/DBIx/Class/SQLMaker/OracleJoins.pm
+++ b/lib/DBIx/Class/SQLMaker/OracleJoins.pm
@@ -2,8 +2,6 @@ package # Hide from PAUSE
   DBIx::Class::SQLMaker::OracleJoins;
 
 use base qw( DBIx::Class::SQLMaker::Oracle );
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
-use namespace::clean;
 
 sub select {
   my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
@@ -69,7 +67,7 @@ sub _recurse_oracle_joins {
       #TODO: Support full outer joins -- this would happen much earlier in
       #the sequence since oracle 8's full outer join syntax is best
       #described as INSANE.
-      croak "Can't handle full outer joins in Oracle 8 yet!\n"
+      $self->throw_exception("Can't handle full outer joins in Oracle 8 yet!\n")
         if $to_jt->{-join_type} =~ /full/i;
 
       $left_join  = q{(+)} if $to_jt->{-join_type} =~ /left/i
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 47fb863..36c7e16 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use DBIx::Class::Exception;
-use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
+use DBIx::Class::Carp;
 use Try::Tiny;
 use Scalar::Util 'weaken';
 use Sub::Name 'subname';
@@ -1039,8 +1039,8 @@ sub clone {
 
 =back
 
-Throws an exception. Defaults to using L<Carp::Clan> to report errors from
-user's perspective.  See L</exception_action> for details on overriding
+Throws an exception. Obeys the exemption rules of L<DBIx::Class::Carp> to report
+errors from outer-user's perspective. See L</exception_action> for details on overriding
 this method's behavior.  If L</stacktrace> is turned on, C<throw_exception>'s
 default behavior will provide a detailed stack trace.
 
diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index 2ff160f..a7c405c 100644
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -201,7 +201,7 @@ use strict;
 use warnings;
 use base 'DBIx::Class::Schema';
 
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use Time::HiRes qw/gettimeofday/;
 use Try::Tiny;
 use namespace::clean;
@@ -346,7 +346,7 @@ sub upgrade {
 
     # db and schema at same version. do nothing
     if ( $db_version eq $self->schema_version ) {
-        carp "Upgrade not necessary\n";
+        carp 'Upgrade not necessary';
         return;
     }
 
@@ -417,7 +417,7 @@ sub upgrade_single_step
 
   # db and schema at same version. do nothing
   if ($db_version eq $target_version) {
-    carp "Upgrade not necessary\n";
+    carp 'Upgrade not necessary';
     return;
   }
 
@@ -437,7 +437,7 @@ sub upgrade_single_step
   $self->create_upgrade_path({ upgrade_file => $upgrade_file });
 
   unless (-f $upgrade_file) {
-    carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
+    carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one";
     return;
   }
 
@@ -612,18 +612,18 @@ sub _on_connect
 
   if($pversion eq $self->schema_version)
     {
-#         carp "This version is already installed\n";
+        #carp "This version is already installed";
         return 1;
     }
 
   if(!$pversion)
     {
-        carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
+        carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.";
         return 1;
     }
 
   carp "Versions out of sync. This is " . $self->schema_version .
-    ", your database contains version $pversion, please call upgrade on your Schema.\n";
+    ", your database contains version $pversion, please call upgrade on your Schema.";
 }
 
 # is this just a waste of time? if not then merge with DBI.pm
@@ -684,7 +684,7 @@ sub _create_db_to_schema_diff {
   print $file $diff;
   close($file);
 
-  carp "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n";
+  carp "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.";
 }
 
 
diff --git a/lib/DBIx/Class/Serialize/Storable.pm b/lib/DBIx/Class/Serialize/Storable.pm
index b7bba43..23f61cb 100644
--- a/lib/DBIx/Class/Serialize/Storable.pm
+++ b/lib/DBIx/Class/Serialize/Storable.pm
@@ -1,10 +1,9 @@
 package DBIx::Class::Serialize::Storable;
 use strict;
 use warnings;
-use Storable;
 
-use Carp::Clan qw/^DBIx::Class/;
-use namespace::clean;
+use Storable();
+use DBIx::Class::Carp;
 
 carp 'The Serialize::Storable component is now *DEPRECATED*. It has not '
     .'been providing any useful functionality for quite a while, and in fact '
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 2dc005c..fccbedc 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -7,9 +7,8 @@ use warnings;
 use base qw/DBIx::Class::Storage::DBIHacks DBIx::Class::Storage/;
 use mro 'c3';
 
-use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
-use DBI;
-use DBIx::Class::Storage::DBI::Cursor;
+use DBIx::Class::Carp;
+use DBIx::Class::Exception;
 use Scalar::Util qw/refaddr weaken reftype blessed/;
 use List::Util qw/first/;
 use Sub::Name 'subname';
@@ -1305,10 +1304,11 @@ sub _connect {
 
   try {
     if(ref $info[0] eq 'CODE') {
-       $dbh = $info[0]->();
+      $dbh = $info[0]->();
     }
     else {
-       $dbh = DBI->connect(@info);
+      require DBI;
+      $dbh = DBI->connect(@info);
     }
 
     if (!$dbh) {
@@ -1354,7 +1354,7 @@ sub _connect {
           else {
             # the handler may be invoked by something totally out of
             # the scope of DBIC
-            croak ("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]");
+            DBIx::Class::Exception->throw("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]");
           }
         }, '__DBIC__DBH__ERROR__HANDLER__';
       }->($self, $dbh);
diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
index 88627d3..bedf113 100644
--- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
@@ -6,7 +6,7 @@ use base qw/DBIx::Class::Storage::DBI::MSSQL/;
 use mro 'c3';
 use Scalar::Util 'reftype';
 use Try::Tiny;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors(simple => qw/
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 3162d81..04a0628 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -1,9 +1,8 @@
 package DBIx::Class::Storage::DBI::Replicated;
 
 BEGIN {
-  use Carp::Clan qw/^DBIx::Class/;
   use DBIx::Class;
-  croak('The following modules are required for Replication ' . DBIx::Class::Optional::Dependencies->req_missing_for ('replicated') )
+  die('The following modules are required for Replication ' . DBIx::Class::Optional::Dependencies->req_missing_for ('replicated') . "\n" )
     unless DBIx::Class::Optional::Dependencies->req_ok_for ('replicated');
 }
 
@@ -395,7 +394,8 @@ if (DBIx::Class::_ENV_::DBICTEST) {
 
 for my $method (@{$method_dispatch->{unimplemented}}) {
   __PACKAGE__->meta->add_method($method, sub {
-    croak "$method must not be called on ".(blessed shift).' objects';
+    my $self = shift;
+    $self->throw_exception("$method must not be called on ".(blessed $self).' objects');
   });
 }
 
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index 1a8347d..b1e8d38 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -5,7 +5,6 @@ use DBIx::Class::Storage::DBI::Replicated::Replicant;
 use List::Util 'sum';
 use Scalar::Util 'reftype';
 use DBI ();
-use Carp::Clan qw/^DBIx::Class/;
 use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
 use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
 use Try::Tiny;
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
index 906d3ae..24b3ab1 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
@@ -8,7 +8,7 @@ use base qw/
     DBIx::Class::Storage::DBI::AutoCast
 /;
 use mro 'c3';
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use Scalar::Util 'blessed';
 use List::Util 'first';
 use Sub::Name();
@@ -867,24 +867,20 @@ C<SMALLDATETIME> columns only have minute precision.
 
 =cut
 
-{
-  my $old_dbd_warned = 0;
+sub connect_call_datetime_setup {
+  my $self = shift;
+  my $dbh = $self->_get_dbh;
 
-  sub connect_call_datetime_setup {
-    my $self = shift;
-    my $dbh = $self->_get_dbh;
-
-    if ($dbh->can('syb_date_fmt')) {
-      # amazingly, this works with FreeTDS
-      $dbh->syb_date_fmt('ISO_strict');
-    } elsif (not $old_dbd_warned) {
-      carp "Your DBD::Sybase is too old to support ".
-      "DBIx::Class::InflateColumn::DateTime, please upgrade!";
-      $old_dbd_warned = 1;
-    }
+  if ($dbh->can('syb_date_fmt')) {
+    # amazingly, this works with FreeTDS
+    $dbh->syb_date_fmt('ISO_strict');
+  }
+  else {
+    carp_once
+      'Your DBD::Sybase is too old to support '
+     .'DBIx::Class::InflateColumn::DateTime, please upgrade!';
 
     $dbh->do('SET DATEFORMAT mdy');
-
     1;
   }
 }
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
index c238e98..9433bf0 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
@@ -3,8 +3,7 @@ package DBIx::Class::Storage::DBI::Sybase::MSSQL;
 use strict;
 use warnings;
 
-use Carp::Clan qw/^DBIx::Class/;
-use namespace::clean;
+use DBIx::Class::Carp;
 
 carp 'Setting of storage_type is redundant as connections through DBD::Sybase'
     .' are now properly recognized and reblessed into the appropriate subclass'
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
index 0757a4b..068a1a2 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
@@ -9,8 +9,7 @@ use base qw/
 /;
 use mro 'c3';
 
-use Carp::Clan qw/^DBIx::Class/;
-use namespace::clean;
+use DBIx::Class::Carp;
 
 __PACKAGE__->datetime_parser_type(
   'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::DateTime::Format'
@@ -93,21 +92,18 @@ C<SMALLDATETIME> columns only have minute precision.
 
 =cut
 
-{
-  my $old_dbd_warned = 0;
-
-  sub connect_call_datetime_setup {
-    my $self = shift;
-    my $dbh = $self->_get_dbh;
-
-    if ($dbh->can('syb_date_fmt')) {
-      # amazingly, this works with FreeTDS
-      $dbh->syb_date_fmt('ISO_strict');
-    } elsif (not $old_dbd_warned) {
-      carp "Your DBD::Sybase is too old to support ".
-      "DBIx::Class::InflateColumn::DateTime, please upgrade!";
-      $old_dbd_warned = 1;
-    }
+sub connect_call_datetime_setup {
+  my $self = shift;
+  my $dbh = $self->_get_dbh;
+
+  if ($dbh->can('syb_date_fmt')) {
+    # amazingly, this works with FreeTDS
+    $dbh->syb_date_fmt('ISO_strict');
+  }
+  else{
+    carp_once
+      'Your DBD::Sybase is too old to support '
+    . 'DBIx::Class::InflateColumn::DateTime, please upgrade!';
   }
 }
 
diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index defcecd..c391a2c 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -13,7 +13,6 @@ use warnings;
 use base 'DBIx::Class::Storage';
 use mro 'c3';
 
-use Carp::Clan qw/^DBIx::Class/;
 use List::Util 'first';
 use Scalar::Util 'blessed';
 use namespace::clean;
diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
index 56c8c81..d5291fa 100644
--- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm
+++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
@@ -2,10 +2,10 @@ package DBIx::Class::Storage::TxnScopeGuard;
 
 use strict;
 use warnings;
-use Carp::Clan qw/^DBIx::Class/;
 use Try::Tiny;
 use Scalar::Util qw/weaken blessed/;
 use DBIx::Class::Exception;
+use DBIx::Class::Carp;
 
 # temporary until we fix the $@ issue in core
 # we also need a real appendable, stackable exception object
diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index af8e117..06b5548 100644
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -14,7 +14,8 @@ $DEBUG = 0 unless defined $DEBUG;
 
 use Exporter;
 use SQL::Translator::Utils qw(debug normalize_name);
-use Carp::Clan qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/;
+use DBIx::Class::Carp qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/;
+use DBIx::Class::Exception;
 use Scalar::Util qw/weaken blessed/;
 use Try::Tiny;
 use namespace::clean;
@@ -43,10 +44,10 @@ sub parse {
     $dbicschema     ||= $args->{'package'};
     my $limit_sources = $args->{'sources'};
 
-    croak 'No DBIx::Class::Schema' unless ($dbicschema);
+    DBIx::Class::Exception->throw('No DBIx::Class::Schema') unless ($dbicschema);
     if (!ref $dbicschema) {
       eval "require $dbicschema"
-        or croak "Can't load $dbicschema: $@";
+        or DBIx::Class::Exception->throw("Can't load $dbicschema: $@");
     }
 
     my $schema      = $tr->schema;
diff --git a/t/53lean_startup.t b/t/53lean_startup.t
index 3bc55e9..d9f902e 100644
--- a/t/53lean_startup.t
+++ b/t/53lean_startup.t
@@ -40,14 +40,12 @@ BEGIN {
     Hash::Merge
 
     DBI
+    SQL::Abstract
 
     Carp
-    Carp::Clan
 
     Class::Accessor::Grouped
     Class::C3::Componentised
-
-    SQL::Abstract
   /, $] < 5.010 ? 'MRO::Compat' : () };
 
   $test_hook = sub {
diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t
index 85c288b..2556546 100644
--- a/t/55namespaces_cleaned.t
+++ b/t/55namespaces_cleaned.t
@@ -79,13 +79,16 @@ for my $mod (@modules) {
       my $gv = svref_2object($all_method_like{$name})->GV;
       my $origin = $gv->STASH->NAME;
 
-      next if $seen->{"${origin}:${name}"}++;
-
       TODO: {
         local $TODO = 'CAG does not clean its BEGIN constants' if $name =~ /^__CAG_/;
-        is ($gv->NAME, $name, "Properly named $name method at $origin");
+        is ($gv->NAME, $name, "Properly named $name method at $origin" . ($origin eq $mod
+          ? ''
+          : " (inherited by $mod)"
+        ));
       }
 
+      next if $seen->{"${origin}:${name}"}++;
+
       if ($origin eq $mod) {
         pass ("$name is a native $mod method");
       }
@@ -108,6 +111,25 @@ for my $mod (@modules) {
         );
       }
     }
+
+    # some common import names (these should never ever be methods)
+    for my $f (qw/carp carp_once carp_unique croak confess cluck try catch finally/) {
+      if ($mod->can($f)) {
+        my $via;
+        for (reverse @{mro::get_linear_isa($mod)} ) {
+          if ( ($_->can($f)||'') eq $all_method_like{$f} ) {
+            $via = $_;
+            last;
+          }
+        }
+        fail ("Import $f leaked into method list of ${mod}, appears to have entered inheritance chain at "
+            . ($via || 'UNKNOWN')
+        );
+      }
+      else {
+        pass ("Import $f not leaked into method list of $mod");
+      }
+    }
   }
 }
 
diff --git a/t/85utf8.t b/t/85utf8.t
index 13b0398..af6dedf 100644
--- a/t/85utf8.t
+++ b/t/85utf8.t
@@ -35,6 +35,20 @@ warnings_are (
   'no spurious warnings issued',
 );
 
+warnings_like (
+  sub {
+    package A::Test1Loud;
+    use base 'DBIx::Class::Core';
+    __PACKAGE__->load_components(qw(Core +A::Comp Ordered UTF8Columns));
+    __PACKAGE__->load_components(qw(Ordered +A::SubComp Row UTF8Columns Core));
+    sub store_column { shift->next::method (@_) };
+    1;
+  },
+  [qr/Use of DBIx::Class::UTF8Columns is strongly discouraged/],
+  'issued deprecation warning',
+);
+
+
 my $test1_mro;
 my $idx = 0;
 for (@{mro::get_linear_isa ('A::Test1')} ) {
diff --git a/t/94versioning.t b/t/94versioning.t
index 8306af5..a2e4007 100644
--- a/t/94versioning.t
+++ b/t/94versioning.t
@@ -155,7 +155,7 @@ my $schema_v3 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_versio
 
 # attempt v1 -> v3 upgrade
 {
-  local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ };
+  local $SIG{__WARN__} = sub { warn $_[0] if $_[0] !~ /Attempting upgrade\.$/ };
   $schema_v3->upgrade();
   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
 }
@@ -180,7 +180,7 @@ system( qq($^X -pi -e "s/ALTER/-- this is a comment\nALTER/" $fn->{trans_v23};)
 
 # Then attempt v1 -> v3 upgrade
 {
-  local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ };
+  local $SIG{__WARN__} = sub { warn $_[0] if $_[0] !~ /Attempting upgrade\.$/ };
   $schema_v3->upgrade();
   is($schema_v3->get_db_version(), '3.0', 'db version number upgraded to 3.0');
 
@@ -234,7 +234,7 @@ system( qq($^X -pi -e "s/ALTER/-- this is a comment\nALTER/" $fn->{trans_v23};)
     $schema_v2->deploy;
   }
 
-  local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ };
+  local $SIG{__WARN__} = sub { warn $_[0] if $_[0] !~ /Attempting upgrade\.$/ };
   $schema_v2->upgrade();
 
   is($schema_v2->get_db_version(), '3.0', 'Fast deploy/upgrade');
diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index bccf8cf..46e0918 100644
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -78,7 +78,7 @@ sub _database {
     for ($db_file, "${db_file}-journal") {
       next unless -e $_;
       unlink ($_) or carp (
-        "Unable to unlink existing test database file $_ ($!), creation of fresh database / further tests may fail!\n"
+        "Unable to unlink existing test database file $_ ($!), creation of fresh database / further tests may fail!"
       );
     }
 
diff --git a/t/sqlmaker/oraclejoin.t b/t/sqlmaker/oraclejoin.t
index 24901a6..3ba82ab 100644
--- a/t/sqlmaker/oraclejoin.t
+++ b/t/sqlmaker/oraclejoin.t
@@ -10,8 +10,8 @@ BEGIN {
 }
 
 use lib qw(t/lib);
-use DBIx::Class::SQLMaker::OracleJoins;
 use DBICTest;
+use DBIx::Class::SQLMaker::OracleJoins;
 use DBIC::SqlMakerTest;
 
 my $sa = DBIx::Class::SQLMaker::OracleJoins->new;
diff --git a/xt/podcoverage.t b/xt/podcoverage.t
index caaeca4..be4bbbb 100644
--- a/xt/podcoverage.t
+++ b/xt/podcoverage.t
@@ -42,6 +42,11 @@ my $exceptions = {
             mk_classaccessor
         /]
     },
+    'DBIx::Class::Carp' => {
+        ignore => [qw/
+            unimport
+        /]
+    },
     'DBIx::Class::Row' => {
         ignore => [qw/
             MULTICREATE_DEBUG