#! 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
#                 of the deployments scripts that use an DBI:ODBC interface
#                 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;
#use Data::Dumper;
use Cwd;
use IPC::Open2;

package DBI;
our $VERSION = '2.0.1';


use Exporter;
our @EXPORT = qw();
our @EXPORT_OK = (@EXPORT, qw());
our %EXPORT_TAGS = qw( );
our $verbose = $ENV{'GBE_DBI_VERBOSE'} || 0;
our $errstr = "No Error";
my  $appname = 'ReleaseManagerSelect.jar';
my $full_app;

#
#   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
#
# Description     : Connect to the SQL server
#
# Inputs          : $db                     - Database Name
#                   $user                   - User Name
#                   $passwd                 - PassWord
#
# Returns         : New connection
#                   undef if the required Java utility cannot be found
#
sub connect
{
    my $obclass = shift;
    my $class = ref($obclass) || $obclass;

    bless my $self = {
        DB          => $_[0],
        USER        => $_[1],
        PASSWORD    => $_[2],
        ATTRREF     => $_[3],
        ERROR       => 0,
        ECOUNT      => 0,
        FH_READ     => undef,
        FH_WRITE    => undef,
        PID         => 0,
    } => ( $class );

    if ( $self->{ATTRREF}->{verbose} )
    {
        $verbose = $self->{ATTRREF}->{verbose};
    }

    #
    #   Convert legacy ODBC refs
    #   Should not needed any more
    #
    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;
    }

    #
    #   Need to locate the path to the Java applet
    #   This can be in th "CLASSPATH", but that simply forces the problem of
    #   locating the utility into the configuration world
    #
    #   Look in Perls @INC list, as we expect to find the program within one of
    #   thePerl Libraries.
    #
    unless ( $full_app )
    {
        foreach my $dir ( @INC )
        {
            my $apppath = "$dir/$appname";
            next unless ( -f $apppath );

            $full_app = $apppath;
            last;
        }

        if ( ! $full_app )
        {
            $errstr = "Cannot find $appname in @INC path";
            return;
        }
    }

    $errstr = "OK";

    #
    #   Initiate the external application server
    #   This is slow and will only done once
    #
    #   Start up the Java based Oracle interface script
    #   Create it with both a read and a write handle as we will be pushing
    #   requests at it and pulling data from it.
    #
    #   Monitor the status of the server waiting for an indication that the
    #   connection is open, or that the connection link has terminated.
    #
    #
    my @cmd;
    push @cmd, "java";                      # Use form that will not invoke a shell
    push @cmd, "-jar";
    push @cmd, $full_app;
    push @cmd, $self->{DB};
    push @cmd, $self->{USER};
    push @cmd, $self->{PASSWORD};

    $self->{PID} = IPC::Open2::open2($self->{FH_READ}, $self->{FH_WRITE}, @cmd );

    $self->{ERROR} = 1;
    $errstr = "Failed to start server app";
    if ( $self->{PID} )
    {
        #
        #   Extract status and any error information
        #
        my $fh = $self->{FH_READ};
        while ( <$fh> )
        {
            $_ =~ s~\s+$~~;
            print "[DBI] Connect: $_\n" if $verbose;

            if ( m/^ConnectionOpened:/ )
            {
                $self->{ERROR} = 0;
                $errstr = "OK";
                last;
            }

            if ( m/^Error:(.*?)\s*$/ )
            {
                $errstr = $1;
            }

            if ( m/^Status:ConnectionClosed$/ )
            {
                $self->{PID} = 0;
            }
        }
    }

    #
    #   Return class iff the connection has been established
    #

    return $self->{ERROR} ? undef : ($self);
}


#-------------------------------------------------------------------------------
# Function        : errstr
#
# Description     : Return the last open error
#
# Inputs          : None
#
# Returns         : String
#
sub errstr
{
    return $errstr;
}

#-------------------------------------------------------------------------------
# Function        : prepare
#
# Description     : Prepare an SQL statement for processing
#
# Inputs          : $self
#                   $statement
#
# Returns         : Reference to a class
#                   undefined on error
#
sub prepare
{
    my $self = shift;
    my $statement = shift;

    #
    #   Remove new-lines from the statement
    #   Must not send new-lines to the application - they don't make it
    #
    $statement =~ s~\n~ ~g;

    #
    #   Remove leading and trailing whitespace
    #
    $statement =~ s~^\s*~~;
    $statement =~ s~\s*$~~;

    print "[DBI] Prepare: $statement\n" if $verbose;

    #
    #   Create a new object to represent the SQL statement being prepared
    #
    my $class = "DBI_Prepare";
    bless my $new_self = {
        CONNECTION => $self,
        STATEMENT => $statement,
        ROWS_READ   => 0,
        ROWS        => 0,
        FH          => undef,
        ERRSTR      => 'OK',
    } => ( $class );

    $self->{ECOUNT}++;
    return $new_self;
}

