#!/usr/bin/perl -w use strict; use File::Temp qw/ tempfile /; =head1 VARIABLES =head2 @SupportedDrivers Array of all supported DBD drivers. =cut our @SupportedDrivers = qw( Informix mysql mysqlPP ODBC Oracle Pg SQLite Sybase ); =head2 @AvailableDrivers Array that lists only drivers from supported list that user has installed. =cut our @AvailableDrivers = grep { eval "require DBD::". $_ } @SupportedDrivers; =head1 FUNCTIONS =head2 get_handle Returns new DB specific handle. Takes one argument DB C<$type>. Other arguments uses to construct handle. =cut sub get_handle { my $type = shift; my $class = 'DBIx::SearchBuilder::Handle::'. $type; eval "require $class"; die $@ if $@; my $handle; $handle = $class->new( @_ ); return $handle; } =head2 handle_to_driver Returns driver name which gets from C<$handle> object argument. =cut sub handle_to_driver { my $driver = ref($_[0]); $driver =~ s/^.*:://; return $driver; } =head2 connect_handle Connects C<$handle> object to DB. =cut sub connect_handle { my $call = "connect_". lc handle_to_driver( $_[0] ); return unless defined &$call; goto &$call; } =head2 connect_handle_with_driver($handle, $driver) Connects C<$handle> using driver C<$driver>; can use this to test the magic that turns a C into a C on C. =cut sub connect_handle_with_driver { my $call = "connect_". lc $_[1]; return unless defined &$call; @_ = $_[0]; goto &$call; } sub connect_sqlite { my ( $fh, $filename ) = tempfile(); close($fh); my $handle = shift; return $handle->Connect( Driver => 'SQLite', Database => $filename ); } sub connect_mysql { my $handle = shift; return $handle->Connect( Driver => 'mysql', Database => $ENV{'SB_TEST_MYSQL'}, User => $ENV{'SB_TEST_MYSQL_USER'} || 'root', Password => $ENV{'SB_TEST_MYSQL_PASS'} || '', ); } sub connect_pg { my $handle = shift; return $handle->Connect( Driver => 'Pg', Database => $ENV{'SB_TEST_PG'}, User => $ENV{'SB_TEST_PG_USER'} || 'postgres', Password => $ENV{'SB_TEST_PG_PASS'} || '', ); } sub connect_oracle { my $handle = shift; return $handle->Connect( Driver => 'Oracle', Database => $ENV{'SB_TEST_ORACLE'}, Host => $ENV{'SB_TEST_ORACLE_HOST'}, SID => $ENV{'SB_TEST_ORACLE_SID'}, User => $ENV{'SB_TEST_ORACLE_USER'} || 'test', Password => $ENV{'SB_TEST_ORACLE_PASS'} || 'test', ); } =head2 should_test Checks environment for C variables. Returns true if specified DB back-end should be tested. Takes one argument C<$driver> name. =cut sub should_test { my $driver = shift; return 1 if lc $driver eq 'sqlite'; my $env = 'SB_TEST_'. uc $driver; return $ENV{$env}; } =head2 had_schema Returns true if C<$class> has schema for C<$driver>. =cut sub has_schema { my ($class, $driver) = @_; my $method = 'schema_'. lc $driver; return UNIVERSAL::can( $class, $method ); } =head2 init_schema Takes C<$class> and C<$handle> and inits schema by calling C method of the C<$class>. Returns last C on success or last return value of the SimpleQuery method on error. =cut sub init_schema { my ($class, $handle) = @_; my $call = "schema_". lc handle_to_driver( $handle ); my $schema = $class->$call(); $schema = ref( $schema )? $schema : [$schema]; my $ret; foreach my $query( @$schema ) { $ret = $handle->SimpleQuery( $query ); return $ret unless UNIVERSAL::isa( $ret, 'DBI::st' ); } return $ret; } =head2 cleanup_schema Takes C<$class> and C<$handle> and cleanup schema by calling C method of the C<$class> if method exists. Always returns undef. =cut sub cleanup_schema { my ($class, $handle) = @_; my $call = "cleanup_schema_". lc handle_to_driver( $handle ); return unless UNIVERSAL::can( $class, $call ); my $schema = $class->$call(); $schema = ref( $schema )? $schema : [$schema]; foreach my $query( @$schema ) { eval { $handle->SimpleQuery( $query ) }; } } =head2 init_data =cut sub init_data { my ($class, $handle) = @_; my @data = $class->init_data(); my @columns = @{ shift @data }; my $count = 0; foreach my $values ( @data ) { my %args; for( my $i = 0; $i < @columns; $i++ ) { $args{ $columns[$i] } = $values->[$i]; } my $rec = $class->new( $handle ); my $id = $rec->Create( %args ); die "Couldn't create record" unless $id; $count++; } return $count; } 1;