view release on metacpan or  search on metacpan

t/lib/DBICTest.pm  view on Meta::CPAN

=head1 NAME

DBICTest - Library to be used by DBIx::Class test scripts.

=head1 SYNOPSIS

  use lib qw(t/lib);
  use DBICTest;
  use Test::More;
  
  my $schema = DBICTest->init_schema();

=head1 DESCRIPTION

This module provides the basic utilities to write tests against 
DBIx::Class.

=head1 METHODS

=head2 init_schema

  my $schema = DBICTest->init_schema(
    no_deploy=>1,
    no_populate=>1,
  );

This method removes the test SQLite database in t/var/DBIxClass.db 
and then creates a new, empty database.

This method will call deploy_schema() by default, unless the 
no_deploy flag is set.

Also, by default, this method will call populate_schema() by 
default, unless the no_deploy or no_populate flags are set.

=cut

sub init_schema {
    my $self = shift;
    my %args = @_;

    my $db_file
        = $args{db_dir}
        ? "$args{db_dir}/DBIxClass.db"
        : "t/var/DBIxClass.db"
        ;

    mkdir("t/var") unless -d "t/var";
    if ( !$args{no_deploy} ) {
      unlink($db_file) if -e $db_file;
      unlink($db_file . "-journal") if -e $db_file . "-journal";
    }

    my $dsn = $args{"dsn"} || "dbi:SQLite:${db_file}";
    my $dbuser = $args{"user"} || '';
    my $dbpass = $args{"pass"} || '';

    my $schema;

    my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1, sqlite_unicode => 1 });

    if ($args{compose_connection}) {
      $schema = DBICTest::Schema->compose_connection(
                  'DBICTest', @connect_info
                );
    } else {
      $schema = DBICTest::Schema->compose_namespace('DBICTest')
                                ->connect(@connect_info);
    }

    if ( !$args{no_deploy} ) {
        __PACKAGE__->deploy_schema( $schema );
        __PACKAGE__->populate_schema( $schema ) if( !$args{no_populate} );
    }
    return $schema;
}


sub get_ddl_file {
  my $self = shift;
  my $schema = shift;

  return 't/lib/' . lc($schema->storage->dbh->{Driver}->{Name}) . '.sql';
}

=head2 deploy_schema

  DBICTest->deploy_schema( $schema );

=cut

sub deploy_schema {
    my $self = shift;
    my $schema = shift;

    my $file = shift || $self->get_ddl_file($schema);
    open(  my $fh, "<",$file ) or die "couldnt open $file, $!";
    my $sql;
    { local $/ = undef; $sql = <$fh>; }

    foreach my $line (split(/;\n/, $sql)) {
      print "$line\n";
      next if(!$line);
      next if($line =~ /^--/);
      next if($line =~ /^BEGIN TRANSACTION/m);
      next if($line =~ /^COMMIT/m);
      next if $line =~ /^\s+$/; # skip whitespace only

      $schema->storage->dbh->do($line) || print "Error on SQL: $line\n";
    }
}
 

=head2 clear_schema

  DBICTest->clear_schema( $schema );

=cut

sub clear_schema {