Merge 'trunk' into 'cdbicompat_integration'
Michael G Schwern [Fri, 7 Mar 2008 15:54:18 +0000 (15:54 +0000)]
r54995@windhund (orig r4113):  ash | 2008-03-01 13:17:54 +0100
Fix versioning test so it works with SQLT 0.09.
r54996@windhund (orig r4114):  ash | 2008-03-04 13:06:34 +0100
is_deferrable patch from Debolaz
r55001@windhund (orig r4119):  teejay | 2008-03-04 20:29:45 +0100
Applied fixes to replication connect_info method
r55002@windhund (orig r4120):  teejay | 2008-03-04 20:31:32 +0100
Applied fixes to replication connect_info method
r55003@windhund (orig r4121):  teejay | 2008-03-04 21:18:45 +0100
works but shouldn't
r55004@windhund (orig r4122):  teejay | 2008-03-04 21:41:32 +0100
roughly DTRT - please to be making less awful
r55008@windhund (orig r4126):  captainL | 2008-03-05 01:07:45 +0100
 r3439@luke-mbp (orig r3680):  captainL | 2007-08-15 13:56:57 +0100
 new branch for ::Versioned enhancements
 r3503@luke-mbp (orig r3681):  captainL | 2007-08-15 14:29:01 +0100
 created ->get_db_version and moved all overridable stuff to do_upgrade
 r3955@luke-mbp (orig r3682):  captainL | 2007-08-15 23:29:57 +0100
 tests are a mess, but Versioned.pm should work now
 r3956@luke-mbp (orig r3683):  captainL | 2007-08-16 00:45:32 +0100
 moved upgrade file reading into upgrade from _on_connect
 r3958@luke-mbp (orig r3689):  captainL | 2007-08-21 12:56:31 +0100
 works well, we now just require a nice way to deploy the SchemaVersions table
 r3959@luke-mbp (orig r3692):  captainL | 2007-08-21 17:58:17 +0100
 determines parser from dbh driver name and gives parser the dbh from schema to connect
 r4213@luke-mbp (orig r3831):  captainL | 2007-10-23 13:18:13 +0100
 fixed versioning test and checked db and schema versions are not equal before upgrading
 r4214@luke-mbp (orig r3832):  captainL | 2007-10-23 15:08:46 +0100
 changed constraint and index generation to be consistent with DB defaults
 r4215@luke-mbp (orig r3833):  captainL | 2007-10-23 15:40:47 +0100
 added entry to Changes
 r4283@luke-mbp (orig r3838):  captainL | 2007-10-24 21:42:22 +0100
 fixed broken regex when reading sql files
 r5785@luke-mbp (orig r3891):  ash | 2007-11-24 22:17:41 +0000
 Change diffing code to use $sqlt_schema. Sort tables in parser
 r5786@luke-mbp (orig r3892):  captainL | 2007-11-25 16:26:57 +0000
 upgrade will only produce a diff between the DB and the DBIC schema if explicitly requested
 r5824@luke-mbp (orig r4012):  ash | 2008-02-01 19:33:00 +0000
 Fallback to SQL->SQL to diff for old producers
 r5825@luke-mbp (orig r4014):  castaway | 2008-02-01 23:01:26 +0000
 Sanitise filename of sqlite backup file

 r5830@luke-mbp (orig r4047):  captainL | 2008-02-09 15:26:50 +0000
 sanified layout of Versioned.pm and documented changes
 r6828@luke-mbp (orig r4075):  ash | 2008-02-13 13:26:10 +0000
 Fix typo
 r6831@luke-mbp (orig r4078):  captainL | 2008-02-14 00:27:14 +0000
 fixed versioned loading split bug
 r6846@luke-mbp (orig r4103):  captainL | 2008-02-27 15:11:21 +0000
 increased sqlt rev dep
 r6847@luke-mbp (orig r4104):  captainL | 2008-02-27 15:12:12 +0000
 fixed behaviour or is_foreign_key_constraint and unique index names
 r6848@luke-mbp (orig r4105):  captainL | 2008-02-28 10:28:31 +0000
 changed versioning table from SchemaVersions to dbix_class_schema_versions with transition ability
 r6849@luke-mbp (orig r4106):  captainL | 2008-02-28 10:54:28 +0000
 hack bugfix for sqlt_type weirdness
 r6850@luke-mbp (orig r4107):  captainL | 2008-02-28 16:11:44 +0000
 cleaned up get_db_version
 r6851@luke-mbp (orig r4108):  captainL | 2008-02-28 16:41:19 +0000
 lowercased column names of versions table
 r6852@luke-mbp (orig r4109):  captainL | 2008-02-28 16:59:04 +0000
 removed startup comment if no action required
 r6862@luke-mbp (orig r4123):  captainL | 2008-03-04 23:14:23 +0000
 improved docs and added env var to skip version checks on connect
 r6864@luke-mbp (orig r4125):  captainL | 2008-03-04 23:28:21 +0000
 manual merge for deferrable changes from trunk

