[Rt-commit] r3885 - in Jifty-DBI/trunk: . t

[ruz at bestpractical.com]

Author: ruz
Date: Sun Sep 25 04:58:59 2005
New Revision: 3885

Modified:
   Jifty-DBI/trunk/   (props changed)
   Jifty-DBI/trunk/t/utils.pl
Log:
 r2504 at cubic-pc:  cubic | 2005-09-24 10:52:31 +0400
 * added File::Spec
 * has_schema now returns method name and also checks for
   version specific schemas if second argument is handle.
 * init_schema use has_schema to get method name


Modified: Jifty-DBI/trunk/t/utils.pl
==============================================================================
--- Jifty-DBI/trunk/t/utils.pl	(original)
+++ Jifty-DBI/trunk/t/utils.pl	Sun Sep 25 04:58:59 2005
@@ -1,6 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
+use File::Spec ();
 
 =head1 VARIABLES
 
@@ -123,7 +124,7 @@
 	);
 }
 
-=head2 should_test
+=head2 should_test $driver
 
 Checks environment for C<JDBI_TEST_*> variables.
 Returns true if specified DB back-end should be tested.
@@ -139,23 +140,46 @@
 	return $ENV{$env};
 }
 
-=head2 had_schema
+=head2 has_schema $class { $driver | $handle }
 
-Returns true if C<$class> has schema for C<$driver>.
+Returns method name if C<$class> has schema for C<$driver> or C<$handle>.
+If second argument is handle object then checks also for DB version
+specific schemas, for example for MySQL 4.1.23 this function will check
+next methods in the C<$class>: C<schema_mysql_4_1_23>, C<schema_mysql_4_1>,
+C<schema_mysql_4> and C<schema_mysql>, but if second argument is C<$driver>
+name then checks only for C<schema_mysql>.
+
+Returns empty value if couldn't find method.
 
 =cut
 
 sub has_schema
 {
 	my ($class, $driver) = @_;
-	my $method = 'schema_'. lc $driver;
-	return UNIVERSAL::can( $class, $method );
+	unless( UNIVERSAL::isa( $driver, 'Jifty::DBI::Handle' ) ) {
+		my $method = 'schema_'. lc $driver;
+		$method = '' unless UNIVERSAL::can( $class, $method );
+		return $method;
+	} else {
+		my $ver = $driver->database_version;
+		return has_schema( $class, handle_to_driver( $driver ) ) unless $ver;
+
+		my $method = 'schema_'. lc handle_to_driver( $driver );
+		$ver =~ s/-.*$//;
+		my @nums = grep $_, map { int($_) } split /\./, $ver;
+		while( @nums ) {
+			my $m = $method ."_". join '_', @nums;
+			return $m if( UNIVERSAL::can( $class, $m ) );
+			pop @nums;
+		}
+		return has_schema( $class, handle_to_driver( $driver ) );
+	}
 }
 
 =head2 init_schema
 
-Takes C<$class> and C<$handle> and inits schema by calling
-C<schema_$driver> method of the C<$class>.
+Takes C<$class> and C<$handle> or C<$driver> and inits schema
+by calling method C<has_schema> returns of the C<$class>.
 Returns last C<DBI::st> on success or last return value of the
 SimpleQuery method on error.
 
@@ -164,7 +188,8 @@
 sub init_schema
 {
 	my ($class, $handle) = @_;
-	my $call = "schema_". lc handle_to_driver( $handle );
+	my $call = has_schema( $class, $handle );
+	diag( "using '$class\:\:$call' schema for ". handle_to_driver( $handle ) ) if $ENV{TEST_VERBOSE};
 	my $schema = $class->$call();
 	$schema = ref( $schema )? $schema : [$schema];
 	my $ret;