#!/usr/bin/perl

#################################
#
# Name: Test_BLOB_Access.pl
#
# Parmaters: <none>
# Desr: Perl script to change the FORMDATASEND in JASON_TMP table in UATLC
#
# Need: DBI for access to Oracle
#	Date for date manipulation
#
# Date: Nov 25, 2015
#
# Modification History:
#	 Nov 25, 2015 - Created
#
##################################
use DBD::Oracle qw(:ora_types);
use DBI;
use Date::Manip;
use FileHandle;
use BLOB;
use XML::Twig;

##################################
#
# Initialization Section
#
##################################

&Date_Init();	# Initization of date Manipulation functions
$| = 1;  #set command buffering on
$dir_home = $ENV{RED1};

$DSN = join':','dbi','Oracle',$ENV{RED7};

printf("'%s', '%s', '%s' \n\n\n", $DSN, $ENV{RED3}, $ENV{RED9});

$dbh   = DBI->connect($DSN, $ENV{RED3}, $ENV{RED9}, {
          PrintError => 0,
          RaiseError => 0}) ||
        die "Cannot connect to $DBI: $DBI::errstr\n" unless $dbh;

$SQL = "alter session set NLS_DATE_FORMAT = 'DD-MON-YYYY HH24:MI:SS'";

$sth = $dbh->prepare($SQL);

$sth->execute;

$debug_no  = 0;
$debug_yes = 1;
$debug_flg = $debug_no;

##################################
#
# Get dates
#
##################################
$strt_date = &ParseDate("today");
$start_date = &UnixDate($strt_date,"%d-%m-%Y %H:%M:%S");

$log_strt_date = &ParseDate("today");
$log_start_date = &UnixDate($log_strt_date,"%d-%m-%Y");

$log_name   = $dir_home.qq{/log/}.$ENV{RED7}.'_Blob_Test_'.$log_start_date.'.log';

open (LOG_FILE, ">$log_name") || die "Can't $log_name file \n";

select ("LOG_FILE");
$| = 1;

printf LOG_FILE "Start Run: $start_date\n";
printf LOG_FILE "Flags: \n";
printf LOG_FILE "\tdatabase connect: %s\n\n", $DSN;

############################
# Initialization Section
#
############################
$dbh->{LongTruncOk} = 0;
$dbh->{LongReadLen} = 5000;
#$LONG_RAW_TYPE=24;

my $stmt = qq{select GUID, FORMDATASEND, DOCUMENTTYPEID, APPLICATIONGUID from JASON_TMP where rownum < 10};

my $stuff = $dbh->selectall_arrayref($stmt);
my $xmlout= XML::Twig->new();

foreach  my $row (@$stuff) {
   printf STDERR "Fetching BLOB with GUID %s \n", $row->[0];
   printf STDERR "Size of BLOB %s \n", length($row->[1]);

my $stmt2   = qq{insert into RON_TMP (GUID, FORMDATASEND, DOCUMENTTYPEID, APPLICATIONGUID) values ('};
my $stmt22  = qq{', ?, ?, ?)};
my $stmt21  = $stmt2.$row->[0].$stmt22;
printf LOG_FILE "Update Statement: <%s>\n", $stmt21;


$tst_xml   = $row->[1];

my $twig = XML::Twig->new(
    twig_handlers => {
        LAST_NAME   => sub {
            $_->set_text( 'BLOGS' );    # set the new text
            },
        FIRST_NAME   => sub {
            $_->set_text( 'FRED' );    # set the new text
            },
        MIDDLE_NAME   => sub {
            $_->set_text( 'T' );    # set the new text
            },
        DATE_OF_BIRTH   => sub {
            $_->set_text( '19721231' );    # set the new text
            },
        SEX   => sub {
            $_->set_text( 'F' );    # set the new text
            },
        ADDRESS_1   => sub {
            $_->set_text( '1234 MAIN STREE' );    # set the new text
            },
        ADDRESS_2   => sub {
            $_->set_text( ' ' );    # set the new text
            },
        CITY   => sub {
            $_->set_text( 'SOMEWHERE' );    # set the new text
            },
        PROV_CDE   => sub {
            $_->set_text( 'AA' );    # set the new text
            },
        POSTAL_OR_ZIP_CODE   => sub {
            $_->set_text( 'V8Z6R1' );    # set the new text
            },
        COUNTRY_CDE   => sub {
            $_->set_text( 'CAN' );    # set the new text
            },
        PHONE_NUM   => sub {
            $_->set_text( '2501234567' );    # set the new text
            },
        EMAIL_ADDRESS   => sub {
            $_->set_text( 'Fred,Blogs@a.ca' );    # set the new text
            },
      },
   pretty_print => 'indented',
   );
$twig->parse($tst_xml);
$twig->print;

$sth4 = $dbh->prepare($stmt21)|| die "Stmt2 Prepare: Error on Execute $DBI::errstr";
$sth4->bind_param(1, $tst_xml, {ora_type=>ORA_BLOB, ora_field=>'FORMDATASEND'})|| die "Bind_param BLOB: Error on prepare $DBI::errstr";
$sth4->bind_param(2, $row->[2])|| die "Bind_param DOCUMENTTYPEID: Error on prepare $DBI::errstr";
$sth4->bind_param(3, $row->[3])|| die "Bind_param APPLICATIONGUID: Error on prepare $DBI::errstr";
$rc4 = $sth4-> execute()|| die "Execute Stmt2: Error on Execute $DBI::errstr";

$twig->flush;
$twig->purge;

printf LOG_FILE "Updating BLOB with GUID %s Return Code of Execute Statement: <%x>\n", $row->[0], $rc4;
}

$dbh->commit;
$dbh->disconnect;

exit(0);

##</code><code>##

.
.
    <Student>
      <Profile>
        <LAST_NAME>BLOGS</LAST_NAME>
        <FIRST_NAME>FRED</FIRST_NAME>
        <MIDDLE_NAME>T</MIDDLE_NAME>
        <DATE_OF_BIRTH>19721231</DATE_OF_BIRTH>
        <SEX>F</SEX>
        <ADDRESS_1>1234 MAIN STREE</ADDRESS_1>
        <ADDRESS_2> </ADDRESS_2>
        <CITY>SOMEWHERE</CITY>
        <PROV_CDE>AA</PROV_CDE>
        <POSTAL_OR_ZIP_CODE>V8Z6R1</POSTAL_OR_ZIP_CODE>
        <COUNTRY_CDE>CAN</COUNTRY_CDE>
        <PHONE_NUM>2501234567</PHONE_NUM>
        <EMAIL_ADDRESS>Fred,Blogs@a.ca</EMAIL_ADDRESS>
      </Profile>
    </Student>
.
.
Updating BLOB with GUID xxxxxxxxxxxx Return Code of Execute Statement: <1>