r55009@windhund (orig r4127):  captainL | 2008-03-05 11:38:19 +0100
added entry in Changes for versioning branch
r55025@windhund (orig r4143):  castaway | 2008-03-07 00:26:08 +0100
Random pod/doc pokage

1  2 
lib/DBIx/Class/Relationship/Base.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/Storage/DBI.pm

@@@ -109,6 -109,13 +109,13 @@@ is creating constraints where it should
  should, set this attribute to a true or false value to override the detection
  of when to create constraints.
  
+ =item is_deferrable
+ Tells L<SQL::Translator> that the foreign key constraint it creates should be
+ deferrable. In other words, the user may request that the constraint be ignored
+ until the end of the transaction. Currently, only the PostgreSQL producer
+ actually supports this.
  =back
  
  =head2 register_relationship
@@@ -288,8 -295,7 +295,8 @@@ L<DBIx::Class::Row/insert> on it
  
  sub find_or_new_related {
    my $self = shift;
 -  return $self->find_related(@_) || $self->new_related(@_);
 +  my $obj = $self->find_related(@_);
 +  return defined $obj ? $obj : $self->new_related(@_);
  }
  
  =head2 find_or_create_related
diff --combined lib/DBIx/Class/Row.pm
@@@ -50,9 -50,7 +50,9 @@@ sub new 
    my ($class, $attrs) = @_;
    $class = ref $class if ref $class;
  
 -  my $new = { _column_data => {} };
 +  my $new = {
 +      _column_data          => {},
 +  };
    bless $new, $class;
  
    if (my $handle = delete $attrs->{-source_handle}) {
@@@ -140,6 -138,9 +140,9 @@@ be set, or the class to have a result_s
  an entirely new object into the database, use C<create> (see
  L<DBIx::Class::ResultSet/create>).
  
+ To fetch an uninserted row object, call
+ L<new|DBIx::Class::ResultSet/new> on a resultset.
  This will also insert any uninserted, related objects held inside this
  one, see L<DBIx::Class::ResultSet/create> for more details.
  
@@@ -261,7 -262,13 +264,13 @@@ sub insert 
    $obj->in_storage; # Get value
    $obj->in_storage(1); # Set value
  
- Indicates whether the object exists as a row in the database or not
+ Indicates whether the object exists as a row in the database or
+ not. This is set to true when L<DBIx::Class::ResultSet/find>,
+ L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
+ are used. 
+ Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
+ L</delete> on one, sets it to false.
  
  =cut
  
@@@ -355,10 -362,11 +364,11 @@@ sub delete 
  
    my $val = $obj->get_column($col);
  
- Gets a column value from a row object. Does not do any queries; the column 
- must have already been fetched from the database and stored in the object. If 
- there is an inflated value stored that has not yet been deflated, it is deflated
- when the method is invoked.
+ Returns a raw column value from the row object, if it has already
+ been fetched from the database or set by an accessor.
+ If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
+ will be deflated and returned.
  
  =cut
  
@@@ -396,7 -404,7 +406,7 @@@ sub has_column_loaded 
  
    my %data = $obj->get_columns;
  
- Does C<get_column>, for all column values at once.
+ Does C<get_column>, for all loaded column values at once.
  
  =cut
  
@@@ -427,9 -435,10 +437,10 @@@ sub get_dirty_columns 
  
  =head2 get_inflated_columns
  
-   my $inflated_data = $obj->get_inflated_columns;
+   my %inflated_data = $obj->get_inflated_columns;
  
- Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
+ Similar to get_columns but objects are returned for inflated columns
+ instead of their raw non-inflated values.
  
  =cut
  
@@@ -445,9 -454,13 +456,13 @@@ sub get_inflated_columns 
  
    $obj->set_column($col => $val);
  
- Sets a column value. If the new value is different from the old one,
+ Sets a raw column value. If the new value is different from the old one,
  the column is marked as dirty for when you next call $obj->update.
  
+ If passed an object or reference, this will happily attempt store the
+ value, and a later insert/update will try and stringify/numify as
+ appropriate.
  =cut
  
  sub set_column {
    my $old = $self->get_column($column);
    my $ret = $self->store_column(@_);
    $self->{_dirty_columns}{$column} = 1
 -    if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
 +    if (defined $old xor defined $ret) || (defined $old && $old ne $ret);
 +
 +  # XXX clear out the relation cache for this column
 +  delete $self->{related_resultsets}{$column};
 +
    return $ret;
  }
  
@@@ -665,7 -674,8 +680,8 @@@ sub inflate_result 
  
    $obj->update_or_insert
  
- Updates the object if it's already in the db, else inserts it.
+ Updates the object if it's already in the database, according to
+ L</in_storage>, else inserts it.
  
  =head2 insert_or_update
  
@@@ -1122,9 -1122,6 +1122,9 @@@ sub _select 
    } else {
      $self->throw_exception("rows attribute must be positive if present")
        if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
 +
 +    # MySQL actually recommends this approach.  I cringe.
 +    $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
      push @args, $attrs->{rows}, $attrs->{offset};
    }
  
