File Coverage

blib/lib/DBIx/Compat.pm

Criterion	Covered	Total	%
statement	6	80	7.5
branch	1	28	3.5
condition	0	11	0.0
subroutine	2	18	11.1
pod	2	17	11.7
total	11	154	7.1

###################################################################################
#
#   DBIx::Compat - Copyright (c) 1997-1998 Gerald Richter / ECOS
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#   For use with Apache httpd and mod_perl, see also Apache copyright.
#
#   THIS IS BETA SOFTWARE!
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#   $Id: Compat.pm,v 1.27 2001/07/10 05:06:51 richter Exp $
#
###################################################################################

package DBIx::Compat ;

use DBI ;

sub SelectFields

    {
    my $hdl   = shift ;
    my $table = shift ;

    my $sth = $hdl -> prepare ("select * from $table where 1=0") ;
    if (!$sth -> execute ())
        {
        warn "select * from $table where 1=0  failed $DBI::errstr" ;
        return undef ;
        }

    return $sth ;
    }

sub SelectFieldsQuoted

    {
    my $hdl   = shift ;
    my $table = shift ;

    my $sth = $hdl -> prepare ("select * from \"$table\" where 1=0") ;
    if (!$sth -> execute ())
        {
        warn "select * from \"$table\" where 1=0  failed $DBI::errstr" ;
        return undef ;
        }

    return $sth ;
    }

sub SelectAllFields

    {
    my $hdl   = shift ;
    my $table = shift ;

    my $sth = $hdl -> prepare ("select * from $table") ;
    if (!$sth -> execute ())
        {
        warn "select * from $table  failed $DBI::errstr" ;
        return undef ;
        }

    return $sth ;
    }



sub ListFields

    {
    my $hdl   = shift ;
    my $table = shift ;

    my $sth = $hdl -> prepare ("LISTFIELDS $table") ;
    $sth -> execute () or return undef ;

    # Meaning of TYPE has changed from 1.19_18 -> 1.19_19
    $Compat{mSQL}{QuoteTypes} = {   1=>1,   12=>1,   -1=>1 } if (exists ($sth -> {msql_type})) ;

    return $sth ;
    }

sub ListFieldsFunc

    {
    my $hdl   = shift ;
    my $table = shift ;

    my $sth = $hdl -> func($table, 'listfields' )  or return undef ;

    return $sth ;
    }


sub ListTables

    {
    my $hdl   = shift ;

    return $hdl -> tables ;
    }

sub ListTablesODBC

    {
    my $hdl   = shift ;

    return grep (!/^MSys/, $hdl -> tables)  ;
    }

sub ListTablesFunc

    {
    my $hdl   = shift ;

    my @tabs ;

    eval { @tabs = $hdl -> tables } ;

    # try the _ListTables function for DBD::mysql before 1.21..
    @tabs = $hdl -> func('_ListTables' ) if ($#tabs < 0 || $@) ;

    return @tabs ;
    }

sub ListTablesPg

    {
    my $hdl   = shift ;
    my @tabs ;
    my $st = $hdl -> tables ;

    while ($dat = $st -> fetch)
        {
        push @tabs, $dat -> [0] ;
        }

    return @tabs ;
    }


sub ListTablesIfmx

    {
    my $hdl   = shift ;

    my @tabs = $hdl -> func('_tables' );

    return @tabs ;
    }


sub LimitOffsetStrPg

    {
    my ($start,$max) = @_;

    return ($max > 0?"LIMIT $max":'') . ($start > 0?" OFFSET $start":'') ;
    }


sub LimitOffsetStrMySQL

    {
    my ($start,$max) = @_;

    $start ||= 0 ;

    return ($max > 0)?"LIMIT $start,$max":''  ;
    }

sub MysqlGetSerial

    {
    my ($dbh, $table) = @_ ;

    return $dbh -> {'mysql_insertid'} ;
    }

sub SeqGetSerial

    {
    my ($dbh, $table, $seq) = @_ ;

    $seq  ||= ($table . '_seq') ;
    my $sth = $dbh -> prepare ("select $seq.nextval from dual") ;
    $sth -> execute () or die "Cannot get serial from $seq ($DBI::errstr)" ;
    my $row = $sth -> fetchrow_arrayref ;

    return $row->[0] ;
    }

sub PgGetSerial

    {
    my ($dbh, $table, $seq) = @_ ;

    $seq  ||= ($table . '_seq') ;
    my $sth = $dbh -> prepare ("select nextval ('$seq')") ;
    $sth -> execute () or die "Cannot get serial from $seq ($DBI::errstr)" ;
    my $row = $sth -> fetchrow_arrayref ;

    return $row->[0] ;
    }


sub InformixGetSerial

    {
    my ($dbh, $table) = @_ ;

    my $sth = $dbh -> prepare ("select distinct dbinfo('sqlca.sqlerrd1') from $table") ;
    $sth -> execute () or die "Cannot get serial from $seq ($DBI::errstr)" ;
    my $row = $sth -> fetchrow_arrayref ;

    return $row->[0] ;
    }


####################################################################################


%Compat =
    (
    '*'  =>
            {
            'Placeholders'   => 10,              # Default: Placeholder are supported
            'ListFields'     => \&SelectFields,  # Default: Use Select to get field names
            'ListTables'     => \&ListTables,    # Default: Use DBI $dbh -> tables
            # QuoteTypes isn't used anymore !!
            'QuoteTypes'   => {   1=>1,   12=>1,  -1=>1, 9 => 1, 10 => 1, 11 => 1}, # Default: ODBC Types, quote char, varchar and longvarchar
            'NumericTypes'   => { 2 => 1, 3 => 1, 4 => 1, 5 => 1, 6 => 1, 7 => 1, 8 => 1, -5 => 1, -6 => 1}, # Default numeric ODBC Types
            'SupportJoin'    => 1,               # Default: Driver supports joins (select with multiple tables)
            'SupportSQLJoin' => 1,               # Default: Driver supports INNER/LEFT/RIGHT JOIN Syntax in SQL select
            'SQLJoinOnly2Tabs' => 0,             # Default: Driver supports LEFT/RIGHT JOIN with more then two tables
            'HaveTypes'      => 1,               # Default: Driver supports $sth -> {TYPE}
            'NullOperator'   => 'IS',            # Default: Operator to compare with NULL is IS
            'HasInOperator'  => 1,               # Default: DBMS support x IN (y)
	    'NeedNullInCreate' => '',            # Default: NULL allowed without explicit declare in CREATE
	    'EmptyIsNull'    => 0,		 # Default: Empty strings ('') and NULL are different
	    'LimitOffset'    => undef,		 # Default: Don't use LIMIT/OFFSET in SELECTs
            'GetSerialPreInsert' => undef,       # Default: Driver does not support serials
            'GetSerialPostInsert' => undef,      # Default: Driver does not support serials
            'CreateTypes' => {},                 # conversion for CreateTables
            'CreateSeq'    => 0,                 # Create sequence for counter
            'CreatePublic' => 0,                 # Create public synonym for table
            'CanDropColumn' => 1,                # DBMS can drop a column
            'QuoteIdentifier' => undef,          # DBMS can handle idntifiers with spaces by quoteing them. Default: no
             },
    'SQLite'  =>
            {
            'Placeholders'   => 10,              # Default: Placeholder are supported
            'ListFields'     => \&SelectFields,  # Default: Use Select to get field names
            'ListTables'     => \&ListTables,    # Default: Use DBI $dbh -> tables
            # QuoteTypes isn't used anymore !!
            'QuoteTypes'   => {   1=>1,   12=>1,  -1=>1, 9 => 1, 10 => 1, 11 => 1}, # Default: ODBC Types, quote char, varchar and longvarchar
            'NumericTypes'   => { 2 => 1, 3 => 1, 4 => 1, 5 => 1, 6 => 1, 7 => 1, 8 => 1, -5 => 1, -6 => 1}, # Default numeric ODBC Types
            'SupportJoin'    => 1,               # Default: Driver supports joins (select with multiple tables)
            'SupportSQLJoin' => 4,               # Default: Driver supports INNER/LEFT/RIGHT JOIN Syntax in SQL select
            'SQLJoinOnly2Tabs' => 0,             # Default: Driver supports LEFT/RIGHT JOIN with more then two tables
            'HaveTypes'      => 0,               # Default: Driver supports $sth -> {TYPE}
            'NullOperator'   => 'IS',            # Default: Operator to compare with NULL is IS
            'HasInOperator'  => 1,               # Default: DBMS support x IN (y)
	    'NeedNullInCreate' => '',            # Default: NULL allowed without explicit declare in CREATE
	    'EmptyIsNull'    => 0,		 # Default: Empty strings ('') and NULL are different
	    'LimitOffset'    => \&LimitOffsetStrPg,		 # Default: Don't use LIMIT/OFFSET in SELECTs
            'GetSerialPreInsert' => undef,       # Default: Driver does not support serials
            'GetSerialPostInsert' => undef,      # Default: Driver does not support serials
            'CreateTypes' =>                        # conversion for CreateTables
                    {
                    'counter'  => 'INTEGER PRIMARY KEY',
                    },
            'CreateSeq'    => 0,                 # Create sequence for counter
            'CreatePublic' => 0,                 # Create public synonym for table
            'CanDropColumn' => 0,                # DBMS can drop a column
            'QuoteIdentifier' => undef,          # DBMS can handle idntifiers with spaces by quoteing them. Default: no
             },

    'ConfFile' =>
	{
            'Placeholders' => 2,		# Placeholders supported, but the perl
						#   type must be the same as the db type
            'ListFields'     => \&SelectFields,
            'SupportJoin'    => 0,
            'HaveTypes'      => 0		# Driver does not support $sth -> {TYPE}
	},

    'CSV' =>
	{
            'Placeholders' => 2,                # Placeholders supported, but the perl
						#   type must be the same as the db type
            'ListFields'     => \&SelectFields,
            'SupportJoin'    => 0,
            'SupportSQLJoin'	=> 0,		    # Driver does not supports INNER/LEFT/RIGHt JOIN Syntax in SQL select
            'HaveTypes'      => 0,              # Driver does not support $sth -> {TYPE}
            'ListTables'     => undef,		# no tables
	    'EmptyIsNull'    => 1,		# DBD::CSV does not really knows about NULL
            'HasInOperator'  => 0,              # DBD::CSV does not support x IN (y)
	},

    'XBase' =>
	{
          #  'Placeholders' => 2,               # Placeholders supported, but the perl
						#   type must be the same as the db type
            'ListFields'     => \&SelectAllFields,
            'SupportJoin'    => 0,
            'HaveTypes'      => 0               # Driver does not support $sth -> {TYPE}
	},

     'Pg' =>
     {
      'Placeholders' => 2,                # Placeholders supported, but the perl
						#   type must be the same as the db type

      'SupportSQLJoin' => 1,              # Driver does not supports INNER/LEFT/RIGHt JOIN Syntax in SQL select
      'NumericTypes'   => {
                                20 => 1,
                                21 => 1,
                                22 => 1,
                                23 => 1,
                                700 => 1,
                                701 => 1,
                                1005 => 0,
                                1006 => 1,
                                1007 => 1,
                                },


      'QuoteTypes' =>
                {   16 => 1, 17=>1,   18=>1,   19=>1,   20=>1,   25=>1,  409=>1,  410=>1,
                    411=>1,  605=>1,
                    702  =>1,   # abstime
                    703  =>1,   # reltime
                    1002=>1, 1003=>1, 1004=>1, 1009=>1, 1026=>1,
                    1039=>1, 1040=>1, 1041=>1, 1042=>1, 1043=>1,
                    1082 =>1,   # date
                    1083 =>1,   # time
                    1184 =>1,   # datetime
                    1186 =>1,   # interval
                    1296 =>1
                 },
      'LimitOffset'    => \&LimitOffsetStrPg, # Only PostgreSQL 6.5+

#### Use the following line for older DBD::Pg versions (< 0.89) which does
#    not support the table_info function
      #            'ListTables'     => \&ListTablesPg,    # DBD::Pg
      'GetSerialPreInsert' => \&PgGetSerial,
      'CreateTypes' =>                 # conversion for CreateTables
      {
       'counter'  => 'serial',
      }
     },



  'mSQL' => {
            'Placeholders'	=> 2,		    # Placeholders supported, but the perl
						    #   type must be the same as the db type
            'SupportSQLJoin'	=> 0,		    # Driver does not supports INNER/LEFT/RIGHt JOIN Syntax in SQL select
            'ListFields'	=> \&ListFields,    # mSQL has it own ListFields function
            'ListTables'	=> \&ListTablesFunc,# DBD::mysql $dbh -> func
            'NullOperator'	=> '=',		    # Operator to compare with NULL is =
            'QuoteTypes'	=> {   1=>1,   12=>1,   -1=>1 }
# ### use the following line for older mSQL drivers
#            'QuoteTypes'	=> {   2=>1,   6=>1 }
            },

    'mysql' => {
            'ListFields'   => \&ListFields,	    # mysql has it own ListFields function
            'QuoteTypes'   => {   1=>1,   12=>1,   -1=>1 , 9=>1},
            'Placeholders' => 10,		    # Placeholders supported, but the perl
						    #   type must be the same as the db type
            'SQLJoinOnly2Tabs' => 0,		    # mysql supports LEFT/RIGHT JOIN with more than two tables
            'ListTables'     => \&ListTablesFunc,   # DBD::mysql $dbh -> func
	    'LimitOffset'    => \&LimitOffsetStrMySQL,
            'GetSerialPostInsert' => \&MysqlGetSerial,
            'CreateTypes' =>                        # conversion for CreateTables
                    {
                    'counter'  => 'integer not null auto_increment',
                    }
            },

    'Solid' => {
            'Placeholders' => 3,		    # Placeholders supported, but cannot use a
						    #   string where a number expected
            'QuoteTypes'   => {   1=>1,   12=>1,   -1=>1, 9=> 1 }
            },

    'ODBC' => {
            'Placeholders' => 10,		    # Placeholders supported, but seems not
						    #   to works all the time ?
            'QuoteTypes'   => {   1=>1,   12=>1,   -1=>1},
 	    'NeedNullInCreate' => 'NULL',
            'ListTables'     => \&ListTablesODBC,    # Use DBI $dbh -> tables, exclude /^MSys/
            'SQLJoinOnly2Tabs' => 0,             # Driver supports LEFT/RIGHT JOIN only with two tables
            'CreateTypes' =>                        # conversion for CreateTables
                        {
                        'tinytext' => 'text',
                        'text'     => 'longtext',
                        },
           },
    'Oracle' => {
            'Placeholders' => 3,		    # Placeholders supported, but cannot use a
						    #   string where a number expected
            'QuoteTypes'   => {
                            -4=>1,
                            -3=>1,
                            -1=>1,
                            1=>1, 9=>1,  11=>1,   12=>1, },
            'SupportSQLJoin' => 3,		    # Oracle need  a = b (+) instead of  INNER/LEFT/RIGHt JOIN Syntax in SQL select
	    'EmptyIsNull'    => 1,		    # Oracle converts empty strings ('') to NULL
# older DBD::Orcales only need the following one entry, but some test may fail
#		'HaveTypes'      => 0		    #  Driver does not supports $sth -> {TYPE}
            'GetSerialPreInsert' => \&SeqGetSerial,
            'CreateTypes' =>                        # conversion for CreateTables
                        {
                        'counter'  => 'integer',
                        'tinytext' => 'varchar2(256)',
                        'text'     => 'varchar2(2000)',
                        'datetime' => 'date',
                        'bool'     => 'number(1)',
                        'bit'      => 'number(1)',
                        },
            'CreateSeq'    => 1,                      # Create sequence for counter
            'CreatePublic' => 1,                      # Create public synonym for table
            'CanDropColumn' => 0,                     # DBMS can drop a column
            'QuoteIdentifier' => '""',                # DBMS can handle idntifiers with spaces by quoteing them.
##            'ListFields'     => \&SelectFieldsQuoted, # Use Select to get field names
            },

    'Sybase'  =>
            {
            'Placeholders'   => 10,
            'ListFields'     => \&SelectFields,
            'QuoteTypes'     => {
                -6=>0, -4=>0, -2=>0, -1=>1, 1=>1, 2=>0, 3=>1,
                4=>0, 6=>0, 7=>0, 9=>0

				},
            'SupportSQLJoin' => 2,               # Driver need *= instead of  INNER/LEFT/RIGHt JOIN Syntax in SQL select
            'HaveTypes'      => 1,
            'NullOperator'   => 'IS',
	    'NeedNullInCreate' => 'NULL'
	    },

    'Informix' => {
            'Placeholders' => 2,
            'SupportSQLJoin' => 4,
            'SQLJoinOnly2Tabs' => 0,
            'ListTables'     => \&ListTablesIfmx,
            'GetSerialPostInsert' => \&InformixGetSerial,
            'QuoteIdentifier' => $ENV{DELIMIDENT}?'""':undef,        # DBMS can handle idntifiers with spaces by quoteing them.
            },


    'Sprite' => {
            'Placeholders' => 2,            # Placeholders supported, but perl type must be the same as type in db
                            #   string where a number expected
            'QuoteTypes'   => {
                            -4=>1,
                            -3=>1,
                            -1=>1,
                            1=>1, 9=>1,  11=>1,   12=>1, },
            'SupportJoin' => 0,         # NO JOINS (YET) IN SPRITE!
            'SupportSQLJoin' => 0,          # Oracle need  a = b (+) instead of  INNER/LEFT/RIGHt JOIN Syntax in SQL select
            'EmptyIsNull'    => 1,          # Sprite converts empty strings ('') to NULL
            'HaveTypes'      => 1,      #  Driver does supports $sth -> {TYPE}
            'GetSerialPreInsert' => \&SeqGetSerial,
            'HasInOperator'  => 0,               # DBMS not support x IN (y)
            },



    ) ;


###########################################################################################################

sub GetItem

    {
    my ($driver, $name) = @_ ;

    return $Compat{$driver}{$name}  if (exists ($Compat{$driver}{$name})) ;
    return $Compat{'*'}{$name} ;
    }

1 ;


=head1 NAME

DBIx::Compat - Perl extension for Compatibility Infos about DBD Drivers

=head1 SYNOPSIS

  use DBIx::Compat;

  my $HaveTypes  = DBIx::Compat::GetItem ($drv, 'HaveTypes') ;

=head1 DESCRIPTION

DBIx::Compat contains a hash which gives information about DBD drivers, to allow
to write driver independent programs.

Currently there are the following attributes defined:


=head2 B

A function which will return information about all fields of an table.
Needs an database handle and a tablename as argument.
Must at least return the fieldnames and the fieldtypes.

 Example:

  $ListFields = $DBIx::Compat::Compat{$Driver}{ListFields} ;
  $sth = &{$ListFields}($DBHandle, $Table) or die "Cannot list fields" ;

  @{ $sth -> {NAME} } ; # array of fieldnames
  @{ $sth -> {TYPE} } ; # array of filedtypes

  $sth -> finish ;



=head2 B

A function which will return an array of all tables of the datasource. Defaults to
C<$dbh> -> C.

=head2 B

Hash which contains one entry for all datatypes that are numeric.

=head2 B

Set to true if the DBMS supports joins (select with multiple tables)

=head2 B

Set to 1 if the DBMS supports INNER/LEFT/RIGHT JOIN Syntax in SQL select.
Set to 2 if DBMS needs a *= b syntax for inner join (MS-SQL, Sybase).
Set to 3 if DBMS needs a = b (+) syntax for inner join (Oracle syntax).


=head2 B

Set to true if DBMS can only support two tables in inner joins.

=head2 B

Set to true if DBMS supports datatypes (most DBMS will do)

=head2 B

Set to C<'NULL'> if DBMS requires the NULL keyword when creating tables
where fields should contains nulls.

=head2 B

Set to true if an empty string ('') and NULL is the same for the DBMS.

=head2 B

An function which will be used to create a SQL text for limiting the
number of fetched rows and selecting the starting row in selects.


=head1 B


=head2 B

Gives information if and how placeholders are supported:

=over 4

=item B<0> = Not supported

=item B<1> = Supported, but not fully, unknown how much

=item B<2> = Supported, but perl type must be the same as type in db

=item B<3> = Supported, but can not give a string when a numeric type is in the db

=item B<10> = Supported under all circumstances

=back


=head2 B

Gives information which datatypes must be quoted when passed literal
(not via a placeholder). Contains a hash with all type number which
need to be quoted.

  $DBIx::Compat::Compat{$Driver}{QuoteTypes}{$Type}

will be true when the type in $Type for the driver $Driver must be
quoted.


=head1 Supported Drivers

Currently there are entry for

=item B

=item B

=item B

=item B

=item B

=item B

=item B

=item B

=item B

if you detect an error in the definition or add an definition for a new
DBD driver, please mail it to the author.


=head1 AUTHOR

G.Richter

=head1 SEE ALSO

perl(1), DBI(3), DBIx::Recordset(3)

=cut