#-------------------------------------------------------------------------------
# Function        : disconnect
#
# Description     : Close the connection
#
# Inputs          : None
#
# Returns         : Nothing
#
sub disconnect
{
    my $self = shift;
    print "[DBI] Disconnect\n" if $verbose;

    if ( $self->{PID} )
    {
        #
        #   Send out a zero-length query
        #   This will cause the helper application to close the connection
        #

        my $fhw = $self->{FH_WRITE};
        print $fhw "\n\n\n";

        #
        #   Now read in data until the pipe breaks
        #
        my $fhr = $self->{FH_READ};
        while ( <$fhr> )
        {
            chomp;
            print "[DBI] Disconnect: $_\n" if $verbose;
        }

        close( $self->{FH_READ} );
        close( $self->{FH_WRITE} );

        $self->{FH_READ} = undef;
        $self->{FH_WRITE} = undef;

        #
        #   Kill the server task.
        #   It will hang around forever if we don't do this
        #
#        kill 9, $self->{PID};
        $self->{PID} = 0;
    }

    return 1;
}

#-------------------------------------------------------------------------------
# Function        : DESTROY
#
# Description     : Called when the object is destroyed
#
# Inputs          :
#
# Returns         :
#
sub DESTROY
{
    my $self = shift;
    $self->disconnect();
    $self->dumpSelf() if $verbose > 1;
    print "[DBI] Connection destroyed\n" if $verbose;
}

#==============================================================================
#   dumpSelf, debugging member to dump selfs hash
#==============================================================================
sub dumpSelf
{
    use Data::Dumper;

    my $self = shift;

    print Data::Dumper->Dump([$self], [ref($self)]);
}   # dumpSelf



#-------------------------------------------------------------------------------
#
#   A new package to encapulate the actual SQL operations
#
package DBI_Prepare;

#-------------------------------------------------------------------------------
# Function        : execute
#
# Description     : Execute the SQL statement
#
# Inputs          : A list of substitution arguments
#                   These will be repalced within the SELECT statement;
#
# Returns         : True: Execution was good
#
sub execute
{
    my $self = shift;
    my @args = @_;
    my @rows;

    my $statement = $self->{STATEMENT};


    #
    #   The users query may contain '?' characters
    #   These are replaced with arguments passed in to the 'execute'
    #
    if ( @args )
    {
        foreach my $arg ( @args )
        {
            $statement =~ s~\?~'$arg'~;
        }
    }

    #
    #   Write the select statement to the helper server task on the writer pipe
    #   The server will execute the task on our behalf and return the results
    #   on our reader handle
    #
    $self->{ERRSTR} = 'None';
    my $fhw = $self->{CONNECTION}{FH_WRITE};
    print $fhw "$statement\n";

    #
    #   Extract ALL the data from the link
    #   This will allow for nested calls
    #
    #   Assume that we have an error, until we see the start of data marker
    #
    $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/^DataStart:/ )
        {
            $self->{ERROR} = 0;
        }

        if ( m/^DataEnd:/ )
        {
            last;
        }
        
        if ( m/^Warning:(.*?)\s*$/ )
        {
            $self->{ERROR} = 1;
            $self->{ERRSTR} = $1;
        }

    }

    $self->{ROWS} = \@rows;

    return ! $self->{ERROR};
}

#-------------------------------------------------------------------------------
# Function        : errstr
#
# Description     : Return the last execute error
#
# Inputs          : None
#
# Returns         : String
#
sub errstr
{
    my $self = shift;
    return $self->{ERRSTR};
}

#-------------------------------------------------------------------------------
# Function        : rows
#
# Description     : Return the number of rows extracted in the query
#
# Inputs          : None
#
# Returns         : -1, because we don't know
#
sub rows
{
    my $self = shift;
    my $row_count = 1 + $#{$self->{ROWS}};
    print "[DBI] Rows: $row_count\n" if $verbose > 1;
    return $row_count;
}

#-------------------------------------------------------------------------------
# Function        : fetchrow_array
#
# Description     : Return the next row of data
#
# Inputs          : None
#
# Returns         : The next row of data
#                   undef on end of data
#
sub fetchrow_array
{
    my $self = shift;
    my $rowref = $self->{ROWS};
    my $data = pop @$rowref;

    return () unless ( $data );
    $data =~ s~\s+$~~;

    my @row;
    foreach my $item ( split (',', $data ) )
    {
        push @row, pack( 'H*', $item);
    }

    print "[DBI] RawData: ". join(',', @row)."\n" if $verbose > 1;
#   print "[DBI] RawData: ". join(',', @row)."\n";
    $self->{ROWS_READ}++;
    return @row;
}

#-------------------------------------------------------------------------------
# Function        : finish
#
# Description     : Finish the 'execute'
#
# Inputs          : None
#
# Returns         : Nothing
#
sub finish
{
    my $self = shift;
}

#-------------------------------------------------------------------------------
# Function        : DESTROY
#
# Description     : Called when the object is destroyed
#
# Inputs          :
#
# Returns         :
#
sub DESTROY
{
    my $self = shift;
    $self->dumpSelf() if $verbose > 1;
    print "[DBI] Query destroyed\n" if $verbose;
}

#==============================================================================
#   dumpSelf, debugging member to dump selfs hash
#==============================================================================
sub dumpSelf
{
    use Data::Dumper;

    my $self = shift;

    print Data::Dumper->Dump([$self], [ref($self)]);
}   # dumpSelf


1;