1 files changed, 105 insertions, 0 deletions
diff --git a/lib/DBI/Const/GetInfoReturn.pm b/lib/DBI/Const/GetInfoReturn.pm
new file mode 100644
index 0000000..d07b7ac
--- /dev/null
+++ b/lib/DBI/Const/GetInfoReturn.pm
@@ -0,0 +1,105 @@
+# $Id: GetInfoReturn.pm 8696 2007-01-24 23:12:38Z timbo $
+#
+# Copyright (c) 2002  Tim Bunce  Ireland
+#
+# Constant data describing return values from the DBI getinfo function.
+#
+# You may distribute under the terms of either the GNU General Public
+# License or the Artistic License, as specified in the Perl README file.
+
+package DBI::Const::GetInfoReturn;
+
+use strict;
+
+use Exporter ();
+
+use vars qw(@ISA @EXPORT @EXPORT_OK %GetInfoReturnTypes %GetInfoReturnValues);
+
+@ISA = qw(Exporter);
+@EXPORT = qw(%GetInfoReturnTypes %GetInfoReturnValues);
+
+my
+$VERSION = sprintf("2.%06d", q$Revision: 8696 $ =~ /(\d+)/o);
+
+
+=head1 NAME
+
+DBI::Const::GetInfoReturn - Data and functions for describing GetInfo results
+
+=head1 SYNOPSIS
+
+The interface to this module is undocumented and liable to change.
+
+=head1 DESCRIPTION
+
+Data and functions for describing GetInfo results
+
+=cut
+
+use DBI::Const::GetInfoType;
+
+use DBI::Const::GetInfo::ANSI ();
+use DBI::Const::GetInfo::ODBC ();
+
+%GetInfoReturnTypes =
+(
+  %DBI::Const::GetInfo::ANSI::ReturnTypes
+, %DBI::Const::GetInfo::ODBC::ReturnTypes
+);
+
+%GetInfoReturnValues = ();
+{
+  my $A = \%DBI::Const::GetInfo::ANSI::ReturnValues;
+  my $O = \%DBI::Const::GetInfo::ODBC::ReturnValues;
+  while ( my ($k, $v) = each %$A ) {
+    my %h = ( exists $O->{$k} ) ? ( %$v, %{$O->{$k}} ) : %$v;
+    $GetInfoReturnValues{$k} = \%h;
+  }
+  while ( my ($k, $v) = each %$O ) {
+    next if exists $A->{$k};
+    my %h = %$v;
+    $GetInfoReturnValues{$k} = \%h;
+  }
+}
+
+# -----------------------------------------------------------------------------
+
+sub Format {
+  my $InfoType = shift;
+  my $Value    = shift;
+
+  return '' unless defined $Value;
+
+  my $ReturnType = $GetInfoReturnTypes{$InfoType};
+
+  return sprintf '0x%08X', $Value if $ReturnType eq 'SQLUINTEGER bitmask';
+  return sprintf '0x%08X', $Value if $ReturnType eq 'SQLINTEGER bitmask';
+# return '"' . $Value . '"'       if $ReturnType eq 'SQLCHAR';
+  return $Value;
+}
+
+
+sub Explain {
+  my $InfoType = shift;
+  my $Value    = shift;
+
+  return '' unless defined $Value;
+  return '' unless exists $GetInfoReturnValues{$InfoType};
+
+  $Value = int $Value;
+  my $ReturnType = $GetInfoReturnTypes{$InfoType};
+  my %h = reverse %{$GetInfoReturnValues{$InfoType}};
+
+  if ( $ReturnType eq 'SQLUINTEGER bitmask'|| $ReturnType eq 'SQLINTEGER bitmask') {
+    my @a = ();
+    for my $k ( sort { $a <=> $b } keys %h ) {
+      push @a, $h{$k} if $Value & $k;
+    }
+    return wantarray ? @a : join(' ', @a );
+  }
+  else {
+    return $h{$Value} ||'?';
+  }
+}
+
+1;