better error reporting for schema load failures, hopefully...
authorivan <ivan>
Sat, 26 Aug 2006 14:37:11 +0000 (14:37 +0000)
committerivan <ivan>
Sat, 26 Aug 2006 14:37:11 +0000 (14:37 +0000)
Changes
DBSchema.pm

diff --git a/Changes b/Changes
index dcfcd3a..10575f8 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,8 +1,9 @@
 Revision history for Perl extension DBIx::DBSchema.
 
-0.31 unreleased
+0.32 unreleased
        - increment the version numbers in Column.pm and Table.pm and the
          "use" statements accordingly
+       - Error reporting for load constructor
 
 0.31 Thu Mar 30 05:28:20 PST 2006
        - more schema update stuff:
index d7d6dc0..9266480 100644 (file)
@@ -1,7 +1,7 @@
 package DBIx::DBSchema;
 
 use strict;
-use vars qw(@ISA $VERSION $DEBUG);
+use vars qw(@ISA $VERSION $DEBUG $errstr);
 #use Exporter;
 use Storable;
 use DBIx::DBSchema::_util qw(_load_driver _dbh);
@@ -13,7 +13,7 @@ use DBIx::DBSchema::ColGroup::Index;
 #@ISA = qw(Exporter);
 @ISA = ();
 
-$VERSION = "0.31";
+$VERSION = "0.32";
 $DEBUG = 0;
 
 =head1 NAME
@@ -31,7 +31,7 @@ DBIx::DBSchema - Database-independent schema objects
   $schema = new_native DBIx::DBSchema $dsn, $user, $pass;
 
   $schema->save("filename");
-  $schema = load DBIx::DBSchema "filename";
+  $schema = load DBIx::DBSchema "filename" or die $DBIx::DBSchema::errstr;
 
   $schema->addtable($dbix_dbschema_table_object);
 
@@ -128,7 +128,8 @@ sub new_native {
 
 =item load FILENAME
 
-Loads a DBIx::DBSchema object from a file.
+Loads a DBIx::DBSchema object from a file.  If there is an error, returns
+false and puts an error message in $DBIx::DBSchema::errstr;
 
 =cut
 
@@ -141,12 +142,23 @@ sub load {
   eval { $self = Storable::retrieve($file); };
 
   if ( $@ && $@ =~ /not.*storable/i ) { #then try FreezeThaw
+    my $olderror = $@;
+
     eval "use FreezeThaw;";
-    die $@ if $@;
-    open(FILE,"<$file") or die "Can't open $file: $!";
-    my $string = join('',<FILE>);
-    close FILE or die "Can't close $file: $!";
-    ($self) = FreezeThaw::thaw($string);
+    if ( $@ ) {
+      $@ = $olderror;
+    } else { 
+      open(FILE,"<$file")
+        or do { $errstr = "Can't open $file: $!"; return ''; };
+      my $string = join('',<FILE>);
+      close FILE
+        or do { $errstr = "Can't close $file: $!"; return ''; };
+      ($self) = FreezeThaw::thaw($string);
+    }
+  }
+
+  unless ( $self ) {
+    $errstr = $@;
   }
 
   $self;