X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=1448bc396b51941e92be91f24c4840009035684f;hb=3b80fa31b60050d4c8df91457ba6fd51b579a7a6;hp=dfa2e1e78ba299a531be0148c6359f0e8d5c17dd;hpb=e1a97e2459751c5151128c30900749c7143bc650;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index dfa2e1e..1448bc3 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -12,10 +12,8 @@ use DBI;
 use DBIx::Class::Storage::DBI::Cursor;
 use Scalar::Util qw/refaddr weaken reftype blessed/;
 use List::Util qw/first/;
-use Data::Dumper::Concise 'Dumper';
 use Sub::Name 'subname';
 use Try::Tiny;
-use File::Path 'make_path';
 use overload ();
 use namespace::clean;
 
@@ -1161,7 +1159,13 @@ sub _server_info {
 }
 
 sub _get_server_version {
-  shift->_get_dbh->get_info(18);
+  shift->_dbh_get_info(18);
+}
+
+sub _dbh_get_info {
+  my ($self, $info) = @_;
+
+  return try { $self->_get_dbh->get_info($info) } || undef;
 }
 
 sub _determine_driver {
@@ -1205,6 +1209,8 @@ sub _determine_driver {
 
     $self->_driver_determined(1);
 
+    Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
+
     $self->_init; # run driver-specific initializations
 
     $self->_run_connection_actions
@@ -1770,10 +1776,11 @@ sub insert_bulk {
       $msg,
       $cols->[$col_idx],
       do {
+        require Data::Dumper::Concise;
         local $Data::Dumper::Maxdepth = 1; # don't dump objects, if any
-        Dumper {
+        Data::Dumper::Concise::Dumper ({
           map { $cols->[$_] => $data->[$slice_idx][$_] } (0 .. $#$cols)
-        },
+        }),
       }
     );
   };
@@ -1914,9 +1921,10 @@ sub _execute_array {
     $self->throw_exception("Unexpected populate error: $err")
       if ($i > $#$tuple_status);
 
+    require Data::Dumper::Concise;
     $self->throw_exception(sprintf "%s for populate slice:\n%s",
       ($tuple_status->[$i][1] || $err),
-      Dumper { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) },
+      Data::Dumper::Concise::Dumper( { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) } ),
     );
   }
 
@@ -2566,10 +2574,10 @@ sub create_ddl_dir {
   } else {
       -d $dir
         or
-      make_path ("$dir")  # make_path does not like objects (i.e. Path::Class::Dir)
+      (require File::Path and File::Path::make_path ("$dir"))  # make_path does not like objects (i.e. Path::Class::Dir)
         or
       $self->throw_exception(
-        "Failed to create '$dir': " . ($! || $@ || 'error unknow')
+        "Failed to create '$dir': " . ($! || $@ || 'error unknown')
       );
   }
 
@@ -2724,6 +2732,7 @@ sub deployment_statements {
   my $filename = $schema->ddl_filename($type, $version, $dir);
   if(-f $filename)
   {
+      # FIXME replace this block when a proper sane sql parser is available
       my $file;
       open($file, "<$filename")
         or $self->throw_exception("Can't open $filename ($!)");
@@ -2762,12 +2771,14 @@ sub deployment_statements {
   return wantarray ? @ret : $ret[0];
 }
 
+# FIXME deploy() currently does not accurately report sql errors
+# Will always return true while errors are warned
 sub deploy {
   my ($self, $schema, $type, $sqltargs, $dir) = @_;
   my $deploy = sub {
     my $line = shift;
-    return if($line =~ /^--/);
     return if(!$line);
+    return if($line =~ /^--/);
     # next if($line =~ /^DROP/m);
     return if($line =~ /^BEGIN TRANSACTION/m);
     return if($line =~ /^COMMIT/m);
@@ -2789,7 +2800,8 @@ sub deploy {
     }
   }
   elsif (@statements == 1) {
-    foreach my $line ( split(";\n", $statements[0])) {
+    # split on single line comments and end of statements
+    foreach my $line ( split(/\s*--.*\n|;\n/, $statements[0])) {
       $deploy->( $line );
     }
   }
@@ -2925,12 +2937,27 @@ sub _max_column_bytesize {
 }
 
 # Determine if a data_type is some type of BLOB
+# FIXME: these regexes are expensive, result of these checks should be cached in
+# the column_info .
 sub _is_lob_type {
   my ($self, $data_type) = @_;
-  $data_type && ($data_type =~ /(?:lob|bfile|text|image|bytea|memo)/i
-    || $data_type =~ /^long(?:\s*(?:raw|bit\s*varying|varbit|binary
+  $data_type && ($data_type =~ /lob|bfile|text|image|bytea|memo/i
+    || $data_type =~ /^long(?:\s+(?:raw|bit\s*varying|varbit|binary
                                   |varchar|character\s*varying|nvarchar
-                                  |national\s*character\s*varying))?$/xi);
+                                  |national\s*character\s*varying))?\z/xi);
+}
+
+sub _is_binary_lob_type {
+  my ($self, $data_type) = @_;
+  $data_type && ($data_type =~ /blob|bfile|image|bytea/i
+    || $data_type =~ /^long(?:\s+(?:raw|bit\s*varying|varbit|binary))?\z/xi);
+}
+
+sub _is_text_lob_type {
+  my ($self, $data_type) = @_;
+  $data_type && ($data_type =~ /^(?:clob|memo)\z/i
+    || $data_type =~ /^long(?:\s+(?:varchar|character\s*varying|nvarchar
+                        |national\s*character\s*varying))\z/xi);
 }
 
 1;