[ Index ] |
PHP Cross Reference of Unnamed Project |
[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;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |