[Summary view] [Print] [Text view]

   1  # $Id: GetInfoReturn.pm 8696 2007-01-24 23:12:38Z timbo $
   2  #
   3  # Copyright (c) 2002  Tim Bunce  Ireland
   4  #
   5  # Constant data describing return values from the DBI getinfo function.
   6  #
   7  # You may distribute under the terms of either the GNU General Public
   8  # License or the Artistic License, as specified in the Perl README file.
   9  
  10  package DBI::Const::GetInfoReturn;
  11  
  12  use strict;
  13  
  14  use Exporter ();
  15  
  16  use vars qw(@ISA @EXPORT @EXPORT_OK %GetInfoReturnTypes %GetInfoReturnValues);
  17  
  18  @ISA = qw(Exporter);
  19  @EXPORT = qw(%GetInfoReturnTypes %GetInfoReturnValues);
  20  
  21  my
  22  $VERSION = sprintf("2.%06d", q$Revision: 8696 $ =~ /(\d+)/o);
  23  
  24  
  25  =head1 NAME
  26  
  27  DBI::Const::GetInfoReturn - Data and functions for describing GetInfo results
  28  
  29  =head1 SYNOPSIS
  30  
  31  The interface to this module is undocumented and liable to change.
  32  
  33  =head1 DESCRIPTION
  34  
  35  Data and functions for describing GetInfo results
  36  
  37  =cut
  38  
  39  use DBI::Const::GetInfoType;
  40  
  41  use DBI::Const::GetInfo::ANSI ();
  42  use DBI::Const::GetInfo::ODBC ();
  43  
  44  %GetInfoReturnTypes =
  45  (
  46    %DBI::Const::GetInfo::ANSI::ReturnTypes
  47  , %DBI::Const::GetInfo::ODBC::ReturnTypes
  48  );
  49  
  50  %GetInfoReturnValues = ();
  51  {
  52    my $A = \%DBI::Const::GetInfo::ANSI::ReturnValues;
  53    my $O = \%DBI::Const::GetInfo::ODBC::ReturnValues;
  54    while ( my ($k, $v) = each %$A ) {
  55      my %h = ( exists $O->{$k} ) ? ( %$v, %{$O->{$k}} ) : %$v;
  56      $GetInfoReturnValues{$k} = \%h;
  57    }
  58    while ( my ($k, $v) = each %$O ) {
  59      next if exists $A->{$k};
  60      my %h = %$v;
  61      $GetInfoReturnValues{$k} = \%h;
  62    }
  63  }
  64  
  65  # -----------------------------------------------------------------------------
  66  
  67  sub Format {
  68    my $InfoType = shift;
  69    my $Value    = shift;
  70  
  71    return '' unless defined $Value;
  72  
  73    my $ReturnType = $GetInfoReturnTypes{$InfoType};
  74  
  75    return sprintf '0x%08X', $Value if $ReturnType eq 'SQLUINTEGER bitmask';
  76    return sprintf '0x%08X', $Value if $ReturnType eq 'SQLINTEGER bitmask';
  77  # return '"' . $Value . '"'       if $ReturnType eq 'SQLCHAR';
  78    return $Value;
  79  }
  80  
  81  
  82  sub Explain {
  83    my $InfoType = shift;
  84    my $Value    = shift;
  85  
  86    return '' unless defined $Value;
  87    return '' unless exists $GetInfoReturnValues{$InfoType};
  88  
  89    $Value = int $Value;
  90    my $ReturnType = $GetInfoReturnTypes{$InfoType};
  91    my %h = reverse %{$GetInfoReturnValues{$InfoType}};
  92  
  93    if ( $ReturnType eq 'SQLUINTEGER bitmask'|| $ReturnType eq 'SQLINTEGER bitmask') {
  94      my @a = ();
  95      for my $k ( sort { $a <=> $b } keys %h ) {
  96        push @a, $h{$k} if $Value & $k;
  97      }
  98      return wantarray ? @a : join(' ', @a );
  99    }
 100    else {
 101      return $h{$Value} ||'?';
 102    }
 103  }
 104  
 105  1;