WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/LIB/DBI.pm



#! perl
########################################################################
# Copyright ( C ) 2006 ERG Limited, All rights reserved
#
# Module name   : jats.sh
# Module type   : Makefile system
# Compiler(s)   : n/a
# Environment(s): jats
#
# Description   : This package has been created to simplify the migration

#                 to Release Manager, to a JDBC interface.
#
#                 The package provides suffient methods to trick the existing
#                 code into working. No More. No less.
#
# Usage:
#
# Version   Who      Date        Description
#
#......................................................................#
 
require 5.006_001;
use strict;
use warnings;

 
#
#   The following hash simplifies existing code
#   in that it will convert known DBI:ODBC called to a more raw form
#
my %url_convert = ( 'dbi:ODBC:RM3' => '$GBE_RM_LOCATION' );
 
 
#-------------------------------------------------------------------------------
# Function        : connect
#

    #
    if ( $url_convert{$self->{DB}} )
    {
        my $var = $url_convert{$self->{DB}};
        my $value = $ENV{$var};
        Error ("Cannot convert old DB value to new form",
               "User requested: " . $self->{DB},
               "Need Environment Variable: $var" ) unless ($value);
 
        print "[DBI] Converting DB to URL: " . $self->{DB} ." to $value\n"
            if $verbose > 1;
        $self->{DB} = $value;

sub execute
{
    my $self = shift;
    my @args = @_;
    my @rows;
    my @colNames;
 
    my $statement = $self->{STATEMENT};
 
 
    #

    $self->{ERROR} = 1;
    my $fhr = $self->{CONNECTION}{FH_READ};
    while ( <$fhr> )
    {
        chomp;
 
        if ( m/Data:(.*)/ )
        {
            push @rows, $1;
            print "[DBI] Execute: $_\n" if $verbose > 2;
        }
        else
        {
            print "[DBI] Execute: $_\n" if $verbose;
        }
        
        if (m~^Info:ColumnName:(\d+):(.*)~) {
            push @colNames, $2;
        }
 
        if ( m/^DataStart:/ )
        {
            $self->{ERROR} = 0;
        }

        }
 
    }
 
    $self->{ROWS} = \@rows;
    $self->{COLNAMES} = \@colNames;
 
    return ! $self->{ERROR};
}
 
#-------------------------------------------------------------------------------

    $self->{ROWS_READ}++;
    return @row;
}
 
#-------------------------------------------------------------------------------
# Function        : fetch_colNames 
#
# Description     : NonStandard function
#                   Fetch array of colum names
#
# Inputs          : None 
#
# Returns         : An array of column names
#
sub fetch_colNames
{
    my $self = shift;
    return $self->{COLNAMES};
}
 
#-------------------------------------------------------------------------------
# Function        : finish
#
# Description     : Finish the 'execute'
#
# Inputs          : None

