From: John Napiorkowski Date: Mon, 7 Jul 2008 13:08:34 +0000 (+0000) Subject: Merge 'trunk' into 'replication_dedux' X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=87d4dd9d4a9961d87577dbd1cc227e7765d42945;hp=-c;p=dbsrgits%2FDBIx-Class-Historic.git Merge 'trunk' into 'replication_dedux' r14114@dev (orig r4505): gphat | 2008-06-19 08:06:57 -0500 Add make_column_dirty to Row (per request from #dbix-class questions) r14293@dev (orig r4514): wdh | 2008-06-25 05:52:30 -0500 clarify that ->resultset_class must be called after ->load_components and ->table when using custom resultsets r14324@dev (orig r4518): wdh | 2008-06-26 07:29:45 -0500 add troubleshooting examples for quoting issues r14371@dev (orig r4519): castaway | 2008-06-26 14:51:35 -0500 Remove setup_connection_class from POD, skip in podcoverage r14372@dev (orig r4520): lukes | 2008-06-27 05:18:08 -0500 changed default behaviour of do_upgrade in versioned to just run everything r14600@dev (orig r4540): bricas | 2008-06-30 08:32:03 -0500 change my nick r14601@dev (orig r4541): nigel | 2008-06-30 09:30:11 -0500 Corrected spelling of TRANSACTION in code reading sql upgrade script. Pointed out by renormalist on IRC. r14602@dev (orig r4542): bricas | 2008-06-30 09:36:37 -0500 update marcus in the authors r14603@dev (orig r4543): lukes | 2008-06-30 13:38:08 -0500 added ignore_version connect attr and updated docs accordingly r14604@dev (orig r4544): lukes | 2008-06-30 15:07:13 -0500 implemented versioning tests for version warns r14715@dev (orig r4551): ash | 2008-07-02 09:53:32 -0500 Add caveat about prefetch r14716@dev (orig r4552): wreis | 2008-07-02 17:19:39 -0500 updating changelog r14717@dev (orig r4553): ribasushi | 2008-07-03 18:52:31 -0500 Minor cookbook fix (two adjacent examples were mixed up) r14718@dev (orig r4554): lukes | 2008-07-04 07:03:51 -0500 made versioning overwrite ddl and diff files where appropriate and made arg order of ddl_filename consistent with create_ddl_filename r14719@dev (orig r4555): lukes | 2008-07-07 07:11:32 -0500 moved schema_version from Versioning to core --- 87d4dd9d4a9961d87577dbd1cc227e7765d42945 diff --combined lib/DBIx/Class/Row.pm index 108e918,d58d957..8c40b00 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@@ -451,6 -451,20 +451,20 @@@ sub get_dirty_columns keys %{$self->{_dirty_columns}}; } + =head2 make_column_dirty + + Marks a column dirty regardless if it has really changed. Throws an + exception if the column does not exist. + + =cut + sub make_column_dirty { + my ($self, $column) = @_; + + $self->throw_exception( "No such column '${column}'" ) + unless exists $self->{_column_data}{$column} || $self->has_column($column); + $self->{_dirty_columns}{$column} = 1; + } + =head2 get_inflated_columns my %inflated_data = $obj->get_inflated_columns; @@@ -785,21 -799,6 +799,21 @@@ sub register_column $class->mk_group_accessors('column' => $acc); } +=head2 get_from_storage + +Returns a new Row which is whatever the Storage has for the currently created +Row object. You ca use this to see if the storage has become inconsistent with +whatever your Row object is. + +=cut + +sub get_from_storage { + my $self = shift @_; + my @primary_columns = map { $self->$_ } $self->primary_columns; + return $self->result_source->schema->txn_do(sub { + return $self->result_source->resultset->find(@primary_columns); + }); +} =head2 throw_exception diff --combined lib/DBIx/Class/Schema.pm index cbcddbc,21f055b..05a1b28 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@@ -62,6 -62,29 +62,29 @@@ particular which module inherits off wh =head1 METHODS + =head2 schema_version + + Returns the current schema class' $VERSION + + =cut + + sub schema_version { + my ($self) = @_; + my $class = ref($self)||$self; + + # does -not- use $schema->VERSION + # since that varies in results depending on if version.pm is installed, and if + # so the perl or XS versions. If you want this to change, bug the version.pm + # author to make vpp and vxs behave the same. + + my $version; + { + no strict 'refs'; + $version = ${"${class}::VERSION"}; + } + return $version; + } + =head2 register_class =over 4 @@@ -613,19 -636,6 +636,6 @@@ sub compose_namespace return $schema; } - =head2 setup_connection_class - - =over 4 - - =item Arguments: $target, @info - - =back - - Sets up a database connection class to inject between the schema and the - subclasses that the schema creates. - - =cut - sub setup_connection_class { my ($class, $target, @info) = @_; $class->inject_base($target => 'DBIx::Class::DB'); @@@ -637,9 -647,9 +647,9 @@@ =over 4 -=item Arguments: $storage_type +=item Arguments: $storage_type|{$storage_type, \%args} -=item Return Value: $storage_type +=item Return Value: $storage_type|{$storage_type, \%args} =back @@@ -653,13 -663,6 +663,13 @@@ in cases where the appropriate subclas dealing with MSSQL via L, in which case you'd set it to C<::DBI::Sybase::MSSQL>. +If your storage type requires instantiation arguments, those are defined as a +second argument in the form of a hashref and the entire value needs to be +wrapped into an arrayref or a hashref. We support both types of refs here in +order to play nice with your Config::[class] or your choice. + +See L for an example of this. + =head2 connection =over 4 @@@ -682,33 -685,19 +692,33 @@@ or L in general sub connection { my ($self, @info) = @_; return $self if !@info && $self->storage; - my $storage_class = $self->storage_type; + + my ($storage_class, $args) = ref $self->storage_type ? + ($self->_normalize_storage_type($self->storage_type),{}) : ($self->storage_type, {}); + $storage_class = 'DBIx::Class::Storage'.$storage_class if $storage_class =~ m/^::/; eval "require ${storage_class};"; $self->throw_exception( "No arguments to load_classes and couldn't load ${storage_class} ($@)" ) if $@; - my $storage = $storage_class->new($self); + my $storage = $storage_class->new($self=>$args); $storage->connect_info(\@info); $self->storage($storage); return $self; } +sub _normalize_storage_type { + my ($self, $storage_type) = @_; + if(ref $storage_type eq 'ARRAY') { + return @$storage_type; + } elsif(ref $storage_type eq 'HASH') { + return %$storage_type; + } else { + $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type); + } +} + =head2 connect =over 4 @@@ -1139,11 -1128,11 +1149,11 @@@ sub create_ddl_dir =over 4 - =item Arguments: $directory, $database-type, $version, $preversion + =item Arguments: $database-type, $version, $directory, $preversion =back - my $filename = $table->ddl_filename($type, $dir, $version, $preversion) + my $filename = $table->ddl_filename($type, $version, $dir, $preversion) This method is called by C to compose a file name out of the supplied directory, database type and version number. The default file @@@ -1155,14 -1144,14 +1165,14 @@@ format =cut sub ddl_filename { - my ($self, $type, $dir, $version, $pversion) = @_; + my ($self, $type, $version, $dir, $preversion) = @_; - my $filename = ref($self); - $filename =~ s/::/-/g; - $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql"); - $filename =~ s/$version/$pversion-$version/ if($pversion); - - return $filename; + my $filename = ref($self); + $filename =~ s/::/-/g; + $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql"); + $filename =~ s/$version/$preversion-$version/ if($preversion); + + return $filename; } =head2 sqlt_deploy_hook($sqlt_schema) diff --combined lib/DBIx/Class/Storage/DBI.pm index d1c1ac7,9cfb860..d919e18 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@@ -1063,7 -1063,6 +1063,7 @@@ sub _query_start if ( $self->debug ) { @bind = $self->_fix_bind_params(@bind); + $self->debugobj->query_start( $sql, @bind ); } } @@@ -1451,12 -1450,10 +1451,10 @@@ hashref like the followin =cut - sub create_ddl_dir - { + sub create_ddl_dir { my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_; - if(!$dir || !-d $dir) - { + if(!$dir || !-d $dir) { warn "No directory given, using ./\n"; $dir = "./"; } @@@ -1479,97 -1476,89 +1477,89 @@@ $sqlt->parser('SQL::Translator::Parser::DBIx::Class'); my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error; - foreach my $db (@$databases) - { + foreach my $db (@$databases) { $sqlt->reset(); $sqlt = $self->configure_sqlt($sqlt, $db); $sqlt->{schema} = $sqlt_schema; $sqlt->producer($db); my $file; - my $filename = $schema->ddl_filename($db, $dir, $version); - if(-e $filename) - { - warn("$filename already exists, skipping $db"); - next unless ($preversion); - } else { - 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; - } - print $file $output; - close($file); - } - if($preversion) - { - require SQL::Translator::Diff; + my $filename = $schema->ddl_filename($db, $version, $dir); + if (-e $filename && (!$version || ($version == $schema->schema_version()))) { + # if we are dumping the current version, overwrite the DDL + warn "Overwriting existing DDL file - $filename"; + unlink($filename); + } - my $prefilename = $schema->ddl_filename($db, $dir, $preversion); - # print "Previous version $prefilename\n"; - if(!-e $prefilename) - { - warn("No previous schema file found ($prefilename)"); - 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; + } + print $file $output; + close($file); + + next unless ($preversion); - 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; - } + require SQL::Translator::Diff; - my $source_schema; - { - my $t = SQL::Translator->new($sqltargs); - $t->debug( 0 ); - $t->trace( 0 ); - $t->parser( $db ) or die $t->error; - $t = $self->configure_sqlt($t, $db); - my $out = $t->translate( $prefilename ) or die $t->error; - $source_schema = $t->schema; - unless ( $source_schema->name ) { - $source_schema->name( $prefilename ); - } - } + my $prefilename = $schema->ddl_filename($db, $preversion, $dir); + if(!-e $prefilename) { + warn("No previous schema file found ($prefilename)"); + next; + } - # 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($sqltargs); - $t->debug( 0 ); - $t->trace( 0 ); - $t->parser( $db ) or die $t->error; - $t = $self->configure_sqlt($t, $db); - my $out = $t->translate( $filename ) or die $t->error; - $dest_schema = $t->schema; - $dest_schema->name( $filename ) - unless $dest_schema->name; + my $difffile = $schema->ddl_filename($db, $version, $dir, $preversion); + if(-e $difffile) { + warn("Overwriting existing diff file - $difffile"); + unlink($difffile); + } + + my $source_schema; + { + my $t = SQL::Translator->new($sqltargs); + $t->debug( 0 ); + $t->trace( 0 ); + $t->parser( $db ) or die $t->error; + $t = $self->configure_sqlt($t, $db); + my $out = $t->translate( $prefilename ) or die $t->error; + $source_schema = $t->schema; + unless ( $source_schema->name ) { + $source_schema->name( $prefilename ); } + } - my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db, - $dest_schema, $db, - $sqltargs - ); - if(!open $file, ">$difffile") - { - $self->throw_exception("Can't write to $difffile ($!)"); - next; - } - print $file $diff; - close($file); + # 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($sqltargs); + $t->debug( 0 ); + $t->trace( 0 ); + $t->parser( $db ) or die $t->error; + $t = $self->configure_sqlt($t, $db); + 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, + $dest_schema, $db, + $sqltargs + ); + if(!open $file, ">$difffile") { + $self->throw_exception("Can't write to $difffile ($!)"); + next; } + print $file $diff; + close($file); } } @@@ -1721,31 -1710,6 +1711,31 @@@ sub build_datetime_parser } } +=head2 is_replicating + +A boolean that reports if a particular L is set to +replicate from a master database. Default is undef, which is the result +returned by databases that don't support replication. + +=cut + +sub is_replicating { + return; + +} + +=head2 lag_behind_master + +Returns a number that represents a certain amount of lag behind a master db +when a given storage is replicating. The number is database dependent, but +starts at zero and increases with the amount of lag. Default in undef + +=cut + +sub lag_behind_master { + return; +} + sub DESTROY { my $self = shift; return if !$self->_dbh; diff --combined t/03podcoverage.t index 9859c59,df5edd8..5fae09f --- a/t/03podcoverage.t +++ b/t/03podcoverage.t @@@ -31,6 -31,11 +31,11 @@@ my $exceptions = qw(cursor) ] }, + 'DBIx::Class::Schema' => { + ignore => [ + qw(setup_connection_class) + ] + }, 'DBIx::Class::CDBICompat::AccessorMapping' => { skip => 1 }, 'DBIx::Class::CDBICompat::AbstractSearch' => { ignore => [qw(search_where)] @@@ -99,8 -104,9 +104,8 @@@ 'DBIx::Class::Schema::Versioned' => { ignore => [ qw(connection) ] }, -# must kill authors. - - 'DBIx::Class::Storage::DBI::Replicated' => { skip => 1 }, +# don't bother since it's heavily deprecated + 'DBIx::Class::ResultSetManager' => { skip => 1 }, }; foreach my $module (@modules) {