Merge 'DBIx-Class-current' into 'trunk'
Matt S Trout [Sun, 17 Jun 2007 19:27:08 +0000 (19:27 +0000)]
0.08000 release commit

1  2 
Changes
Makefile.PL
lib/DBIx/Class.pm
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Schema/Versioned.pm
t/03podcoverage.t

diff --cc Changes
+++ b/Changes
@@@ -1,6 -1,57 +1,58 @@@
  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
diff --cc Makefile.PL
@@@ -1,31 -1,39 +1,39 @@@
- # 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;
@@@ -13,7 -18,7 +18,7 @@@ sub component_base_class { 'DBIx::Class
  # i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
  # brain damage and presumably various other packaging systems too
  
- $VERSION = '0.07006';
 -$VERSION = '0.07999_06';
++$VERSION = '0.08000';
  
  sub MODIFY_CODE_ATTRIBUTES {
    my ($class,$code,@attrs) = @_;
@@@ -482,9 -676,10 +676,9 @@@ sub connection 
    $self->throw_exception(
      "No arguments to load_classes and couldn't load ${storage_class} ($@)"
    ) if $@;
-   my $storage = $storage_class->new;
+   my $storage = $storage_class->new($self);
    $storage->connect_info(\@info);
    $self->storage($storage);
 -  $self->on_connect() if($self->can('on_connect'));
    return $self;
  }
  
index 0000000,dd297ff..ea662b3
mode 000000,100644..100644
--- /dev/null
@@@ -1,0 -1,321 +1,321 @@@
+ 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>
@@@ -70,6 -70,6 +70,18 @@@ my $exceptions = 
      'DBIx::Class::Storage::DBI::mysql'                  => { skip => 1 },
      'SQL::Translator::Parser::DBIx::Class'              => { skip => 1 },
      'SQL::Translator::Producer::DBIx::Class::File'      => { skip => 1 },
++
++# skipped because the synopsis covers it clearly
++
++    'DBIx::Class::InflateColumn::File'                  => { skip => 1 },
++
++# skipped because two methods may not need to be public
++
++    'DBIx::Class::Schema::Versioned' => { ignore => [ qw(on_connect exists) ] },
++
++# must kill authors.
++
++    'DBIx::Class::Storage::DBI::Replication' => { skip => 1 },
  };
  
  foreach my $module (@modules) {