Rev 6887	Rev 6910
Line -...	Line 1...
-		1	`#! perl`
1	`########################################################################`	2	`########################################################################`
2	`# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.`	3	`# Copyright ( C ) 2006 ERG Limited, All rights reserved`
3	`#`	4	`#`
4	`# Module name : DBI.pm`	5	`# Module name : jats.sh`
5	`# Module type : Makefile system`	6	`# Module type : Makefile system`
6	`# Compiler(s) : n/a`	7	`# Compiler(s) : n/a`
7	`# Environment(s): jats`	8	`# Environment(s): jats`
8	`#`	9	`#`
9	`# Description : This package has been created to simplify the migration`	10	`# Description : This package has been created to simplify the migration`
Line 11...	Line 12...
11	`# to Release Manager, to a JDBC interface.`	12	`# to Release Manager, to a JDBC interface.`
12	`#`	13	`#`
13	`# The package provides suffient methods to trick the existing`	14	`# The package provides suffient methods to trick the existing`
14	`# code into working. No More. No less.`	15	`# code into working. No More. No less.`
15	`#`	16	`#`
-		17	`# Usage:`
-		18	`#`
-		19	`# Version Who Date Description`
-		20	`#`
16	`#......................................................................#`	21	`#......................................................................#`
17		22
18	`require 5.006_001;`	23	`require 5.006_001;`
19	`use strict;`	24	`use strict;`
20	`use warnings;`	25	`use warnings;`
Line 37...	Line 42...
37		42
38	`#`	43	`#`
39	`# The following hash simplifies existing code`	44	`# The following hash simplifies existing code`
40	`# in that it will convert known DBI:ODBC called to a more raw form`	45	`# in that it will convert known DBI:ODBC called to a more raw form`
41	`#`	46	`#`
42	`my %url_convert = ( 'dbi:ODBC:RM3' => 'GBE_RM_LOCATION' );`	47	`my %url_convert = ( 'dbi:ODBC:RM3' => '$GBE_RM_LOCATION' );`
43		48
44		49
45	`#-------------------------------------------------------------------------------`	50	`#-------------------------------------------------------------------------------`
46	`# Function : connect`	51	`# Function : connect`
47	`#`	52	`#`
Line 82...	Line 87...
82	`#`	87	`#`
83	`if ( $url_convert{$self->{DB}} )`	88	`if ( $url_convert{$self->{DB}} )`
84	`{`	89	`{`
85	`my $var = $url_convert{$self->{DB}};`	90	`my $var = $url_convert{$self->{DB}};`
86	`my $value = $ENV{$var};`	91	`my $value = $ENV{$var};`
87	`die ("Cannot convert old DB value to new form\n",`	92	`Error ("Cannot convert old DB value to new form",`
88	`"User requested: " . $self->{DB} . "\n",`	93	`"User requested: " . $self->{DB},`
89	`"Need Environment Variable: $var" ) unless ($value);`	94	`"Need Environment Variable: $var" ) unless ($value);`
90		95
91	`print "[DBI] Converting DB to URL: " . $self->{DB} ." to $value\n"`	96	`print "[DBI] Converting DB to URL: " . $self->{DB} ." to $value\n"`
92	`if $verbose > 1;`	97	`if $verbose > 1;`
93	`$self->{DB} = $value;`	98	`$self->{DB} = $value;`
Line 345...	Line 350...
345	`sub execute`	350	`sub execute`
346	`{`	351	`{`
347	`my $self = shift;`	352	`my $self = shift;`
348	`my @args = @_;`	353	`my @args = @_;`
349	`my @rows;`	354	`my @rows;`
-		355	`my @colNames;`
350		356
351	`my $statement = $self->{STATEMENT};`	357	`my $statement = $self->{STATEMENT};`
352		358
353		359
354	`#`	360	`#`
Line 381...	Line 387...
381	`$self->{ERROR} = 1;`	387	`$self->{ERROR} = 1;`
382	`my $fhr = $self->{CONNECTION}{FH_READ};`	388	`my $fhr = $self->{CONNECTION}{FH_READ};`
383	`while ( <$fhr> )`	389	`while ( <$fhr> )`
384	`{`	390	`{`
385	`chomp;`	391	`chomp;`
386		-
387	`if ( m/Data:(.*)/ )`	392	`if ( m/Data:(.*)/ )`
388	`{`	393	`{`
389	`push @rows, $1;`	394	`push @rows, $1;`
390	`print "[DBI] Execute: $_\n" if $verbose > 2;`	395	`print "[DBI] Execute: $_\n" if $verbose > 2;`
391	`}`	396	`}`
392	`else`	397	`else`
393	`{`	398	`{`
394	`print "[DBI] Execute: $_\n" if $verbose;`	399	`print "[DBI] Execute: $_\n" if $verbose;`
395	`}`	400	`}`
396		401
-		402	`if (m~^Info:ColumnName:(\d+):(.*)~) {`
-		403	`push @colNames, $2;`
-		404	`}`
397		405
398	`if ( m/^DataStart:/ )`	406	`if ( m/^DataStart:/ )`
399	`{`	407	`{`
400	`$self->{ERROR} = 0;`	408	`$self->{ERROR} = 0;`
401	`}`	409	`}`
Line 412...	Line 420...
412	`}`	420	`}`
413		421
414	`}`	422	`}`
415		423
416	`$self->{ROWS} = \@rows;`	424	`$self->{ROWS} = \@rows;`
-		425	`$self->{COLNAMES} = \@colNames;`
417		426
418	`return ! $self->{ERROR};`	427	`return ! $self->{ERROR};`
419	`}`	428	`}`
420		429
421	`#-------------------------------------------------------------------------------`	430	`#-------------------------------------------------------------------------------`
Line 480...	Line 489...
480	`$self->{ROWS_READ}++;`	489	`$self->{ROWS_READ}++;`
481	`return @row;`	490	`return @row;`
482	`}`	491	`}`
483		492
484	`#-------------------------------------------------------------------------------`	493	`#-------------------------------------------------------------------------------`
-		494	`# Function : fetch_colNames`
-		495	`#`
-		496	`# Description : NonStandard function`
-		497	`# Fetch array of colum names`
-		498	`#`
-		499	`# Inputs : None`
-		500	`#`
-		501	`# Returns : An array of column names`
-		502	`#`
-		503	`sub fetch_colNames`
-		504	`{`
-		505	`my $self = shift;`
-		506	`return $self->{COLNAMES};`
-		507	`}`
-		508
-		509	`#-------------------------------------------------------------------------------`
485	`# Function : finish`	510	`# Function : finish`
486	`#`	511	`#`
487	`# Description : Finish the 'execute'`	512	`# Description : Finish the 'execute'`
488	`#`	513	`#`
489	`# Inputs : None`	514	`# Inputs : None`

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LIB/DBI.pm – Rev 6887 → 6910