[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/i586-linux-thread-multi/Win32/ -> DBIODBC.pm (source)

   1  package            # hide this package from CPAN indexer
   2      Win32::ODBC;
   3  
   4  #use strict;
   5  
   6  use DBI;
   7  
   8  # once we've been loaded we don't want perl to load the real Win32::ODBC
   9  $INC{'Win32/ODBC.pm'} = $INC{'Win32/DBIODBC.pm'} || 1;
  10  
  11  #my $db = new Win32::ODBC("DSN=$self->{'DSN'};UID=$self->{'UID'};PWD=$self->{'PWD'};");
  12  
  13  #EMU --- my $db = new Win32::ODBC("DSN=$DSN;UID=$login;PWD=$password;");
  14  sub new
  15  {
  16      shift;
  17      my $connect_line= shift;
  18  
  19  # [R] self-hack to allow empty UID and PWD
  20      my $temp_connect_line;
  21      $connect_line=~/DSN=\w+/;
  22      $temp_connect_line="$&;";
  23      if ($connect_line=~/UID=\w?/)
  24          {$temp_connect_line.="$&;";}
  25      else    {$temp_connect_line.="UID=;";};
  26      if ($connect_line=~/PWD=\w?/)
  27          {$temp_connect_line.="$&;";}
  28      else    {$temp_connect_line.="PWD=;";};
  29      $connect_line=$temp_connect_line;
  30  # -[R]-
  31      
  32      my $self= {};
  33          
  34      
  35      $_=$connect_line;
  36       /^(DSN=)(.*)(;UID=)(.*)(;PWD=)(.*)(;)$/;
  37  
  38       #---- DBI CONNECTION VARIABLES
  39  
  40       $self->{ODBC_DSN}=$2;
  41       $self->{ODBC_UID}=$4;
  42       $self->{ODBC_PWD}=$6;
  43      
  44      
  45      #---- DBI CONNECTION VARIABLES    
  46      $self->{DBI_DBNAME}=$self->{ODBC_DSN};
  47      $self->{DBI_USER}=$self->{ODBC_UID};
  48      $self->{DBI_PASSWORD}=$self->{ODBC_PWD};
  49      $self->{DBI_DBD}='ODBC';
  50              
  51      #---- DBI CONNECTION
  52      $self->{'DBI_DBH'}=DBI->connect($self->{'DBI_DBNAME'},
  53              $self->{'DBI_USER'},$self->{'DBI_PASSWORD'},$self->{'DBI_DBD'});
  54  
  55      warn "Error($DBI::err) : $DBI::errstr\n" if ! $self->{'DBI_DBH'}; 
  56  
  57          
  58      #---- RETURN 
  59      
  60      bless $self;
  61  }
  62  
  63  
  64  #EMU --- $db->Sql('SELECT * FROM DUAL');
  65  sub Sql
  66  {
  67       my $self= shift;
  68       my $SQL_statment=shift;
  69  
  70   #    print " SQL : $SQL_statment \n";
  71      
  72      $self->{'DBI_SQL_STATMENT'}=$SQL_statment;
  73      
  74      my $dbh=$self->{'DBI_DBH'};
  75  
  76   #    print " DBH : $dbh \n";
  77      
  78      my $sth=$dbh->prepare("$SQL_statment");
  79      
  80   #    print " STH : $sth \n";
  81      
  82      $self->{'DBI_STH'}=$sth;
  83      
  84      if ($sth)
  85      {
  86          $sth->execute();
  87      }
  88      
  89      #--- GET ERROR MESSAGES
  90      $self->{DBI_ERR}=$DBI::err;
  91      $self->{DBI_ERRSTR}=$DBI::errstr;
  92  
  93      if ($sth)
  94      {
  95          #--- GET COLUMNS NAMES
  96          $self->{'DBI_NAME'} = $sth->{NAME};
  97      }
  98  
  99  # [R] provide compatibility with Win32::ODBC's way of identifying erraneous SQL statements
 100       return ($self->{'DBI_ERR'})?1:undef;
 101  # -[R]-
 102  }
 103   
 104  
 105  #EMU --- $db->FetchRow())
 106  sub FetchRow
 107  { 
 108       my $self= shift;
 109       
 110       my $sth=$self->{'DBI_STH'};
 111       if ($sth)
 112      {
 113           my @row=$sth->fetchrow_array;
 114           $self->{'DBI_ROW'}=\@row;
 115  
 116           if (scalar(@row)>0)
 117           {
 118              #-- the row of result is not nul
 119              #-- return somthing nothing will be return else
 120              return 1;
 121           }     
 122      }
 123      return undef;
 124  } 
 125  
 126  # [R] provide compatibility with Win32::ODBC's Data() method.
 127  sub Data
 128  {
 129      my $self=shift;
 130      my @array=@{$self->{'DBI_ROW'}};
 131      foreach my $element (@array)
 132      {
 133          # remove padding of spaces by DBI
 134          $element=~s/(\s*$)//;
 135      };
 136      return (wantarray())?@array:join('', @array);
 137  };
 138  # -[R]-
 139   
 140  #EMU --- %record = $db->DataHash;
 141  sub DataHash
 142  { 
 143       my $self= shift;
 144            
 145       my $p_name=$self->{'DBI_NAME'};
 146       my $p_row=$self->{'DBI_ROW'};
 147  
 148       my @name=@$p_name;
 149       my @row=@$p_row;
 150  
 151       my %DataHash;
 152  #print @name; print "\n"; print @row;
 153  # [R] new code that seems to work consistent with Win32::ODBC
 154      while (@name)
 155      {
 156          my $name=shift(@name);
 157          my $value=shift(@row);
 158  
 159          # remove padding of spaces by DBI
 160          $name=~s/(\s*$)//;
 161          $value=~s/(\s*$)//;
 162  
 163          $DataHash{$name}=$value;
 164      };
 165  # -[R]-
 166  
 167  # [R] old code that didn't appear to work
 168  #    foreach my $name (@name)
 169  #    {
 170  #        $name=~s/(^\s*)|(\s*$)//;
 171  #        my @arr=@$name;
 172  #        foreach (@arr)
 173  #        {
 174  #            print "lot $name  name  col $_   or ROW= 0 $row[0]  1 $row[1] 2 $row[2] \n ";
 175  #            $DataHash{$name}=shift(@row);
 176  #        }
 177  #    }
 178  # -[R]-
 179  
 180       #--- Return Hash
 181       return %DataHash;     
 182  } 
 183  
 184  
 185  #EMU --- $db->Error()
 186  sub Error
 187  { 
 188       my $self= shift;
 189            
 190       if ($self->{'DBI_ERR'} ne '')
 191       {
 192          #--- Return error message
 193          $self->{'DBI_ERRSTR'};
 194       }
 195  
 196       #-- else good no error message     
 197       
 198  }
 199  
 200  # [R] provide compatibility with Win32::ODBC's Close() method.
 201  sub Close
 202  {
 203      my $self=shift;
 204  
 205      my $dbh=$self->{'DBI_DBH'};
 206      $dbh->disconnect;
 207  }
 208  # -[R]-
 209  
 210  1;
 211  
 212  __END__
 213  
 214  # [R] to -[R]- indicate sections edited by me, Roy Lee
 215  
 216  =head1 NAME
 217  
 218  Win32::DBIODBC - Win32::ODBC emulation layer for the DBI
 219  
 220  =head1 SYNOPSIS
 221  
 222    use Win32::DBIODBC;     # instead of use Win32::ODBC
 223  
 224  =head1 DESCRIPTION
 225  
 226  This is a I<very> basic I<very> alpha quality Win32::ODBC emulation
 227  for the DBI. To use it just replace
 228  
 229      use Win32::ODBC;
 230  
 231  in your scripts with
 232  
 233      use Win32::DBIODBC;
 234  
 235  or, while experimenting, you can pre-load this module without changing your
 236  scripts by doing
 237  
 238      perl -MWin32::DBIODBC your_script_name
 239  
 240  =head1 TO DO
 241  
 242  Error handling is virtually non-existant.
 243  
 244  =head1 AUTHOR
 245  
 246  Tom Horen <tho@melexis.com>
 247  
 248  =cut


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1