@@@ -1332,21 -1329,22 +1332,22 @@@ sub create_ddl_di
    $version ||= $schema->VERSION || '1.x';
    $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} };
  
-   $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.08: '}
+   $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09: '}
        . $self->_check_sqlt_message . q{'})
            if !$self->_check_sqlt_version;
  
    my $sqlt = SQL::Translator->new({
- #      debug => 1,
        add_drop_table => 1,
    });
+   $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
+   my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error;
    foreach my $db (@$databases)
    {
      $sqlt->reset();
-     $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
- #    $sqlt->parser_args({'DBIx::Class' => $schema);
      $sqlt = $self->configure_sqlt($sqlt, $db);
-     $sqlt->data($schema);
+     $sqlt->{schema} = $sqlt_schema;
      $sqlt->producer($db);
  
      my $file;
      if(-e $filename)
      {
        warn("$filename already exists, skipping $db");
-       next;
-     }
-     my $output = $sqlt->translate;
-     if(!$output)
-     {
-       warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
-       next;
-     }
-     if(!open($file, ">$filename"))
-     {
-         $self->throw_exception("Can't open $filename for writing ($!)");
+       next unless ($preversion);
+     } else {
+       my $output = $sqlt->translate;
+       if(!$output)
+       {
+         warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
          next;
-     }
-     print $file $output;
-     close($file);
+       }
+       if(!open($file, ">$filename"))
+       {
+           $self->throw_exception("Can't open $filename for writing ($!)");
+           next;
+       }
+       print $file $output;
+       close($file);
+     } 
      if($preversion)
      {
        require SQL::Translator::Diff;
          warn("No previous schema file found ($prefilename)");
          next;
        }
-       #### We need to reparse the SQLite file we just wrote, so that 
-       ##   Diff doesnt get all confoosed, and Diff is *very* confused.
-       ##   FIXME: rip Diff to pieces!
- #      my $target_schema = $sqlt->schema;
- #      unless ( $target_schema->name ) {
- #        $target_schema->name( $filename );
- #      }
-       my @input;
-       push @input, {file => $prefilename, parser => $db};
-       push @input, {file => $filename, parser => $db};
-       my ( $source_schema, $source_db, $target_schema, $target_db ) = map {
-         my $file   = $_->{'file'};
-         my $parser = $_->{'parser'};
  
+       my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion);
+       print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n";
+       if(-e $difffile)
+       {
+         warn("$difffile already exists, skipping");
+         next;
+       }
+       my $source_schema;
+       {
          my $t = SQL::Translator->new;
          $t->debug( 0 );
          $t->trace( 0 );
-         $t->parser( $parser )            or die $t->error;
-         my $out = $t->translate( $file ) or die $t->error;
-         my $schema = $t->schema;
-         unless ( $schema->name ) {
-           $schema->name( $file );
+         $t->parser( $db )                       or die $t->error;
+         my $out = $t->translate( $prefilename ) or die $t->error;
+         $source_schema = $t->schema;
+         unless ( $source_schema->name ) {
+           $source_schema->name( $prefilename );
          }
-         ($schema, $parser);
-       } @input;
+       }
+       # The "new" style of producers have sane normalization and can support 
+       # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
+       # And we have to diff parsed SQL against parsed SQL.
+       my $dest_schema = $sqlt_schema;
+       unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
+         my $t = SQL::Translator->new;
+         $t->debug( 0 );
+         $t->trace( 0 );
+         $t->parser( $db )                    or die $t->error;
+         my $out = $t->translate( $filename ) or die $t->error;
+         $dest_schema = $t->schema;
+         $dest_schema->name( $filename )
+           unless $dest_schema->name;
+       }
  
        my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
-                                                     $target_schema, $db,
+                                                     $dest_schema,   $db,
                                                      {}
                                                     );
-       my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion);
-       print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n";
-       if(-e $difffile)
-       {
-         warn("$difffile already exists, skipping");
-         next;
-       }
        if(!open $file, ">$difffile")
        { 
          $self->throw_exception("Can't write to $difffile ($!)");
@@@ -1482,7 -1484,7 +1487,7 @@@ sub deployment_statements 
        return join('', @rows);
    }
  
-   $self->throw_exception(q{Can't deploy without SQL::Translator 0.08: '}
+   $self->throw_exception(q{Can't deploy without SQL::Translator 0.09: '}
        . $self->_check_sqlt_message . q{'})
            if !$self->_check_sqlt_version;
  
@@@ -1567,9 -1569,9 +1572,9 @@@ sub build_datetime_parser 
      my $_check_sqlt_message; # private
      sub _check_sqlt_version {
          return $_check_sqlt_version if defined $_check_sqlt_version;
-         eval 'use SQL::Translator 0.08';
-         $_check_sqlt_message = $@ ? $@ : '';
-         $_check_sqlt_version = $@ ? 0 : 1;
+         eval 'use SQL::Translator "0.09"';
+         $_check_sqlt_message = $@ || '';
+         $_check_sqlt_version = !$@;
      }
  
      sub _check_sqlt_message {