Revision history for DBIx::Class
+ - mark DB.pm and compose_connection as deprecated
+ - switch tests to compose_namespace
+
0.07999_01 2006-10-05 21:00:00
- add connect_info option "disable_statement_caching"
- create insert_bulk using execute_array, populate uses it
requires 'DBI' => 1.40;
requires 'Module::Find' => 0;
requires 'Class::Inspector' => 0;
-requires 'Class::Accessor::Grouped' => 0;
+requires 'Class::Accessor::Grouped' => 0.03;
# Perl 5.8.0 doesn't have utf8::is_utf8()
requires 'Encode' => 0 if ($] <= 5.008000);
use DBIx::Class::ClassResolver::PassThrough;
use DBI;
+unless ($INC{"DBIx/Class/CDBICompat.pm"}) {
+ warn "IMPORTANT: DBIx::Class::DB is DEPRECATED AND *WILL* BE REMOVED. DO NOT USE.\n";
+}
+
__PACKAGE__->load_components(qw/ResultSetProxy/);
{
DBIx::Class::DB - (DEPRECATED) classdata schema component
-=head1 SYNOPSIS
-
- package MyDB;
-
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components('DB');
-
- __PACKAGE__->connection('dbi:...', 'user', 'pass', \%attrs);
-
- package MyDB::MyTable;
-
- use base qw/MyDB/;
- __PACKAGE__->load_components('Core'); # just load this in MyDB if it will
- # always be there
-
- ...
-
=head1 DESCRIPTION
This class is designed to support the Class::DBI connection-as-classdata style
for DBIx::Class. You are *strongly* recommended to use a DBIx::Class::Schema
instead; DBIx::Class::DB will not undergo new development and will be moved
-to being a CDBICompat-only component before 1.0.
+to being a CDBICompat-only component before 1.0. In order to discourage further
+use, documentation has been removed as of 0.08000
+
+=begin HIDE_BECAUSE_THIS_CLASS_IS_DEPRECATED
=head1 METHODS
Alias for L<txn_rollback>
+=end HIDE_BECAUSE_THIS_CLASS_IS_DEPRECATED
+
=head1 AUTHORS
Matt S. Trout <mst@shadowcatsystems.co.uk>
sub ident_condition {
my ($self, $alias) = @_;
my %cond;
- $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_)
- for $self->primary_columns;
+ my $prefix = defined $alias ? $alias.'.' : '';
+ $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
return \%cond;
}
my ($source, $attrs) = @_;
$source = $source->handle
unless $source->isa('DBIx::Class::ResultSourceHandle');
+ $attrs = { %{$attrs||{}} };
if ($attrs->{page}) {
$attrs->{rows} ||= 10;
sub update {
my ($self, $upd) = @_;
$self->throw_exception( "Not in database" ) unless $self->in_storage;
- $self->set_columns($upd) if $upd;
- my %to_update = $self->get_dirty_columns;
- return $self unless keys %to_update;
my $ident_cond = $self->ident_condition;
$self->throw_exception("Cannot safely update a row in a PK-less table")
if ! keys %$ident_cond;
+ $self->set_columns($upd) if $upd;
+ my %to_update = $self->get_dirty_columns;
+ return $self unless keys %to_update;
my $rows = $self->result_source->storage->update(
$self->result_source->from, \%to_update, $ident_cond);
if ($rows == 0) {
use Carp::Clan qw/^DBIx::Class/;
use Scalar::Util qw/weaken/;
+use File::Spec;
require Module::Find;
use base qw/DBIx::Class/;
return;
}
-=head2 compose_connection
+=head2 compose_connection (DEPRECATED)
=over 4
=back
+DEPRECATED. You probably wanted compose_namespace.
+
+Actually, you probably just wanted to call connect.
+
+=for hidden due to deprecation
+
Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
then injects the L<DBix::Class::ResultSetProxy> component and a
=cut
-sub compose_connection {
- my ($self, $target, @info) = @_;
- my $base = 'DBIx::Class::ResultSetProxy';
- eval "require ${base};";
- $self->throw_exception
- ("No arguments to load_classes and couldn't load ${base} ($@)")
- if $@;
-
- if ($self eq $target) {
- # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
- foreach my $moniker ($self->sources) {
- my $source = $self->source($moniker);
+{
+ my $warn;
+
+ sub compose_connection {
+ my ($self, $target, @info) = @_;
+
+ warn "compose_connection deprecated as of 0.08000" unless $warn++;
+
+ my $base = 'DBIx::Class::ResultSetProxy';
+ eval "require ${base};";
+ $self->throw_exception
+ ("No arguments to load_classes and couldn't load ${base} ($@)")
+ if $@;
+
+ if ($self eq $target) {
+ # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
+ foreach my $moniker ($self->sources) {
+ my $source = $self->source($moniker);
+ my $class = $source->result_class;
+ $self->inject_base($class, $base);
+ $class->mk_classdata(resultset_instance => $source->resultset);
+ $class->mk_classdata(class_resolver => $self);
+ }
+ $self->connection(@info);
+ return $self;
+ }
+
+ my $schema = $self->compose_namespace($target, $base);
+ {
+ no strict 'refs';
+ *{"${target}::schema"} = sub { $schema };
+ }
+
+ $schema->connection(@info);
+ foreach my $moniker ($schema->sources) {
+ my $source = $schema->source($moniker);
my $class = $source->result_class;
- $self->inject_base($class, $base);
+ #warn "$moniker $class $source ".$source->storage;
+ $class->mk_classdata(result_source_instance => $source);
$class->mk_classdata(resultset_instance => $source->resultset);
- $class->mk_classdata(class_resolver => $self);
+ $class->mk_classdata(class_resolver => $schema);
}
- $self->connection(@info);
- return $self;
+ return $schema;
}
-
- my $schema = $self->compose_namespace($target, $base);
- {
- no strict 'refs';
- *{"${target}::schema"} = sub { $schema };
- }
-
- $schema->connection(@info);
- foreach my $moniker ($schema->sources) {
- my $source = $schema->source($moniker);
- my $class = $source->result_class;
- #warn "$moniker $class $source ".$source->storage;
- $class->mk_classdata(result_source_instance => $source);
- $class->mk_classdata(resultset_instance => $source->resultset);
- $class->mk_classdata(class_resolver => $schema);
- }
- return $schema;
}
=head2 compose_namespace
my $storage = $storage_class->new($self);
$storage->connect_info(\@info);
$self->storage($storage);
+ $self->on_connect() if($self->can('on_connect'));
return $self;
}
=over 4
-=item Arguments: \@databases, $version, $directory, $sqlt_args
+=item Arguments: \@databases, $version, $directory, $preversion, $sqlt_args
=back
Creates an SQL file based on the Schema, for each of the specified
-database types, in the given directory.
+database types, in the given directory. Given a previous version number,
+this will also create a file containing the ALTER TABLE statements to
+transform the previous schema into the current one. Note that these
+statements may contain DROP TABLE or DROP COLUMN statements that can
+potentially destroy data.
+
+The file names are created using the C<ddl_filename> method below, please
+override this method in your schema if you would like a different file
+name format. For the ALTER file, the same format is used, replacing
+$version in the name with "$preversion-$version".
+
+If no arguments are passed, then the following default values are used:
+
+=over 4
+
+=item databases - ['MySQL', 'SQLite', 'PostgreSQL']
+
+=item version - $schema->VERSION
+
+=item directory - './'
+
+=item preversion - <none>
+
+=back
Note that this feature is currently EXPERIMENTAL and may not work correctly
across all databases, or fully handle complex relationships.
+WARNING: Please check all SQL files created, before applying them.
+
=cut
sub create_ddl_dir {
=head2 ddl_filename (EXPERIMENTAL)
- my $filename = $table->ddl_filename($type, $dir, $version)
+=over 4
+
+=item Arguments: $directory, $database-type, $version, $preversion
+
+=back
+
+ my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
+
+This method is called by C<create_ddl_dir> to compose a file name out of
+the supplied directory, database type and version number. The default file
+name format is: C<$dir$schema-$version-$type.sql>.
-Creates a filename for a SQL file based on the table class name. Not
-intended for direct end user use.
+You may override this method in your schema if you wish to use a different
+format.
=cut
sub ddl_filename {
- my ($self, $type, $dir, $version) = @_;
+ my ($self, $type, $dir, $version, $pversion) = @_;
my $filename = ref($self);
$filename =~ s/::/-/;
- $filename = "$dir$filename-$version-$type.sql";
+ $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
+ $filename =~ s/$version/$pversion-$version/ if($pversion);
return $filename;
}
--- /dev/null
+package DBIx::Class::Version::Table;
+use base 'DBIx::Class';
+use strict;
+use warnings;
+
+__PACKAGE__->load_components(qw/ Core/);
+__PACKAGE__->table('SchemaVersions');
+
+__PACKAGE__->add_columns
+ ( 'Version' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'name' => 'Version',
+ 'is_nullable' => 0,
+ 'size' => '10'
+ },
+ 'Installed' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'name' => 'Installed',
+ 'is_nullable' => 0,
+ 'size' => '20'
+ },
+ );
+__PACKAGE__->set_primary_key('Version');
+
+package DBIx::Class::Version;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+__PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table');
+
+
+# ---------------------------------------------------------------------------
+package DBIx::Class::Schema::Versioned;
+
+use strict;
+use warnings;
+use base 'DBIx::Class';
+use POSIX 'strftime';
+use Data::Dumper;
+
+__PACKAGE__->mk_classdata('_filedata');
+__PACKAGE__->mk_classdata('upgrade_directory');
+
+sub on_connect
+{
+ my ($self) = @_;
+ my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
+ my $vtable = $vschema->resultset('Table');
+ my $pversion;
+
+ if(!$self->exists($vtable))
+ {
+# $vschema->storage->debug(1);
+ $vschema->storage->ensure_connected();
+ $vschema->deploy();
+ $pversion = 0;
+ }
+ else
+ {
+ my $psearch = $vtable->search(undef,
+ { select => [
+ { 'max' => 'Installed' },
+ ],
+ as => ['maxinstall'],
+ })->first;
+ $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
+ })->first;
+ $pversion = $pversion->Version if($pversion);
+ }
+# warn("Previous version: $pversion\n");
+ if($pversion eq $self->VERSION)
+ {
+ warn "This version is already installed\n";
+ return 1;
+ }
+
+## use IC::DT?
+
+ if(!$pversion)
+ {
+ $vtable->create({ Version => $self->VERSION,
+ Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
+ });
+ ## If we let the user do this, where does the Version table get updated?
+ warn "No previous version found, calling deploy to install this version.\n";
+ $self->deploy();
+ return 1;
+ }
+
+ my $file = $self->ddl_filename(
+ $self->storage->sqlt_type,
+ $self->upgrade_directory,
+ $self->VERSION
+ );
+ if(!$file)
+ {
+ # No upgrade path between these two versions
+ return 1;
+ }
+
+ $file = $self->ddl_filename(
+ $self->storage->sqlt_type,
+ $self->upgrade_directory,
+ $self->VERSION,
+ $pversion,
+ );
+# $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e;
+ if(!-f $file)
+ {
+ warn "Upgrade not possible, no upgrade file found ($file)\n";
+ return;
+ }
+
+ my $fh;
+ open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
+ my @data = split(/;\n/, join('', <$fh>));
+ close($fh);
+ @data = grep { $_ && $_ !~ /^-- / } @data;
+ @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
+
+ $self->_filedata(\@data);
+
+ ## Don't do this yet, do only on command?
+ ## If we do this later, where does the Version table get updated??
+ warn "Versions out of sync. This is " . $self->VERSION .
+ ", your database contains version $pversion, please call upgrade on your Schema.\n";
+# $self->upgrade($pversion, $self->VERSION);
+}
+
+sub exists
+{
+ my ($self, $rs) = @_;
+
+ my $c = eval {
+ $rs->search({ 1, 0 })->count;
+ };
+ return 0 if $@ || !defined $c;
+
+ return 1;
+}
+
+sub backup
+{
+ my ($self) = @_;
+ ## Make each ::DBI::Foo do this
+ $self->storage->backup();
+}
+
+sub upgrade
+{
+ my ($self) = @_;
+
+ ## overridable sub, per default just run all the commands.
+
+ $self->backup();
+
+ $self->run_upgrade(qr/create/i);
+ $self->run_upgrade(qr/alter table .*? add/i);
+ $self->run_upgrade(qr/alter table .*? (?!drop)/i);
+ $self->run_upgrade(qr/alter table .*? drop/i);
+ $self->run_upgrade(qr/drop/i);
+# $self->run_upgrade(qr//i);
+
+ my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
+ my $vtable = $vschema->resultset('Table');
+ $vtable->create({ Version => $self->VERSION,
+ Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
+ });
+}
+
+
+sub run_upgrade
+{
+ my ($self, $stm) = @_;
+# print "Reg: $stm\n";
+ my @statements = grep { $_ =~ $stm } @{$self->_filedata};
+# print "Statements: ", join("\n", @statements), "\n";
+ $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
+
+ for (@statements)
+ {
+ $self->storage->debugfh->print("$_\n") if $self->storage->debug;
+# print "Running \n>>$_<<\n";
+ $self->storage->dbh->do($_) or warn "SQL was:\n $_";
+ }
+
+ return 1;
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades
+
+=head1 SYNOPSIS
+
+ package Library::Schema;
+ use base qw/DBIx::Class::Schema/;
+ # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
+ __PACKAGE__->load_classes(qw/CD Book DVD/);
+
+ __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
+ __PACKAGE__->upgrade_directory('/path/to/upgrades/');
+
+ sub backup
+ {
+ my ($self) = @_;
+ # my special backup process
+ }
+
+ sub upgrade
+ {
+ my ($self) = @_;
+
+ ## overridable sub, per default just runs all the commands.
+
+ $self->run_upgrade(qr/create/i);
+ $self->run_upgrade(qr/alter table .*? add/i);
+ $self->run_upgrade(qr/alter table .*? (?!drop)/i);
+ $self->run_upgrade(qr/alter table .*? drop/i);
+ $self->run_upgrade(qr/drop/i);
+ $self->run_upgrade(qr//i);
+ }
+
+=head1 DESCRIPTION
+
+This module is a component designed to extend L<DBIx::Class::Schema>
+classes, to enable them to upgrade to newer schema layouts. To use this
+module, you need to have called C<create_ddl_dir> on your Schema to
+create your upgrade files to include with your delivery.
+
+A table called I<SchemaVersions> is created and maintained by the
+module. This contains two fields, 'Version' and 'Installed', which
+contain each VERSION of your Schema, and the date+time it was installed.
+
+If you would like to influence which levels of version change need
+upgrades in your Schema, you can override the method C<ddl_filename>
+in L<DBIx::Class::Schema>. Return a false value if there is no upgrade
+path between the two versions supplied. By default, every change in
+your VERSION is regarded as needing an upgrade.
+
+NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff
+returns SQL statements that SQLite does not support.
+
+
+=head1 METHODS
+
+=head2 backup
+
+This is an overwritable method which is called just before the upgrade, to
+allow you to make a backup of the database. Per default this method attempts
+to call C<< $self->storage->backup >>, to run the standard backup on each
+database type.
+
+This method should return the name of the backup file, if appropriate.
+
+C<backup> is called from C<upgrade>, make sure you call it, if you write your
+own <upgrade> method.
+
+=head2 upgrade
+
+This is an overwritable method used to run your upgrade. The freeform method
+allows you to run your upgrade any way you please, you can call C<run_upgrade>
+any number of times to run the actual SQL commands, and in between you can
+sandwich your data upgrading. For example, first run all the B<CREATE>
+commands, then migrate your data from old to new tables/formats, then
+issue the DROP commands when you are finished.
+
+=head2 run_upgrade
+
+ $self->run_upgrade(qr/create/i);
+
+Runs a set of SQL statements matching a passed in regular expression. The
+idea is that this method can be called any number of times from your
+C<upgrade> method, running whichever commands you specify via the
+regex in the parameter.
+
+=head1 AUTHOR
+
+Jess Robinson <castaway@desert-island.demon.co.uk>
sub _find_syntax {
my ($self, $syntax) = @_;
my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
-# print STDERR "Found DBH $syntax >$dbhname< ", $syntax->{Driver}->{Name}, "\n";
if(ref($self) && $dbhname && $dbhname eq 'DB2') {
return 'RowNumberOver';
}
$self->throw_exception("'$sql' did not generate a statement.");
}
if ($self->debug) {
- my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
+ my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
$self->debugobj->query_end($sql, @debug_bind);
}
return (wantarray ? ($rv, $sth, @bind) : $rv);
=over 4
-=item Arguments: $schema \@databases, $version, $directory, $sqlt_args
+=item Arguments: $schema \@databases, $version, $directory, $preversion, $sqlt_args
=back
sub create_ddl_dir
{
- my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
+ my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_;
if(!$dir || !-d $dir)
{
$sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} };
eval "use SQL::Translator";
- $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
+ $self->throw_exception("Can't create a ddl file without SQL::Translator: $@") if $@;
- my $sqlt = SQL::Translator->new($sqltargs);
+ my $sqlt = SQL::Translator->new({
+# debug => 1,
+ add_drop_table => 1,
+ });
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->producer($db);
my $filename = $schema->ddl_filename($db, $dir, $version);
if(-e $filename)
{
- $self->throw_exception("$filename already exists, skipping $db");
+ warn("$filename already exists, skipping $db");
next;
}
- open($file, ">$filename")
- or $self->throw_exception("Can't open $filename for writing ($!)");
+
my $output = $sqlt->translate;
-#use Data::Dumper;
-# print join(":", keys %{$schema->source_registrations});
-# print Dumper($sqlt->schema);
if(!$output)
{
- $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")");
+ 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)
+ {
+ eval "use SQL::Translator::Diff";
+ if($@)
+ {
+ warn("Can't diff versions without SQL::Translator::Diff: $@");
+ next;
+ }
+
+ my $prefilename = $schema->ddl_filename($db, $dir, $preversion);
+# print "Previous version $prefilename\n";
+ if(!-e $prefilename)
+ {
+ 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 $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 );
+ }
+ ($schema, $parser);
+ } @input;
+
+ my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
+ $target_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 ($!)");
+ next;
+ }
+ print $file $diff;
+ close($file);
+ }
}
+}
+sub configure_sqlt() {
+ my $self = shift;
+ my $tr = shift;
+ my $db = shift || $self->sqlt_type;
+ if ($db eq 'PostgreSQL') {
+ $tr->quote_table_names(0);
+ $tr->quote_field_names(0);
+ }
+ return $tr;
}
=head2 deployment_statements
$type ||= $self->sqlt_type;
$version ||= $schema->VERSION || '1.x';
$dir ||= './';
+ my $filename = $schema->ddl_filename($type, $dir, $version);
+ if(-f $filename)
+ {
+ my $file;
+ open($file, "<$filename")
+ or $self->throw_exception("Can't open $filename ($!)");
+ my @rows = <$file>;
+ close($file);
+ return join('', @rows);
+ }
+
eval "use SQL::Translator";
if(!$@)
{
return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
}
- my $filename = $schema->ddl_filename($type, $dir, $version);
- if(!-f $filename)
- {
-# $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs);
- $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
- return;
- }
- my $file;
- open($file, "<$filename")
- or $self->throw_exception("Can't open $filename ($!)");
- my @rows = <$file>;
- close($file);
-
- return join('', @rows);
-
+ $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
+ return;
+
}
sub deploy {
use strict;
use warnings;
+use POSIX 'strftime';
+use File::Copy;
+use File::Spec;
use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
$dbh->func('last_insert_rowid');
}
+sub backup
+{
+ my ($self) = @_;
+
+ ## Where is the db file?
+ my $dsn = $self->connect_info()->[0];
+
+ my $dbname = $1 if($dsn =~ /dbname=([^;]+)/);
+ if(!$dbname)
+ {
+ $dbname = $1 if($dsn =~ /^dbi:SQLite:(.+)$/i);
+ }
+ $self->throw_exception("Cannot determine name of SQLite db file")
+ if(!$dbname || !-f $dbname);
+
+# print "Found database: $dbname\n";
+# my $dbfile = file($dbname);
+ my ($vol, $dir, $file) = File::Spec->splitpath($dbname);
+# my $file = $dbfile->basename();
+ $file = strftime("%y%m%d%h%M%s", localtime()) . $file;
+ $file = "B$file" while(-f $file);
+
+ my $res = copy($dbname, $file);
+ $self->throw_exception("Backup failed! ($!)") if(!$res);
+
+ return $file;
+}
+
1;
=head1 NAME
use lib qw(t/lib);
use_ok('DBICTest');
-DBICTest->init_schema();
+my $schema = DBICTest->init_schema();
-my $orig_debugcb = DBICTest->schema->storage->debugcb;
-my $orig_debug = DBICTest->schema->storage->debug;
+my $orig_debugcb = $schema->storage->debugcb;
+my $orig_debug = $schema->storage->debug;
-diag('Testing against ' . join(' ', map { DBICTest->schema->storage->dbh->get_info($_) } qw/17 18/));
+diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
-DBICTest->schema->storage->sql_maker->quote_char('`');
-DBICTest->schema->storage->sql_maker->name_sep('.');
+$schema->storage->sql_maker->quote_char('`');
+$schema->storage->sql_maker->name_sep('.');
my $sql = '';
-DBICTest->schema->storage->debugcb(sub { $sql = $_[1] });
-DBICTest->schema->storage->debug(1);
+$schema->storage->debugcb(sub { $sql = $_[1] });
+$schema->storage->debug(1);
my $rs;
-$rs = DBICTest::CD->search(
+$rs = $schema->resultset('CD')->search(
{ 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
{ join => 'artist' });
eval { $rs->count };
like($sql, qr/\QSELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )\E/, 'got correct SQL for count query with quoting');
my $order = 'year DESC';
-$rs = DBICTest::CD->search({},
+$rs = $schema->resultset('CD')->search({},
{ 'order_by' => $order });
eval { $rs->first };
like($sql, qr/ORDER BY `\Q${order}\E`/, 'quoted ORDER BY with DESC (should use a scalarref anyway)');
-$rs = DBICTest::CD->search({},
+$rs = $schema->resultset('CD')->search({},
{ 'order_by' => \$order });
eval { $rs->first };
like($sql, qr/ORDER BY \Q${order}\E/, 'did not quote ORDER BY with scalarref');
-DBICTest->schema->storage->sql_maker->quote_char([qw/[ ]/]);
-DBICTest->schema->storage->sql_maker->name_sep('.');
+$schema->storage->sql_maker->quote_char([qw/[ ]/]);
+$schema->storage->sql_maker->name_sep('.');
-$rs = DBICTest::CD->search(
+$rs = $schema->resultset('CD')->search(
{ 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
{ join => 'artist' });
eval { $rs->count };
order => '12'
);
-DBICTest->schema->storage->sql_maker->quote_char('`');
-DBICTest->schema->storage->sql_maker->name_sep('.');
+$schema->storage->sql_maker->quote_char('`');
+$schema->storage->sql_maker->name_sep('.');
-is(DBICTest->schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
+is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
-DBICTest->schema->storage->debugcb($orig_debugcb);
-DBICTest->schema->storage->debug($orig_debug);
+$schema->storage->debugcb($orig_debugcb);
+$schema->storage->debug($orig_debug);
use lib qw(t/lib);
use_ok('DBICTest');
-DBICTest->init_schema();
+my $schema = DBICTest->init_schema();
-my $orig_debugcb = DBICTest->schema->storage->debugcb;
-my $orig_debug = DBICTest->schema->storage->debug;
+my $orig_debugcb = $schema->storage->debugcb;
+my $orig_debug = $schema->storage->debug;
-diag('Testing against ' . join(' ', map { DBICTest->schema->storage->dbh->get_info($_) } qw/17 18/));
+diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
-my $dsn = DBICTest->schema->storage->connect_info->[0];
-DBICTest->schema->connection($dsn, { quote_char => '`', name_sep => '.' });
+my $dsn = $schema->storage->connect_info->[0];
+$schema->connection($dsn, { quote_char => '`', name_sep => '.' });
my $sql = '';
-DBICTest->schema->storage->debugcb(sub { $sql = $_[1] });
-DBICTest->schema->storage->debug(1);
+$schema->storage->debugcb(sub { $sql = $_[1] });
+$schema->storage->debug(1);
my $rs;
-$rs = DBICTest::CD->search(
+$rs = $schema->resultset('CD')->search(
{ 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
{ join => 'artist' });
eval { $rs->count };
like($sql, qr/\QSELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )\E/, 'got correct SQL for count query with quoting');
my $order = 'year DESC';
-$rs = DBICTest::CD->search({},
+$rs = $schema->resultset('CD')->search({},
{ 'order_by' => $order });
eval { $rs->first };
like($sql, qr/ORDER BY `\Q${order}\E`/, 'quoted ORDER BY with DESC (should use a scalarref anyway)');
-$rs = DBICTest::CD->search({},
+$rs = $schema->resultset('CD')->search({},
{ 'order_by' => \$order });
eval { $rs->first };
like($sql, qr/ORDER BY \Q${order}\E/, 'did not quote ORDER BY with scalarref');
-DBICTest->schema->connection($dsn, { quote_char => [qw/[ ]/], name_sep => '.' });
-DBICTest->schema->storage->debugcb(sub { $sql = $_[1] });
-DBICTest->schema->storage->debug(1);
+$schema->connection($dsn, { quote_char => [qw/[ ]/], name_sep => '.' });
+$schema->storage->debugcb(sub { $sql = $_[1] });
+$schema->storage->debug(1);
-$rs = DBICTest::CD->search(
+$rs = $schema->resultset('CD')->search(
{ 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
{ join => 'artist' });
eval { $rs->count };
order => '12'
);
-DBICTest->schema->connection($dsn, { quote_char => '`', name_sep => '.' });
+$schema->connection($dsn, { quote_char => '`', name_sep => '.' });
-is(DBICTest->schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
+is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
-DBICTest->schema->storage->debugcb($orig_debugcb);
-DBICTest->schema->storage->debug($orig_debug);
+$schema->storage->debugcb($orig_debugcb);
+$schema->storage->debug($orig_debug);
use lib qw(t/lib);
use_ok('DBICTest');
-DBICTest->init_schema();
+my $schema = DBICTest->init_schema();
my $cbworks = 0;
-DBICTest->schema->storage->debugcb(sub { $cbworks = 1; });
-DBICTest->schema->storage->debug(0);
-my $rs = DBICTest::CD->search({});
+$schema->storage->debugcb(sub { $cbworks = 1; });
+$schema->storage->debug(0);
+my $rs = $schema->resultset('CD')->search({});
$rs->count();
ok(!$cbworks, 'Callback not called with debug disabled');
-DBICTest->schema->storage->debug(1);
+$schema->storage->debug(1);
$rs->count();
ok($cbworks, 'Debug callback worked.');
my $prof = new DBIx::Test::Profiler();
-DBICTest->schema->storage->debugobj($prof);
+$schema->storage->debugobj($prof);
# Test non-transaction calls.
$rs->count();
$prof->reset();
# Test transaction calls
-DBICTest->schema->txn_begin();
+$schema->txn_begin();
ok($prof->{'txn_begin'}, 'txn_begin called');
-$rs = DBICTest::CD->search({});
+$rs = $schema->resultset('CD')->search({});
$rs->count();
ok($prof->{'query_start'}, 'query_start called');
ok($prof->{'query_end'}, 'query_end called');
-DBICTest->schema->txn_commit();
+$schema->txn_commit();
ok($prof->{'txn_commit'}, 'txn_commit called');
$prof->reset();
# Test a rollback
-DBICTest->schema->txn_begin();
-$rs = DBICTest::CD->search({});
+$schema->txn_begin();
+$rs = $schema->resultset('CD')->search({});
$rs->count();
-DBICTest->schema->txn_rollback();
+$schema->txn_rollback();
ok($prof->{'txn_rollback'}, 'txn_rollback called');
-DBICTest->schema->storage->debug(0);
+$schema->storage->debug(0);
package DBIx::Test::Profiler;
use strict;
like($@, qr/DBICTest::Exception is handling this: $ex_regex/);
# While we're at it, lets throw a custom exception through Storage::DBI
-eval { DBICTest->schema->storage->throw_exception('floob') };
+eval { $schema->storage->throw_exception('floob') };
like($@, qr/DBICTest::Exception is handling this: floob/);
use DBICTest::ResultSetManager; # uses Class::Inspector
-my $schema = DBICTest::ResultSetManager->compose_connection('DB', 'foo');
+my $schema = DBICTest::ResultSetManager->compose_namespace('DB');
my $rs = $schema->resultset('Foo');
ok( !DB::Foo->can('bar'), 'Foo class does not have bar method' );
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::Schema;
+use DBICTest::Schema::Artist;
+
+DBICTest::Schema::Artist->source_name('MyArtist');
+DBICTest::Schema->register_class('FooA', 'DBICTest::Schema::Artist');
+
+my $schema = DBICTest->init_schema();
+
+my $a = $schema->resultset('FooA')->search;
+is($a->count, 3, 'have 3 artists');
+is($schema->class('FooA'), 'DBICTest::FooA', 'Correct artist class');
plan tests => 5;
-my $artist = DBICTest::Artist->find(1);
+my $artist = $schema->resultset("Artist")->find(1);
ok($artist->find_related('twokeys', {cd => 1}), "find multiple pks using relationships + args");
ok($schema->resultset("FourKeys")->search({ foo => 1, bar => 2 })->find({ hello => 3, goodbye => 4 }), "search on partial key followed by a find");
BEGIN {
eval "use DBD::SQLite";
- plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 3);
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 5);
}
my $art = $schema->resultset("Artist")->find(1);
$art->discard_changes;
+ok($art->update({ artistid => 100 }), 'update allows pk mutation');
+
+is($art->artistid, 100, 'pk mutation applied');
plan tests => 5;
-DBICTest::Schema->compose_connection('MySQLTest' => $dsn, $user, $pass);
+DBICTest::Schema->compose_namespace('MySQLTest' => $dsn, $user, $pass);
my $dbh = MySQLTest->schema->storage->dbh;
plan tests => 8;
DBICTest::Schema->load_classes( 'Casecheck' );
-DBICTest::Schema->compose_connection('PgTest' => $dsn, $user, $pass);
+DBICTest::Schema->compose_namespace('PgTest' => $dsn, $user, $pass);
my $dbh = PgTest->schema->storage->dbh;
PgTest->schema->source("Artist")->name("testschema.artist");
plan tests => 6;
-DBICTest::Schema->compose_connection('OraTest' => $dsn, $user, $pass);
+DBICTest::Schema->compose_namespace('OraTest' => $dsn, $user, $pass);
my $dbh = OraTest->schema->storage->dbh;
plan tests => 6;
-DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass);
+DBICTest::Schema->compose_namespace('DB2Test' => $dsn, $user, $pass);
my $dbh = DB2Test->schema->storage->dbh;
plan tests => 6;
-DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass);
+DBICTest::Schema->compose_namespace('DB2Test' => $dsn, $user, $pass);
my $dbh = DB2Test->schema->storage->dbh;
# Add more for others in the future when they exist (ODBC? ADO? JDBC?)
DBICTest::Schema->storage_type($storage_type);
-DBICTest::Schema->compose_connection( 'MSSQLTest' => $dsn, $user, $pass );
+DBICTest::Schema->compose_namespace( 'MSSQLTest' => $dsn, $user, $pass );
my $dbh = MSSQLTest->schema->storage->dbh;
DBICTest::Schema->storage(undef); # just in case?
DBICTest::Schema->storage_type('::DBI::MySQLNoBindVars');
-DBICTest::Schema->compose_connection('MySQLTest' => $dsn, $user, $pass);
+DBICTest::Schema->compose_namespace('MySQLTest' => $dsn, $user, $pass);
my $dbh = MySQLTest->schema->storage->dbh;
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ eval "use DBD::SQLite; use SQL::Translator;";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite and SQL::Translator for testing' )
+ : ( tests => 6 );
+}
+
+use lib qw(t/lib);
+
+use_ok('DBICVersionOrig');
+
+my $db_file = "t/var/versioning.db";
+unlink($db_file) if -e $db_file;
+unlink($db_file . "-journal") if -e $db_file . "-journal";
+mkdir("t/var") unless -d "t/var";
+unlink('t/var/DBICVersion-Schema-1.0-SQLite.sql');
+
+my $schema_orig = DBICVersion::Schema->connect("dbi:SQLite:$db_file");
+# $schema->storage->ensure_connected();
+
+is($schema_orig->ddl_filename('SQLite', 't/var', '1.0'), 't/var/DBICVersion-Schema-1.0-SQLite.sql', 'Filename creation working');
+$schema_orig->create_ddl_dir('SQLite', undef, 't/var');
+
+ok(-f 't/var/DBICVersion-Schema-1.0-SQLite.sql', 'Created DDL file');
+## do this here or let Versioned.pm do it?
+# $schema->deploy();
+
+my $tvrs = $schema_orig->resultset('Table');
+is($schema_orig->exists($tvrs), 1, 'Created schema from DDL file');
+
+eval "use DBICVersionNew";
+my $schema_new = DBICVersion::Schema->connect("dbi:SQLite:$db_file");
+
+unlink('t/var/DBICVersion-Schema-2.0-SQLite.sql');
+unlink('t/var/DBICVersion-Schema-1.0-2.0-SQLite.sql');
+$schema_new->create_ddl_dir('SQLite', undef, 't/var', '1.0');
+ok(-f 't/var/DBICVersion-Schema-1.0-2.0-SQLite.sql', 'Created DDL upgrade file');
+
+## create new to pick up filedata for upgrade files we just made (on_connect)
+my $schema_upgrade = DBICVersion::Schema->connect("dbi:SQLite:$db_file");
+
+## do this here or let Versioned.pm do it?
+$schema_upgrade->upgrade();
+$tvrs = $schema_upgrade->resultset('Table');
+is($schema_upgrade->exists($tvrs), 1, 'Upgraded schema from DDL file');
use_ok('DBICTest');
-DBICTest->init_schema();
+my $schema = DBICTest->init_schema();
-my $sql_maker = DBICTest->schema->storage->sql_maker;
+my $sql_maker = $schema->storage->sql_maker;
$sql_maker->quote_char('`');
$sql_maker->name_sep('.');
use lib 't/lib';
use_ok('DBICTest');
-DBICTest->init_schema();
+my $schema = DBICTest->init_schema();
-DBICTest::CD->load_components(qw/CDBICompat::Pager/);
+DBICTest::CD->load_components(qw/CDBICompat CDBICompat::Pager/);
+
+DBICTest::CD->result_source_instance->schema($schema);
my ( $pager, $it ) = DBICTest::CD->page(
{},
my $dbuser = $ENV{"DBICTEST_DBUSER"} || '';
my $dbpass = $ENV{"DBICTEST_DBPASS"} || '';
- my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn, $dbuser, $dbpass);
+ my $schema = DBICTest::Schema->compose_namespace('DBICTest')
+ ->connect($dsn, $dbuser, $dbpass);
$schema->storage->on_connect_do(['PRAGMA synchronous = OFF']);
if ( !$args{no_deploy} ) {
__PACKAGE__->deploy_schema( $schema );
use base 'DBIx::Class::Core';
-DBICTest::Schema::FourKeys->table('fourkeys');
-DBICTest::Schema::FourKeys->add_columns(
+__PACKAGE__->table('fourkeys');
+__PACKAGE__->add_columns(
'foo' => { data_type => 'integer' },
'bar' => { data_type => 'integer' },
'hello' => { data_type => 'integer' },
'goodbye' => { data_type => 'integer' },
'sensors' => { data_type => 'character' },
);
-DBICTest::Schema::FourKeys->set_primary_key(qw/foo bar hello goodbye/);
+__PACKAGE__->set_primary_key(qw/foo bar hello goodbye/);
-DBICTest::Schema::FourKeys->has_many(
- 'fourkeys_to_twokeys', 'DBICTest::Schema::FourKeys_to_TwoKeys', {
+__PACKAGE__->has_many(
+ 'fourkeys_to_twokeys', '__PACKAGE___to_TwoKeys', {
'foreign.f_foo' => 'self.foo',
'foreign.f_bar' => 'self.bar',
'foreign.f_hello' => 'self.hello',
'foreign.f_goodbye' => 'self.goodbye',
});
-DBICTest::Schema::FourKeys->many_to_many(
+__PACKAGE__->many_to_many(
'twokeys', 'fourkeys_to_twokeys', 'twokeys',
);
use base qw/DBIx::Class::Core/;
-DBICTest::Schema::LinerNotes->table('liner_notes');
-DBICTest::Schema::LinerNotes->add_columns(
+__PACKAGE__->table('liner_notes');
+__PACKAGE__->add_columns(
'liner_id' => {
data_type => 'integer',
},
size => 100,
},
);
-DBICTest::Schema::LinerNotes->set_primary_key('liner_id');
-DBICTest::Schema::LinerNotes->belongs_to(
+__PACKAGE__->set_primary_key('liner_id');
+__PACKAGE__->belongs_to(
'cd', 'DBICTest::Schema::CD', 'liner_id'
);
use base 'DBIx::Class::Core';
-DBICTest::Schema::NoPrimaryKey->table('noprimarykey');
-DBICTest::Schema::NoPrimaryKey->add_columns(
+__PACKAGE__->table('noprimarykey');
+__PACKAGE__->add_columns(
'foo' => { data_type => 'integer' },
'bar' => { data_type => 'integer' },
'baz' => { data_type => 'integer' },
);
-DBICTest::Schema::NoPrimaryKey->add_unique_constraint(foo_bar => [ qw/foo bar/ ]);
+__PACKAGE__->add_unique_constraint(foo_bar => [ qw/foo bar/ ]);
1;
use base 'DBIx::Class::Core';
-DBICTest::Schema::OneKey->table('onekey');
-DBICTest::Schema::OneKey->add_columns(
+__PACKAGE__->table('onekey');
+__PACKAGE__->add_columns(
'id' => {
data_type => 'integer',
is_auto_increment => 1,
data_type => 'integer',
},
);
-DBICTest::Schema::OneKey->set_primary_key('id');
+__PACKAGE__->set_primary_key('id');
1;
use base 'DBIx::Class::Core';
-DBICTest::Schema::Serialized->table('serialized');
-DBICTest::Schema::Serialized->add_columns(
+__PACKAGE__->table('serialized');
+__PACKAGE__->add_columns(
'id' => { data_type => 'integer' },
'serialized' => { data_type => 'text' },
);
-DBICTest::Schema::Serialized->set_primary_key('id');
+__PACKAGE__->set_primary_key('id');
1;
--- /dev/null
+package DBICVersion::Table;
+
+use base 'DBIx::Class';
+use strict;
+use warnings;
+
+__PACKAGE__->load_components(qw/ Core/);
+__PACKAGE__->table('TestVersion');
+
+__PACKAGE__->add_columns
+ ( 'Version' => {
+ 'data_type' => 'INTEGER',
+ 'is_auto_increment' => 1,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => ''
+ },
+ 'VersionName' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 1,
+ 'size' => '20'
+ },
+ );
+
+__PACKAGE__->set_primary_key('Version');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '2.0';
+
+__PACKAGE__->register_class('Table', 'DBICVersion::Table');
+__PACKAGE__->load_components('+DBIx::Class::Schema::Versioned');
+
+sub upgrade_directory
+{
+ return 't/var/';
+}
+
+1;
--- /dev/null
+package DBICVersion::Table;
+
+use base 'DBIx::Class';
+use strict;
+use warnings;
+
+__PACKAGE__->load_components(qw/ Core/);
+__PACKAGE__->table('TestVersion');
+
+__PACKAGE__->add_columns
+ ( 'Version' => {
+ 'data_type' => 'INTEGER',
+ 'is_auto_increment' => 1,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => ''
+ },
+ 'VersionName' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => '10'
+ },
+ );
+
+__PACKAGE__->set_primary_key('Version');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '1.0';
+
+__PACKAGE__->register_class('Table', 'DBICVersion::Table');
+__PACKAGE__->load_components('+DBIx::Class::Schema::Versioned');
+
+sub upgrade_directory
+{
+ return 't/var/';
+}
+
+1;
projects / dbsrgits/DBIx-Class.git / commitdiff