lib/DBIx/Class/Schema/Versioned.pm

   1 package # Hide from PAUSE
   2   DBIx::Class::Version::Table;
   3 use base 'DBIx::Class::Core';
   4 use strict;
   5 use warnings;
   6
   7 __PACKAGE__->table('dbix_class_schema_versions');
   8
   9 __PACKAGE__->add_columns
  10     ( 'version' => {
  11         'data_type' => 'VARCHAR',
  12         'is_auto_increment' => 0,
  13         'default_value' => undef,
  14         'is_foreign_key' => 0,
  15         'name' => 'version',
  16         'is_nullable' => 0,
  17         'size' => '10'
  18         },
  19       'installed' => {
  20           'data_type' => 'VARCHAR',
  21           'is_auto_increment' => 0,
  22           'default_value' => undef,
  23           'is_foreign_key' => 0,
  24           'name' => 'installed',
  25           'is_nullable' => 0,
  26           'size' => '20'
  27           },
  28       );
  29 __PACKAGE__->result_source_instance->set_primary_key('version');
  30
  31 package # Hide from PAUSE
  32   DBIx::Class::Version::TableCompat;
  33 use base 'DBIx::Class::Core';
  34 __PACKAGE__->table('SchemaVersions');
  35
  36 __PACKAGE__->add_columns
  37     ( 'Version' => {
  38         'data_type' => 'VARCHAR',
  39         },
  40       'Installed' => {
  41           'data_type' => 'VARCHAR',
  42           },
  43       );
  44 __PACKAGE__->result_source_instance->set_primary_key('Version');
  45
  46 package # Hide from PAUSE
  47   DBIx::Class::Version;
  48 use base 'DBIx::Class::Schema';
  49 use strict;
  50 use warnings;
  51
  52 # no point sanity checking, unless we are running asserts
  53 __PACKAGE__->schema_sanity_checker(
  54   DBIx::Class::_ENV_::ASSERT_NO_FAILING_SANITY_CHECKS
  55     ? 'DBIx::Class::Schema::SanityChecker'
  56     : ''
  57 );
  58
  59 __PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table');
  60
  61 package # Hide from PAUSE
  62   DBIx::Class::VersionCompat;
  63 use base 'DBIx::Class::Schema';
  64 use strict;
  65 use warnings;
  66
  67 # no point sanity checking, unless we are running asserts
  68 __PACKAGE__->schema_sanity_checker(
  69   DBIx::Class::_ENV_::ASSERT_NO_FAILING_SANITY_CHECKS
  70     ? 'DBIx::Class::Schema::SanityChecker'
  71     : ''
  72 );
  73
  74 __PACKAGE__->register_class('TableCompat', 'DBIx::Class::Version::TableCompat');
  75
  76
  77 # ---------------------------------------------------------------------------
  78
  79 =head1 NAME
  80
  81 DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
  82
  83 =head1 SYNOPSIS
  84
  85   package MyApp::Schema;
  86   use base qw/DBIx::Class::Schema/;
  87
  88   our $VERSION = 0.001;
  89
  90   # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD
  91   __PACKAGE__->load_classes(qw/CD Book DVD/);
  92
  93   __PACKAGE__->load_components(qw/Schema::Versioned/);
  94   __PACKAGE__->upgrade_directory('/path/to/upgrades/');
  95
  96
  97 =head1 DESCRIPTION
  98
  99 This module provides methods to apply DDL changes to your database using SQL
 100 diff files. Normally these diff files would be created using
 101 L<DBIx::Class::Schema/create_ddl_dir>.
 102
 103 A table called I<dbix_class_schema_versions> is created and maintained by the
 104 module. This is used to determine which version your database is currently at.
 105 Similarly the $VERSION in your DBIC schema class is used to determine the
 106 current DBIC schema version.
 107
 108 The upgrade is initiated manually by calling C<upgrade> on your schema object,
 109 this will attempt to upgrade the database from its current version to the current
 110 schema version using a diff from your I<upgrade_directory>. If a suitable diff is
 111 not found then no upgrade is possible.
 112
 113 =head1 SEE ALSO
 114
 115 L<DBIx::Class::DeploymentHandler> is a much more powerful alternative to this
 116 module.  Examples of things it can do that this module cannot do include
 117
 118 =over
 119
 120 =item *
 121
 122 Downgrades in addition to upgrades
 123
 124 =item *
 125
 126 Multiple sql files per upgrade/downgrade/install
 127
 128 =item *
 129
 130 Perl scripts allowed for upgrade/downgrade/install
 131
 132 =item *
 133
 134 Just one set of files needed for upgrade, unlike this module where one might
 135 need to generate C<factorial(scalar @versions)>
 136
 137 =back
 138
 139 =head1 GETTING STARTED
 140
 141 Firstly you need to setup your schema class as per the L</SYNOPSIS>, make sure
 142 you have specified an upgrade_directory and an initial $VERSION.
 143
 144 Then you'll need two scripts, one to create DDL files and diffs and another to perform
 145 upgrades. Your creation script might look like a bit like this:
 146
 147   use strict;
 148   use Pod::Usage;
 149   use Getopt::Long;
 150   use MyApp::Schema;
 151
 152   my ( $preversion, $help );
 153   GetOptions(
 154     'p|preversion:s'  => \$preversion,
 155   ) or die pod2usage;
 156
 157   my $schema = MyApp::Schema->connect(
 158     $dsn,
 159     $user,
 160     $password,
 161   );
 162   my $sql_dir = './sql';
 163   my $version = $schema->schema_version();
 164   $schema->create_ddl_dir( 'MySQL', $version, $sql_dir, $preversion );
 165
 166 Then your upgrade script might look like so:
 167
 168   use strict;
 169   use MyApp::Schema;
 170
 171   my $schema = MyApp::Schema->connect(
 172     $dsn,
 173     $user,
 174     $password,
 175   );
 176
 177   if (!$schema->get_db_version()) {
 178     # schema is unversioned
 179     $schema->deploy();
 180   } else {
 181     $schema->upgrade();
 182   }
 183
 184 The script above assumes that if the database is unversioned then it is empty
 185 and we can safely deploy the DDL to it. However things are not always so simple.
 186
 187 if you want to initialise a pre-existing database where the DDL is not the same
 188 as the DDL for your current schema version then you will need a diff which
 189 converts the database's DDL to the current DDL. The best way to do this is
 190 to get a dump of the database schema (without data) and save that in your
 191 SQL directory as version 0.000 (the filename must be as with
 192 L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL
 193 script given above from version 0.000 to the current version. Then hand check
 194 and if necessary edit the resulting diff to ensure that it will apply. Once you have
 195 done all that you can do this:
 196
 197   if (!$schema->get_db_version()) {
 198     # schema is unversioned
 199     $schema->install("0.000");
 200   }
 201
 202   # this will now apply the 0.000 to current version diff
 203   $schema->upgrade();
 204
 205 In the case of an unversioned database the above code will create the
 206 dbix_class_schema_versions table and write version 0.000 to it, then
 207 upgrade will then apply the diff we talked about creating in the previous paragraph
 208 and then you're good to go.
 209
 210 =cut
 211
 212 package DBIx::Class::Schema::Versioned;
 213
 214 use strict;
 215 use warnings;
 216 use base 'DBIx::Class::Schema';
 217
 218 use DBIx::Class::Carp;
 219 use DBIx::Class::_Util qw( dbic_internal_try UNRESOLVABLE_CONDITION );
 220 use Scalar::Util 'weaken';
 221 use namespace::clean;
 222
 223 __PACKAGE__->mk_group_accessors( inherited => qw(
 224   _filedata
 225   upgrade_directory
 226   backup_directory
 227   do_backup
 228   do_diff_on_init
 229 ) );
 230
 231
 232 =head1 METHODS
 233
 234 =head2 upgrade_directory
 235
 236 Use this to set the directory your upgrade files are stored in.
 237
 238 =head2 backup_directory
 239
 240 Use this to set the directory you want your backups stored in (note that backups
 241 are disabled by default).
 242
 243 =cut
 244
 245 =head2 install
 246
 247 =over 4
 248
 249 =item Arguments: $db_version
 250
 251 =back
 252
 253 Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database version.
 254
 255 Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
 256
 257 See L</GETTING STARTED> for more details.
 258
 259 =cut
 260
 261 sub install
 262 {
 263   my ($self, $new_version) = @_;
 264
 265   # must be called on a fresh database
 266   if ($self->get_db_version()) {
 267       $self->throw_exception("A versioned schema has already been deployed, try upgrade instead.\n");
 268   }
 269
 270   # default to current version if none passed
 271   $new_version ||= $self->schema_version();
 272
 273   if ($new_version) {
 274     # create versions table and version row
 275     $self->{vschema}->deploy;
 276     $self->_set_db_version({ version => $new_version });
 277   }
 278 }
 279
 280 =head2 deploy
 281
 282 Same as L<DBIx::Class::Schema/deploy> but also calls C<install>.
 283
 284 =cut
 285
 286 sub deploy {
 287   my $self = shift;
 288   $self->next::method(@_);
 289   $self->install();
 290 }
 291
 292 =head2 create_upgrade_path
 293
 294 =over 4
 295
 296 =item Arguments: { upgrade_file => $file }
 297
 298 =back
 299
 300 Virtual method that should be overridden to create an upgrade file.
 301 This is useful in the case of upgrading across multiple versions
 302 to concatenate several files to create one upgrade file.
 303
 304 You'll probably want the db_version retrieved via $self->get_db_version
 305 and the schema_version which is retrieved via $self->schema_version
 306
 307 =cut
 308
 309 sub create_upgrade_path {
 310   ## override this method
 311 }
 312
 313 =head2 ordered_schema_versions
 314
 315 =over 4
 316
 317 =item Return Value: a list of version numbers, ordered from lowest to highest
 318
 319 =back
 320
 321 Virtual method that should be overridden to return an ordered list
 322 of schema versions. This is then used to produce a set of steps to
 323 upgrade through to achieve the required schema version.
 324
 325 You may want the db_version retrieved via $self->get_db_version
 326 and the schema_version which is retrieved via $self->schema_version
 327
 328 =cut
 329
 330 sub ordered_schema_versions {
 331   ## override this method
 332 }
 333
 334 =head2 upgrade
 335
 336 Call this to attempt to upgrade your database from the version it
 337 is at to the version this DBIC schema is at. If they are the same
 338 it does nothing.
 339
 340 It will call L</ordered_schema_versions> to retrieve an ordered
 341 list of schema versions (if ordered_schema_versions returns nothing
 342 then it is assumed you can do the upgrade as a single step). It
 343 then iterates through the list of versions between the current db
 344 version and the schema version applying one update at a time until
 345 all relevant updates are applied.
 346
 347 The individual update steps are performed by using
 348 L</upgrade_single_step>, which will apply the update and also
 349 update the dbix_class_schema_versions table.
 350
 351 =cut
 352
 353 sub upgrade {
 354     my ($self) = @_;
 355     my $db_version = $self->get_db_version();
 356
 357     # db unversioned
 358     unless ($db_version) {
 359         carp 'Upgrade not possible as database is unversioned. Please call install first.';
 360         return;
 361     }
 362
 363     # db and schema at same version. do nothing
 364     if ( $db_version eq $self->schema_version ) {
 365         carp 'Upgrade not necessary';
 366         return;
 367     }
 368
 369     my @version_list = $self->ordered_schema_versions;
 370
 371     # if nothing returned then we preload with min/max
 372     @version_list = ( $db_version, $self->schema_version )
 373       unless ( scalar(@version_list) );
 374
 375     # catch the case of someone returning an arrayref
 376     @version_list = @{ $version_list[0] }
 377       if ( ref( $version_list[0] ) eq 'ARRAY' );
 378
 379     # remove all versions in list above the required version
 380     while ( scalar(@version_list)
 381         && ( $version_list[-1] ne $self->schema_version ) )
 382     {
 383         pop @version_list;
 384     }
 385
 386     # remove all versions in list below the current version
 387     while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) {
 388         shift @version_list;
 389     }
 390
 391     # check we have an appropriate list of versions
 392     if ( scalar(@version_list) < 2 ) {
 393         die;
 394     }
 395
 396     # do sets of upgrade
 397     while ( scalar(@version_list) >= 2 ) {
 398         $self->upgrade_single_step( $version_list[0], $version_list[1] );
 399         shift @version_list;
 400     }
 401 }
 402
 403 =head2 upgrade_single_step
 404
 405 =over 4
 406
 407 =item Arguments: db_version - the version currently within the db
 408
 409 =item Arguments: target_version - the version to upgrade to
 410
 411 =back
 412
 413 Call this to attempt to upgrade your database from the
 414 I<db_version> to the I<target_version>. If they are the same it
 415 does nothing.
 416
 417 It requires an SQL diff file to exist in your I<upgrade_directory>,
 418 normally you will have created this using L<DBIx::Class::Schema/create_ddl_dir>.
 419
 420 If successful the dbix_class_schema_versions table is updated with
 421 the I<target_version>.
 422
 423 This method may be called repeatedly by the upgrade method to
 424 upgrade through a series of updates.
 425
 426 =cut
 427
 428 sub upgrade_single_step
 429 {
 430   my ($self,
 431       $db_version,
 432       $target_version) = @_;
 433
 434   # db and schema at same version. do nothing
 435   if ($db_version eq $target_version) {
 436     carp 'Upgrade not necessary';
 437     return;
 438   }
 439
 440   # strangely the first time this is called can
 441   # differ to subsequent times. so we call it
 442   # here to be sure.
 443   # XXX - just fix it
 444   $self->storage->sqlt_type;
 445
 446   my $upgrade_file = $self->ddl_filename(
 447                                          $self->storage->sqlt_type,
 448                                          $target_version,
 449                                          $self->upgrade_directory,
 450                                          $db_version,
 451                                         );
 452
 453   $self->create_upgrade_path({ upgrade_file => $upgrade_file });
 454
 455   unless (-f $upgrade_file) {
 456     carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one";
 457     return;
 458   }
 459
 460   carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
 461
 462   # backup if necessary then apply upgrade
 463   $self->_filedata($self->_read_sql_file($upgrade_file));
 464   $self->backup() if($self->do_backup);
 465   $self->txn_do(sub { $self->do_upgrade() });
 466
 467   # set row in dbix_class_schema_versions table
 468   $self->_set_db_version({version => $target_version});
 469 }
 470
 471 =head2 do_upgrade
 472
 473 This is an overwritable method used to run your upgrade. The freeform method
 474 allows you to run your upgrade any way you please, you can call C<run_upgrade>
 475 any number of times to run the actual SQL commands, and in between you can
 476 sandwich your data upgrading. For example, first run all the B<CREATE>
 477 commands, then migrate your data from old to new tables/formats, then
 478 issue the DROP commands when you are finished. Will run the whole file as it is by default.
 479
 480 =cut
 481
 482 sub do_upgrade
 483 {
 484   my ($self) = @_;
 485
 486   # just run all the commands (including inserts) in order
 487   $self->run_upgrade(qr/.*?/);
 488 }
 489
 490 =head2 run_upgrade
 491
 492  $self->run_upgrade(qr/create/i);
 493
 494 Runs a set of SQL statements matching a passed in regular expression. The
 495 idea is that this method can be called any number of times from your
 496 C<do_upgrade> method, running whichever commands you specify via the
 497 regex in the parameter. Probably won't work unless called from the overridable
 498 do_upgrade method.
 499
 500 =cut
 501
 502 sub run_upgrade
 503 {
 504     my ($self, $stm) = @_;
 505
 506     return unless ($self->_filedata);
 507     my @statements = grep { $_ =~ $stm } @{$self->_filedata};
 508     $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
 509
 510     for (@statements)
 511     {
 512         $self->storage->debugobj->query_start($_) if $self->storage->debug;
 513         $self->apply_statement($_);
 514         $self->storage->debugobj->query_end($_) if $self->storage->debug;
 515     }
 516
 517     return 1;
 518 }
 519
 520 =head2 apply_statement
 521
 522 Takes an SQL statement and runs it. Override this if you want to handle errors
 523 differently.
 524
 525 =cut
 526
 527 sub apply_statement {
 528     my ($self, $statement) = @_;
 529
 530     $self->storage->dbh->do($_) or carp "SQL was: $_";
 531 }
 532
 533 =head2 get_db_version
 534
 535 Returns the version that your database is currently at. This is determined by the values in the
 536 dbix_class_schema_versions table that C<upgrade> and C<install> write to.
 537
 538 =cut
 539
 540 sub get_db_version
 541 {
 542     my ($self, $rs) = @_;
 543
 544     my $vtable = $self->{vschema}->resultset('Table');
 545     my $version = dbic_internal_try {
 546       $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
 547               ->get_column ('version')
 548                ->next;
 549     };
 550     return $version || 0;
 551 }
 552
 553 =head2 schema_version
 554
 555 Returns the current schema class' $VERSION
 556
 557 =cut
 558
 559 =head2 backup
 560
 561 This is an overwritable method which is called just before the upgrade, to
 562 allow you to make a backup of the database. Per default this method attempts
 563 to call C<< $self->storage->backup >>, to run the standard backup on each
 564 database type.
 565
 566 This method should return the name of the backup file, if appropriate..
 567
 568 This method is disabled by default. Set $schema->do_backup(1) to enable it.
 569
 570 =cut
 571
 572 sub backup
 573 {
 574     my ($self) = @_;
 575     ## Make each ::DBI::Foo do this
 576     $self->storage->backup($self->backup_directory());
 577 }
 578
 579 =head2 connection
 580
 581 Overloaded method. This checks the DBIC schema version against the DB version and
 582 warns if they are not the same or if the DB is unversioned. It also provides
 583 compatibility between the old versions table (SchemaVersions) and the new one
 584 (dbix_class_schema_versions).
 585
 586 To avoid the checks on connect, set the environment var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth argument like so:
 587
 588   my $schema = MyApp::Schema->connect(
 589     $dsn,
 590     $user,
 591     $password,
 592     { ignore_version => 1 },
 593   );
 594
 595 =cut
 596
 597 sub connection {
 598   my $self = shift;
 599   $self->next::method(@_);
 600   $self->_on_connect();
 601   return $self;
 602 }
 603
 604 sub _on_connect
 605 {
 606   my ($self) = @_;
 607
 608   weaken (my $w_storage = $self->storage );
 609
 610   $self->{vschema} = DBIx::Class::Version->clone->connection(
 611     sub { $w_storage->dbh },
 612
 613     # proxy some flags from the main storage
 614     { map { $_ => $w_storage->$_ } qw( unsafe ) },
 615   );
 616   my $conn_attrs = $w_storage->_dbic_connect_attributes || {};
 617
 618   my $vtable = $self->{vschema}->resultset('Table');
 619
 620   # useful when connecting from scripts etc
 621   return if ($conn_attrs->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $conn_attrs->{ignore_version}));
 622
 623   # check for legacy versions table and move to new if exists
 624   unless ($self->_source_exists($vtable)) {
 625     my $vtable_compat = DBIx::Class::VersionCompat->clone->connection(sub { $w_storage->dbh })->resultset('TableCompat');
 626     if ($self->_source_exists($vtable_compat)) {
 627       $self->{vschema}->deploy;
 628       map { $vtable->new_result({ installed => $_->Installed, version => $_->Version })->insert } $vtable_compat->all;
 629       $w_storage->_get_dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
 630     }
 631   }
 632
 633   my $pversion = $self->get_db_version();
 634
 635   if($pversion eq $self->schema_version)
 636     {
 637         #carp "This version is already installed";
 638         return 1;
 639     }
 640
 641   if(!$pversion)
 642     {
 643         carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.";
 644         return 1;
 645     }
 646
 647   carp "Versions out of sync. This is " . $self->schema_version .
 648     ", your database contains version $pversion, please call upgrade on your Schema.";
 649 }
 650
 651 # is this just a waste of time? if not then merge with DBI.pm
 652 sub _create_db_to_schema_diff {
 653   my $self = shift;
 654
 655   my %driver_to_db_map = (
 656                           'mysql' => 'MySQL'
 657                          );
 658
 659   my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
 660   unless ($db) {
 661     print "Sorry, this is an unsupported DB\n";
 662     return;
 663   }
 664
 665   require DBIx::Class::Optional::Dependencies;
 666   if ( my $missing = DBIx::Class::Optional::Dependencies->req_missing_for('deploy') ) {
 667     $self->throw_exception("Unable to proceed without $missing");
 668   }
 669
 670   my $db_tr = SQL::Translator->new({
 671                                     add_drop_table => 1,
 672                                     parser => 'DBI',
 673                                     parser_args => { dbh => $self->storage->dbh }
 674                                    });
 675
 676   $db_tr->producer($db);
 677   my $dbic_tr = SQL::Translator->new;
 678   $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
 679   $dbic_tr->data($self);
 680   $dbic_tr->producer($db);
 681
 682   $db_tr->schema->name('db_schema');
 683   $dbic_tr->schema->name('dbic_schema');
 684
 685   # is this really necessary?
 686   foreach my $tr ($db_tr, $dbic_tr) {
 687     my $data = $tr->data;
 688     $tr->parser->($tr, $$data);
 689   }
 690
 691   my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
 692                                                 $dbic_tr->schema, $db,
 693                                                 { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
 694
 695   my $filename = $self->ddl_filename(
 696                                          $db,
 697                                          $self->schema_version,
 698                                          $self->upgrade_directory,
 699                                          'PRE',
 700                                     );
 701   my $file;
 702   if(!open($file, ">$filename"))
 703     {
 704       $self->throw_exception("Can't open $filename for writing ($!)");
 705       next;
 706     }
 707   print $file $diff;
 708   close($file);
 709
 710   carp "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.";
 711 }
 712
 713
 714 sub _set_db_version {
 715   my $self = shift;
 716   my ($params) = @_;
 717   $params ||= {};
 718
 719   my $version = $params->{version} ? $params->{version} : $self->schema_version;
 720   my $vtable = $self->{vschema}->resultset('Table');
 721
 722   ##############################################################################
 723   #                             !!! NOTE !!!
 724   ##############################################################################
 725   #
 726   # The travesty below replaces the old nice timestamp format of %Y-%m-%d %H:%M:%S
 727   # This is necessary since there are legitimate cases when upgrades can happen
 728   # back to back within the same second. This breaks things since we relay on the
 729   # ability to sort by the 'installed' value. The logical choice of an autoinc
 730   # is not possible, as it will break multiple legacy installations. Also it is
 731   # not possible to format the string sanely, as the column is a varchar(20).
 732   # The 'v' character is added to the front of the string, so that any version
 733   # formatted by this new function will sort _after_ any existing 200... strings.
 734   require Time::HiRes;
 735   my @tm = Time::HiRes::gettimeofday();
 736   my @dt = gmtime ($tm[0]);
 737   my $o = $vtable->new_result({
 738     version => $version,
 739     installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
 740       $dt[5] + 1900,
 741       $dt[4] + 1,
 742       $dt[3],
 743       $dt[2],
 744       $dt[1],
 745       $dt[0],
 746       int($tm[1] / 1000), # convert to millisecs
 747     ),
 748   })->insert;
 749 }
 750
 751 sub _read_sql_file {
 752   my $self = shift;
 753   my $file = shift || return;
 754
 755   open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)");
 756   my @data = split /\n/, join '', <$fh>;
 757   close $fh;
 758
 759   @data = split /;/,
 760      join '',
 761        grep { $_ &&
 762               !/^--/  &&
 763               !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/mi }
 764          @data;
 765
 766   return \@data;
 767 }
 768
 769 sub _source_exists
 770 {
 771   my ($self, $rs) = @_;
 772
 773   ( dbic_internal_try {
 774     $rs->search( UNRESOLVABLE_CONDITION )->cursor->next;
 775     1;
 776   } )
 777     ? 1
 778     : 0
 779   ;
 780 }
 781
 782 =head1 FURTHER QUESTIONS?
 783
 784 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 785
 786 =head1 COPYRIGHT AND LICENSE
 787
 788 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 789 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 790 redistribute it and/or modify it under the same terms as the
 791 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 792
 793 =cut
 794
 795 1;