Revision history for DBIx::Class
++0.08000 2007-06-17 18:06:12
+ - Fixed DBIC_TRACE debug filehandles to set ->autoflush(1)
+ - Fixed circular dbh<->storage in HandleError with weakref
+
+ 0.07999_06 2007-06-13 04:45:00
+ - tweaked Row.pm to make last_insert_id take multiple column names
+ - Fixed DBIC::Storage::DBI::Cursor::DESTROY bug that was
+ messing up exception handling
+ - added exception objects to eliminate stacktrace/Carp::Clan
+ output redundancy
+ - setting $ENV{DBIC_TRACE} defaults stacktrace on.
+ - added stacktrace option to Schema, makes throw_exception
+ use "confess"
+ - make database handles use throw_exception by default
+ - make database handles supplied by a coderef use our
+ standard HandleError/RaiseError/PrintError
+ - add "unsafe" connect_info option to suppress our setting
+ of HandleError/RaiseError/PrintError
+ - removed several redundant evals whose sole purpose was to
+ provide extra debugging info
+ - fixed page-within-page bug (reported by nilsonsfj)
+ - fixed rare bug when database is disconnected inbetween
+ "$dbh->prepare_cached" and "$sth->execute"
+
+ 0.07999_05 2007-06-07 23:00:00
+ - Made source_name rw in ResultSource
+ - Fixed up SQL::Translator test/runtime dependencies
+ - Fixed t/60core.t in the absence of DateTime::Format::MySQL
- Test cleanup and doc note (ribasushi)
+
+ 0.07999_04 2007-06-01 14:04:00
+ - pulled in Replication storage from branch and marked EXPERIMENTAL
+ - fixup to ensure join always LEFT after first LEFT join depthwise
+ - converted the vendor tests to use schema objects intead of schema
+ classes, made cleaned more reliable with END blocks
+ - versioning support via DBIx::Class::Schema::Versioned
+ - find/next now return undef rather than () on fail from Bernhard Graf
+ - rewritten collapse_result to fix prefetch
+ - moved populate to resultset
+ - added support for creation of related rows via insert and populate
+ - transaction support more robust now in the face of varying AutoCommit
+ and manual txn_begin usage
+ - unbreak back-compat for Row/ResultSet->new_result
+ - Added Oracle/WhereJoins.pm for Oracle >= 8 to support
+ Oracle <= 9i, and provide Oracle with a better join method for
+ later versions. (I use the term better loosely.)
+ - The SQL::T parser class now respects a relationship attribute of
+ is_foreign_key_constrain to allow explicit control over wether or
+ not a foreign constraint is needed
+ - resultset_class/result_class now (again) auto loads the specified
+ class; requires Class::Accessor::Grouped 0.05002+
+ - added get_inflated_columns to Row
+ - %colinfo accessor and inflate_column now work together
- More documentation updates
- Error messages from ->deploy made more informative
- connect_info will now always return the arguments it was
- CDBI compat infers has_many from has_a (Schwern)
- Fix ddl_filename transformation (Carl Vincent)
+ 0.07999_02 2007-01-25 20:11:00
+ - add support for binding BYTEA and similar parameters (w/Pg impl)
+ - add support to Ordered for multiple ordering columns
+ - mark DB.pm and compose_connection as deprecated
+ - switch tests to compose_namespace
- - ResltClass::HashRefInflator added
++ - ResultClass::HashRefInflator added
+ - Changed row and rs objects to not have direct handle to a source,
+ instead a (schema,source_name) tuple of type ResultSourceHandle
+
0.07005 2007-01-10 18:36:00
- fixup changes file
- remove erroneous .orig files - oops
- # Note: this file was auto-generated by Module::Build::Compat version 0.03
-
- unless (eval "use Module::Build::Compat 0.02; 1" ) {
- print "This module requires Module::Build to install itself.\n";
-
- require ExtUtils::MakeMaker;
- my $yn = ExtUtils::MakeMaker::prompt
- (' Install Module::Build now from CPAN?', 'y');
-
- unless ($yn =~ /^y/i) {
- die " *** Cannot install without Module::Build. Exiting ...\n";
- }
-
- require Cwd;
- require File::Spec;
- require CPAN;
-
- # Save this 'cause CPAN will chdir all over the place.
- my $cwd = Cwd::cwd();
-
- CPAN::Shell->install('Module::Build::Compat');
- CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
- or die "Couldn't install Module::Build, giving up.\n";
-
- chdir $cwd or die "Cannot chdir() back to $cwd: $!";
- }
- eval "use Module::Build::Compat 0.02; 1" or die $@;
-
- Module::Build::Compat->run_build_pl(args => \@ARGV);
- require Module::Build;
- Module::Build::Compat->write_makefile(build_class => 'Module::Build');
-use inc::Module::Install 0.64;
++use inc::Module::Install 0.67;
+
+ name 'DBIx-Class';
+ all_from 'lib/DBIx/Class.pm';
+ perl_version '5.006001';
+
+ requires 'Cwd' => 3.19;
+ requires 'Data::Page' => 2.00;
+ requires 'Scalar::Util' => 0;
+ requires 'SQL::Abstract' => 1.20;
+ requires 'SQL::Abstract::Limit' => 0.101;
+ requires 'Class::C3' => 0.13;
+ requires 'Storable' => 0;
+ requires 'Carp::Clan' => 0;
+ requires 'DBI' => 1.40;
+ requires 'Module::Find' => 0;
+ requires 'Class::Inspector' => 0;
+ requires 'Class::Accessor::Grouped' => 0.05002;
+ requires 'JSON' => 1.00;
+
+ # Perl 5.8.0 doesn't have utf8::is_utf8()
+ requires 'Encode' => 0 if ($] <= 5.008000);
+
+ build_requires 'DBD::SQLite' => 1.11;
+
+ install_script 'script/dbicadmin';
+
+ tests "t/*.t t/*/*.t";
+
+ # re-build README if we're in an svk checkout
+ if( -e 'MANIFEST.SKIP' ) {
+ system('pod2text lib/DBIx/Class.pm > README');
+ }
+
+ auto_provides;
+
+ auto_install;
+
+ WriteAll;
--- /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');
+ __PACKAGE__->mk_classdata('backup_directory');
+
+ sub schema_version {
+ my ($self) = @_;
+ my $class = ref($self)||$self;
+ my $version;
+ {
+ no strict 'refs';
+ $version = ${"${class}::VERSION"};
+ }
+ return $version;
+ }
+
-sub on_connect
++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->schema_version)
+ {
+ warn "This version is already installed\n";
+ return 1;
+ }
+
+ ## use IC::DT?
+
+ if(!$pversion)
+ {
+ $vtable->create({ Version => $self->schema_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->schema_version
+ );
+ if(!$file)
+ {
+ # No upgrade path between these two versions
+ return 1;
+ }
+
+ $file = $self->ddl_filename(
+ $self->storage->sqlt_type,
+ $self->upgrade_directory,
+ $self->schema_version,
+ $pversion,
+ );
+ # $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_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->schema_version .
+ ", your database contains version $pversion, please call upgrade on your Schema.\n";
+ # $self->upgrade($pversion, $self->schema_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($self->backup_directory());
+ }
+
+ 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->schema_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/');
+ __PACKAGE__->backup_directory('/path/to/backups/');
+
+ 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.
+
+ The actual upgrade is called manually by calling C<upgrade> on your
+ schema object. Code is run at connect time to determine whether an
+ upgrade is needed, if so, a warning "Versions out of sync" is
+ produced.
+
+ 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.
+
+ =head2 upgrade_directory
+
+ Use this to set the directory your upgrade files are stored in.
+
+ =head2 backup_directory
+
+ Use this to set the directory you want your backups stored in.
+
+ =head2 schema_version
+
+ Returns the current schema class' $VERSION; 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.
+
+ =head1 AUTHOR
+
+ Jess Robinson <castaway@desert-island.demon.co.uk>