File Coverage

blib/lib/DBIx/Version.pm

Criterion	Covered	Total	%
statement	11	46	23.9
branch	1	18	5.5
condition			n/a
subroutine	4	4	100.0
pod	1	1	100.0
total	17	69	24.6

package DBIx::Version;

use strict;
use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use DBIx::Version ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our $VERSION = '0.01';

# Preloaded methods go here.

sub Version {
   my $dbh = shift;

   return (undef, undef, undef) if not defined $dbh;

   my $version;

   # look for MontySQL
   if (exists $dbh->{'mysql_serverinfo'}) {
      $version = $dbh->{'mysql_serverinfo'};
      if ($version =~ /^(\d{1,2}\.\d{1,2}\.\d{1,2}-)/) {
# 4.0.17-standard-log
         return ('mysql', $1, $version);
      }
      else {
         return (undef, undef, undef);
      }
   }

   # look for PostgreSQL
   eval {
      my $sql = q{select version()};

      my $sth = $dbh->prepare($sql);

      my $rv = $sth->execute();

      ($version) = $sth->fetchrow_array();
      $sth->finish();
   };
   if ($@) { # prolly not valid query for this database
   }
   else {
      if ($version =~ /^PostgreSQL (\d{1,2}\.\d{1,2}\.\d{1,2}) /) {
# PostgreSQL 7.4.1 on i686-pc-linux-gnu, compiled by GCC gcc (GCC) 3.3.2 20031107 (Red Hat Linux 3.3.2-2)
         return ('postgresql', $1, $version);
      }
      else {
         return (undef, undef, undef);
      }
   }

   # look for Oracle
   # alternately, $dbh->get_info(18); # SQL_DBMS_VER
   eval {
      my $sql = q{SELECT version FROM V$INSTANCE};

      my $sth = $dbh->prepare($sql);

      my $rv = $sth->execute();

      ($version) = $sth->fetchrow_array();
      $sth->finish();
   };
   if ($@) { # prolly not valid query for this database
   }
   else {
      return ('oracle', $version, $version);
   }

   # look for Microsoft SQL Server or Sybase
   eval {
      my $sql = q{SELECT @@version};

      my $sth = $dbh->prepare($sql);

      my $rv = $sth->execute();

      ($version) = $sth->fetchrow_array();
      $sth->finish();
   };
   if ($@) { # prolly not valid query for this database
   }
   else {
      if ($version =~ / - (\d{1,2}\.\d{1,2}\.\d{3}) /) {
         return ('sqlserver', $1, $version);
      }
      elsif ($version =~ m|/(\d{1,2}\.\d{1,2}\.\d{1,2}\.\d{1,2})/| ) {
# Adaptive Server Enterprise/12.5.0.1/SWR 9982
         return ('sqlserver', $1, $version);
      }
      else {
         return (undef, undef, undef);
      }
   }
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__