From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 19 Mar 2011 11:40:45 +0000 (+0100)
Subject: Cleanup that namespacing mess
X-Git-Tag: v0.08191~58
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=9c1700e39e6ee002d9294c0d988882d1f0d7d86f

Cleanup that namespacing mess
---

diff --git a/Changes b/Changes
index db1bbae..b4693a4 100644
--- a/Changes
+++ b/Changes
@@ -34,6 +34,7 @@ Revision history for DBIx::Class
         - 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)
+        - Make sure all namespaces are clean of rogue imports
 
 0.08127 2011-01-19 16:40 (UTC)
     * New Features / Changes
diff --git a/Makefile.PL b/Makefile.PL
index 71b477f..824a047 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -58,7 +58,7 @@ my $test_requires = {
 my $runtime_requires = {
   'Carp::Clan'               => '6.0',
   'Class::Accessor::Grouped' => '0.10002',
-  'Class::C3::Componentised' => '1.0008',
+  'Class::C3::Componentised' => '1.0009',
   'Class::Inspector'         => '1.24',
   'Config::Any'              => '0.20',
   'Context::Preserve'        => '0.01',
diff --git a/lib/DBIx/Class/Admin/Descriptive.pm b/lib/DBIx/Class/Admin/Descriptive.pm
index 45fcb19..9326fca 100644
--- a/lib/DBIx/Class/Admin/Descriptive.pm
+++ b/lib/DBIx/Class/Admin/Descriptive.pm
@@ -1,10 +1,10 @@
 package     # hide from PAUSE
     DBIx::Class::Admin::Descriptive;
 
-use DBIx::Class::Admin::Usage;
 
 use base 'Getopt::Long::Descriptive';
 
+require DBIx::Class::Admin::Usage;
 sub usage_class { 'DBIx::Class::Admin::Usage'; }
 
 1;
diff --git a/lib/DBIx/Class/Componentised.pm b/lib/DBIx/Class/Componentised.pm
index 57b143b..7e398ca 100644
--- a/lib/DBIx/Class/Componentised.pm
+++ b/lib/DBIx/Class/Componentised.pm
@@ -5,9 +5,12 @@ use strict;
 use warnings;
 
 use base 'Class::C3::Componentised';
-use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/;
 use mro 'c3';
 
+use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/;
+use namespace::clean;
+
+
 my $warned;
 
 # this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column
diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm
index 083b83d..c81cda9 100644
--- a/lib/DBIx/Class/DB.pm
+++ b/lib/DBIx/Class/DB.pm
@@ -17,13 +17,9 @@ unless ($INC{"DBIx/Class/CDBICompat.pm"}) {
 
 __PACKAGE__->load_components(qw/ResultSetProxy/);
 
-{
-    no warnings 'once';
-    *dbi_commit = \&txn_commit;
-    *dbi_rollback = \&txn_rollback;
-}
-
 sub storage { shift->schema_instance(@_)->storage; }
+sub dbi_commit { shift->txn_commit(@_) }
+sub dbi_rollback { shift->txn_rollback(@_) }
 
 =head1 NAME
 
diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm
index e9de5da..2c6a955 100644
--- a/lib/DBIx/Class/InflateColumn.pm
+++ b/lib/DBIx/Class/InflateColumn.pm
@@ -2,7 +2,6 @@ package DBIx::Class::InflateColumn;
 
 use strict;
 use warnings;
-use Scalar::Util qw/blessed/;
 
 use base qw/DBIx::Class::Row/;
 
diff --git a/lib/DBIx/Class/InflateColumn/File.pm b/lib/DBIx/Class/InflateColumn/File.pm
index 951b76e..634bafc 100644
--- a/lib/DBIx/Class/InflateColumn/File.pm
+++ b/lib/DBIx/Class/InflateColumn/File.pm
@@ -6,8 +6,9 @@ use base 'DBIx::Class';
 use File::Path;
 use File::Copy;
 use Path::Class;
-
 use Carp::Clan qw/^DBIx::Class/;
+use namespace::clean;
+
 carp 'InflateColumn::File has entered a deprecation cycle. This component '
     .'has a number of architectural deficiencies that can quickly drive '
     .'your filesystem and database out of sync and is not recommended '
@@ -18,6 +19,8 @@ carp 'InflateColumn::File has entered a deprecation cycle. This component '
     .'DBIC_IC_FILE_NOWARN to a true value to disable  this warning.'
 unless $ENV{DBIC_IC_FILE_NOWARN};
 
+
+
 __PACKAGE__->load_components(qw/InflateColumn/);
 
 sub register_column {
diff --git a/lib/DBIx/Class/Optional/Dependencies.pm b/lib/DBIx/Class/Optional/Dependencies.pm
index 6f7c10d..9caf05b 100644
--- a/lib/DBIx/Class/Optional/Dependencies.pm
+++ b/lib/DBIx/Class/Optional/Dependencies.pm
@@ -3,7 +3,7 @@ package DBIx::Class::Optional::Dependencies;
 use warnings;
 use strict;
 
-use Carp;
+use Carp ();
 
 # NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
 # This module is to be loaded by Makefile.PM on a pristine system
@@ -411,11 +411,11 @@ my $reqs = {
 sub req_list_for {
   my ($class, $group) = @_;
 
-  croak "req_list_for() expects a requirement group name"
+  Carp::croak "req_list_for() expects a requirement group name"
     unless $group;
 
   my $deps = $reqs->{$group}{req}
-    or croak "Requirement group '$group' does not exist";
+    or Carp::croak "Requirement group '$group' does not exist";
 
   return { %$deps };
 }
@@ -425,7 +425,7 @@ our %req_availability_cache;
 sub req_ok_for {
   my ($class, $group) = @_;
 
-  croak "req_ok_for() expects a requirement group name"
+  Carp::croak "req_ok_for() expects a requirement group name"
     unless $group;
 
   return $class->_check_deps($group)->{status};
@@ -434,7 +434,7 @@ sub req_ok_for {
 sub req_missing_for {
   my ($class, $group) = @_;
 
-  croak "req_missing_for() expects a requirement group name"
+  Carp::croak "req_missing_for() expects a requirement group name"
     unless $group;
 
   return $class->_check_deps($group)->{missing};
@@ -443,7 +443,7 @@ sub req_missing_for {
 sub req_errorlist_for {
   my ($class, $group) = @_;
 
-  croak "req_errorlist_for() expects a requirement group name"
+  Carp::croak "req_errorlist_for() expects a requirement group name"
     unless $group;
 
   return $class->_check_deps($group)->{errorlist};
@@ -661,7 +661,7 @@ EOD
     'You may distribute this code under the same terms as Perl itself',
   );
 
-  open (my $fh, '>', $podfn) or croak "Unable to write to $podfn: $!";
+  open (my $fh, '>', $podfn) or Carp::croak "Unable to write to $podfn: $!";
   print $fh join ("\n\n", @chunks);
   close ($fh);
 }
diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm
index c46f00c..39155a7 100644
--- a/lib/DBIx/Class/Relationship/CascadeActions.pm
+++ b/lib/DBIx/Class/Relationship/CascadeActions.pm
@@ -4,6 +4,7 @@ package # hide from PAUSE
 use strict;
 use warnings;
 use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
+use namespace::clean;
 
 our %_pod_inherit_config = 
   (
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 8f894a0..5ded4b7 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -12,15 +12,14 @@ use Try::Tiny;
 # not importing first() as it will clash with our own method
 use List::Util ();
 
-use namespace::clean;
-
-
 BEGIN {
   # De-duplication in _merge_attr() is disabled, but left in for reference
   # (the merger is used for other things that ought not to be de-duped)
   *__HM_DEDUP = sub () { 0 };
 }
 
+use namespace::clean;
+
 use overload
         '0+'     => "count",
         'bool'   => "_bool",
diff --git a/lib/DBIx/Class/ResultSetColumn.pm b/lib/DBIx/Class/ResultSetColumn.pm
index 0879585..8c2962c 100644
--- a/lib/DBIx/Class/ResultSetColumn.pm
+++ b/lib/DBIx/Class/ResultSetColumn.pm
@@ -5,8 +5,9 @@ use warnings;
 
 use base 'DBIx::Class';
 
-use Carp::Clan qw/^DBIx::Class/;
 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/Row.pm b/lib/DBIx/Class/Row.pm
index 380f1db..5985209 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -8,7 +8,6 @@ use base qw/DBIx::Class/;
 use DBIx::Class::Exception;
 use Scalar::Util 'blessed';
 use Try::Tiny;
-use namespace::clean;
 
 ###
 ### Internal method
@@ -21,6 +20,8 @@ BEGIN {
       : sub () { 0 };
 }
 
+use namespace::clean;
+
 =head1 NAME
 
 DBIx::Class::Row - Basic row methods
diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm
index cb9dcd8..1340165 100644
--- a/lib/DBIx/Class/SQLMaker.pm
+++ b/lib/DBIx/Class/SQLMaker.pm
@@ -73,6 +73,9 @@ BEGIN {
         }
       };
   }
+
+  # Current SQLA pollutes its namespace - clean for the time being
+  namespace::clean->clean_subroutines(qw/SQL::Abstract carp croak confess/);
 }
 
 # the "oh noes offset/top without limit" constant
diff --git a/lib/DBIx/Class/SQLMaker/MSSQL.pm b/lib/DBIx/Class/SQLMaker/MSSQL.pm
index 30b0c96..f64d972 100644
--- a/lib/DBIx/Class/SQLMaker/MSSQL.pm
+++ b/lib/DBIx/Class/SQLMaker/MSSQL.pm
@@ -2,7 +2,6 @@ package # Hide from PAUSE
   DBIx::Class::SQLMaker::MSSQL;
 
 use base qw( DBIx::Class::SQLMaker );
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 
 #
 # MSSQL does not support ... OVER() ... RNO limits
diff --git a/lib/DBIx/Class/SQLMaker/MySQL.pm b/lib/DBIx/Class/SQLMaker/MySQL.pm
index ccb1195..4eefc9d 100644
--- a/lib/DBIx/Class/SQLMaker/MySQL.pm
+++ b/lib/DBIx/Class/SQLMaker/MySQL.pm
@@ -3,6 +3,7 @@ package # Hide from PAUSE
 
 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
diff --git a/lib/DBIx/Class/SQLMaker/Oracle.pm b/lib/DBIx/Class/SQLMaker/Oracle.pm
index 5c0f7cd..400fc63 100644
--- a/lib/DBIx/Class/SQLMaker/Oracle.pm
+++ b/lib/DBIx/Class/SQLMaker/Oracle.pm
@@ -6,9 +6,9 @@ use strict;
 
 use base qw( DBIx::Class::SQLMaker );
 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
+use namespace::clean;
 
 BEGIN {
-  use Carp::Clan qw/^DBIx::Class/;
   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') )
     unless DBIx::Class::Optional::Dependencies->req_ok_for ('id_shortener');
diff --git a/lib/DBIx/Class/SQLMaker/OracleJoins.pm b/lib/DBIx/Class/SQLMaker/OracleJoins.pm
index 3bc8ec9..2d3ae29 100644
--- a/lib/DBIx/Class/SQLMaker/OracleJoins.pm
+++ b/lib/DBIx/Class/SQLMaker/OracleJoins.pm
@@ -3,6 +3,7 @@ package # Hide from PAUSE
 
 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) = @_;
diff --git a/lib/DBIx/Class/SQLMaker/SQLite.pm b/lib/DBIx/Class/SQLMaker/SQLite.pm
index 50acef2..acf0337 100644
--- a/lib/DBIx/Class/SQLMaker/SQLite.pm
+++ b/lib/DBIx/Class/SQLMaker/SQLite.pm
@@ -2,7 +2,6 @@ package # Hide from PAUSE
   DBIx::Class::SQLMaker::SQLite;
 
 use base qw( DBIx::Class::SQLMaker );
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 
 #
 # SQLite does not understand SELECT ... FOR UPDATE
diff --git a/lib/DBIx/Class/Serialize/Storable.pm b/lib/DBIx/Class/Serialize/Storable.pm
index 7d57aea..b7bba43 100644
--- a/lib/DBIx/Class/Serialize/Storable.pm
+++ b/lib/DBIx/Class/Serialize/Storable.pm
@@ -4,6 +4,7 @@ use warnings;
 use Storable;
 
 use Carp::Clan qw/^DBIx::Class/;
+use namespace::clean;
 
 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/Sybase/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
index 04eda45..c238e98 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use Carp::Clan qw/^DBIx::Class/;
+use namespace::clean;
 
 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 71d6e34..0757a4b 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
@@ -8,7 +8,9 @@ use base qw/
   DBIx::Class::Storage::DBI::MSSQL
 /;
 use mro 'c3';
+
 use Carp::Clan qw/^DBIx::Class/;
+use namespace::clean;
 
 __PACKAGE__->datetime_parser_type(
   'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::DateTime::Format'
diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm
index d4937d1..714c8fb 100644
--- a/lib/DBIx/Class/Storage/Statistics.pm
+++ b/lib/DBIx/Class/Storage/Statistics.pm
@@ -4,6 +4,7 @@ use warnings;
 
 use base qw/DBIx::Class/;
 use IO::File;
+use namespace::clean;
 
 __PACKAGE__->mk_group_accessors(simple => qw/callback _debugfh silence/);
 
diff --git a/lib/DBIx/Class/Storage/TxnScopeGuard.pm b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
index 843ad91..56c8c81 100644
--- a/lib/DBIx/Class/Storage/TxnScopeGuard.pm
+++ b/lib/DBIx/Class/Storage/TxnScopeGuard.pm
@@ -6,7 +6,6 @@ use Carp::Clan qw/^DBIx::Class/;
 use Try::Tiny;
 use Scalar::Util qw/weaken blessed/;
 use DBIx::Class::Exception;
-use namespace::clean;
 
 # temporary until we fix the $@ issue in core
 # we also need a real appendable, stackable exception object
@@ -20,6 +19,8 @@ BEGIN {
   }
 }
 
+use namespace::clean;
+
 my ($guards_count, $compat_handler, $foreign_handler);
 
 sub new {
diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t
new file mode 100644
index 0000000..faf98b9
--- /dev/null
+++ b/t/55namespaces_cleaned.t
@@ -0,0 +1,131 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use File::Find;
+use File::Spec;
+use B qw/svref_2object/;
+
+# makes sure we can load at least something
+use DBIx::Class;
+
+my @modules = grep {
+  my $mod = $_;
+
+  # trap deprecation warnings and whatnot
+  local $SIG{__WARN__} = sub {};
+
+  # not all modules are loadable at all times
+  eval "require $mod" ? $mod : do {
+    SKIP: { skip "Failed require of $mod: $@", 1 }A
+    ();
+  };
+
+
+} find_modules();
+
+# have an exception table for old and/or weird code we are not sure
+# we *want* to clean in the first place
+my $skip_idx = { map { $_ => 1 } (
+  (grep { /^DBIx::Class::CDBICompat/ } @modules), # too crufty to touch
+  'SQL::Translator::Producer::DBIx::Class::File', # ditto
+
+  # not sure how to handle type libraries
+  'DBIx::Class::Storage::DBI::Replicated::Types',
+  'DBIx::Class::Admin::Types',
+
+  # G::L::D is unclean, but we never inherit from it
+  'DBIx::Class::Admin::Descriptive',
+  'DBIx::Class::Admin::Usage',
+) };
+
+my $has_cmop = eval { require Class::MOP };
+
+# can't use Class::Inspector for the mundane parts as it does not
+# distinguish imports from anything else, what a crock of...
+# Class::MOP is not always available either - hence just do it ourselves
+
+my $seen; #inheritance means we will see the same method multiple times
+
+for my $mod (@modules) {
+  SKIP: {
+    skip "$mod exempt from namespace checks",1 if $skip_idx->{$mod};
+
+    my %all_method_like = do {
+      no strict 'refs';
+      map {
+        my $m = $_;
+        map
+          { *{"${m}::$_"}{CODE} ? ( $_ => *{"${m}::$_"}{CODE} ) : () }
+          keys %{"${m}::"}
+      } (reverse @{mro::get_linear_isa($mod)});
+    };
+
+    my %parents = map { $_ => 1 } @{mro::get_linear_isa($mod)};
+
+    my %roles;
+    if ($has_cmop and my $mc = Class::MOP::class_of($mod)) {
+      if ($mc->can('calculate_all_roles_with_inheritance')) {
+        $roles{$_->name} = 1 for ($mc->calculate_all_roles_with_inheritance);
+      }
+    }
+
+    for my $name (keys %all_method_like) {
+
+      # overload is a funky thing - it is neither cleaned, and its imports are named funny
+      next if $name =~ /^\(/;
+
+      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");
+      }
+
+      if ($origin eq $mod) {
+        pass ("$name is a native $mod method");
+      }
+      elsif ($roles{$origin}) {
+        pass ("${mod}::${name} came from consumption of role $origin");
+      }
+      elsif ($parents{$origin}) {
+        pass ("${mod}::${name} came from proper parent-class $origin");
+      }
+      else {
+        my $via;
+        for (reverse @{mro::get_linear_isa($mod)} ) {
+          if ( ($_->can($name)||'') eq $all_method_like{$name} ) {
+            $via = $_;
+            last;
+          }
+        }
+        fail ("${mod}::${name} appears to have entered inheritance chain by import into "
+            . ($via || 'UNKNOWN')
+        );
+      }
+    }
+  }
+}
+
+sub find_modules {
+  my @modules;
+
+  find({
+    wanted => sub {
+      -f $_ or return;
+      s/\.pm$// or return;
+      s/^ (?: lib | blib . (?:lib|arch) ) . //x;
+      push @modules, join ('::', File::Spec->splitdir($_));
+    },
+    no_chdir => 1,
+  }, (-e 'blib' ? 'blib' : 'lib') );
+
+  return sort @modules;
+}
+
+
+done_testing;