Login or Register to Ask a Question and Join Our Community


Shell Programming and Scripting

Perl inserting random negative integer

Login to Discuss or Reply to this Discussion in Our Community

 
Thread Tools Search this Thread
Top Forums Shell Programming and Scripting Perl inserting random negative integer
# 1  
Old 09-24-2015
Perl inserting random negative integer
Hi All,

i have problem here whenever i run this perl script that is pasted here, it inserts a negative number in place of PO_nbr
.

What the script does is reads a pipe delimited file and then using some values on the file it will query db to get few other values and then it inserts the data into a table.

the problem is only with the po nbr that is being inserted into ...

and this works fine in Unix only in Linux it inserts a negative value


Code:
use strict;

#This is used to flush the log file output after each printf
use FileHandle;
use File::Copy;
use File::Basename;
use DBI;

#This is used to declare options for your program
#by passing flags on the command line like -d -f
use Getopt::Std;

use Time::Local;

#Declare global variables.
my %opt = ();
my $program_name="dryrcvg_palletload";
my $log_file = "/u/spool/07/$program_name.LOG"; #name will change later
my $SQL_DUPLICATE_CONSTR = -268;
my $SQL_DUPLICATE_INDEX = -239;
my $db_name_one="store_receiving";
my $input_file = "";
my $cur_date;
my $cur_time;
my $rc = 0;

#Declare global variables.
my %opt = ();
my $program_name="dryrcvg_palletload";
my $log_file = "/u/spool/07/$program_name.LOG"; #name will change later
my $SQL_DUPLICATE_CONSTR = -268;
my $SQL_DUPLICATE_INDEX = -239;
my $db_name_one="store_receiving";
my $input_file = "";
my $cur_date;
my $cur_time;
my $rc = 0;

#Declare global SQL handlers.
my $db_conn;
my $select_pack_receiving;
my $insert_pack_receiving;
my $update_pack_receiving;
my $insert_pack_rcvg_item;
my $select_pack_rcvg_item;
my $previous_row_item_qty;
my $update_pack_rcvg_item;
my $query_itemupc;
my $query_itemupcxref;
my $query_acctdivnbr;
my $query_vendornbr;
my $query_ponbr;

#Declare a -d  flag for debug mode
#Declare a -f  for file to process
getopts('df:', \%opt);
init_global_variables();

logh("---------- PROGRAM BEGIN dryrcvg_palletload.pl ----------");

#Only when input files area available proceed further
if (%opt)
{
     if($opt{f})
     {
          $input_file = $opt{f};
          logh("Input file to be processed: $input_file");
          $rc = db_init($db_name_one);
         if(!$rc)
          {
               $rc = init_prepare_statement($db_name_one);
          }

          if(!$rc)
          {
               process_input_data($input_file);

               close_db();
          }
          else
          {
               logh("Failed to initialize database connection. Exiting program");
          }
     }
     else
     {
          logh("No input file passed. Exiting program");
     }
}
else
{
     logh("No argument supplied. Exiting program");
}

logh("--------- PROGRAM END dryrcvg_palletload.pl rc [$rc]-------------");

close(LOG_FILE);


#===============================================================================
#    name: process_input_data
#    args: Input_file
# returns: none
#   notes: This reads the input file and parse file
#===============================================================================
sub process_input_data
{
     logh("BEGIN of process_input_data ");
     my ($input_file) = @_;
     my $l_rc = 0;
     my $input_basename;
     my $move_file_name;
     my $po_nbr_from_invoice = 0;

     open(INPUT_FILE, "< $input_file") or (logh("Can't open $input_file $!") and die);

     logh("d","Successful open of $input_file and start processing records");

     my $pallet_id="";
     my $upc_nbr="";

     while(defined(my $line = <INPUT_FILE>))
     {
          my ($club,$country,$temp_pallet_id,$po,$invoice,$trailer,$item,$item_sequence,
              $item_total_sequence,$item_qty,$store_delivery,$expiration_date,
              $receive_method,$weight,$cube,$dc_type) = get_pallet_fields($line);

          logh("d","pallet_id = [$temp_pallet_id]\n
                    Item_Nbr = [$item]\n
                    item_Qty = [$item_qty]\n
                    Store_Delivery = [$store_delivery]\n
                    Club = [$club]\n
                    Country = [$country]\n
                    PO = [$po]\n
                    Invoice = [$invoice]\n
                    Trailer = [$trailer]\n
                    Item_Sequence = [$item_sequence]\n
                    Item_Total_Sequence = [$item_total_sequence]\n
                    Expiry date = [$expiration_date]\n
                    Receive_Method = [$receive_method]\n
                    Weight = [$weight]\n
                    Cube = [$cube]\n
                    DC_Type = [$dc_type] "
                    );

          $pallet_id = substr($temp_pallet_id,6);

          logh("d","Stripped Pallet_id = [$pallet_id]");


          #Fetch Base Division Number
          my $base_div_nbr = get_base_div_nbr($club);

          #Fetch Vendor Number and Order Sequence Number.
          my $vendor_nbr = get_vendor_nbr($po);
          my $order_seq_nbr = 0;
          my $receiving_id = 0;
          my $origin_type_code = 0;

          #Get UPC NBR from the given Item number for DRY GLS FEED
          if($invoice == 0)
          {
                $upc_nbr = get_upc($item);
          }

          #IF the Invoice is zero and unable to get UPC in first try then it could be FRESH GLS feed
          if(($upc_nbr eq "") && ($invoice != 0))
          {
               logh("No UPC Found for item[$item] upc_nbr[$upc_nbr]");
               logh("item[".$item."] sub1[".substr($item, 0, 2)."] sub2[".substr($item,(length($item) - 1),1)."] sub3[".substr($item, 2, (length($item) - 3))."]");
               if(   (substr($item, 0, 2) eq "64")
                  && (substr($item, (length($item) - 1), 1) eq "9")
                 )
               {
                    $origin_type_code = 2;
                    logh("The value of origin_type_code is [$origin_type_code]");

                    $upc_nbr = get_upc(substr($item, 2, (length($item) - 3)));

                    if($upc_nbr ne "")
                    {
                         $item = substr($item, 2, (length($item) - 3));
                         logh("UPC Found for substr[".substr($item, 2, (length($item) - 3))."] upc_nbr[$upc_nbr] item[".$item."]");
                              #Get the PO NBR from Invoice for FRESH GLS FEED
                         $po_nbr_from_invoice = get_po_nbr($invoice);

                         logh(" The PO _nbr from Invoice  is [$po_nbr_from_invoice]");

                         if($po_nbr_from_invoice != 0)
                          {
                                $po = $po_nbr_from_invoice ;
                          }
                         else
                          {
                                $po = 0 ;
                          }
                    }
                    else
                    {
                         $upc_nbr = "0";
                         logh("UPC NOT Found for Item Number $item, loading without UPC. upc_nbr[$upc_nbr]");
                         #Get the PO NBR from Invoice for FRESH GLS FEED
                         $po_nbr_from_invoice = get_po_nbr($invoice);

                         logh(" The PO _nbr from Invoice  is [$po_nbr_from_invoice]");

                         if($po_nbr_from_invoice != 0)
                          {
                                $po = $po_nbr_from_invoice ;
                          }
                         else
                          {
                                $po = 0 ;
                          }
                    }
               }
          }
          else
          {
               $origin_type_code = 1;
               if($upc_nbr eq "")
                {
                  $upc_nbr = 0 ;
                }
          }

          logh("origin_type_code[".$origin_type_code."]");


          if($origin_type_code > 0)
          {
               #Invoke Subroutine load_pallet_info to load data in to pack_receiving
               ($l_rc, $receiving_id) = load_pallet_info($origin_type_code, $pallet_id, $country, $base_div_nbr, $club, $vendor_nbr, $order_seq_nbr, $po);
               logh("Returned receiving_id[$receiving_id] l_rc[$l_rc]");
          }
          else
          {
               $l_rc++;
               logh("Skipped load_pallet_info l_rc=[$l_rc]");
          }

          if(!$l_rc)
          {
               #Invoke subroutine get_upc to retrieve UPC number for given item number
               #$upc_nbr= get_upc($item);

               #if($upc_nbr ne "")
               #{
               #     logh("UPC Found for item[$item] upc_nbr[$upc_nbr]");
               #}
               #else
               #{
               #     $upc_nbr = "0";
               #     logh("UPC NOT Found for Item Number $item, loading without UPC. upc_nbr[$upc_nbr]");
               #}
               $l_rc = load_pallet_upc($receiving_id, $item, $upc_nbr, $item_qty);

               logh("d", "Proceeding with next record");
          }
          else
          {
               logh("Skipped load_pallet_upc l_rc=[$l_rc]");
          }

        #Resetting the UPC for the next record
        $upc_nbr="";
        $origin_type_code="";

     }
     close(INPUT_FILE);

     logh("END of process_input_data ");
}

#===============================================================================
#    name: load_pallet_info
#    args: pallet_id
# returns: none
#   notes: This inserts the pallet_id into pack_receiving table
#===============================================================================
sub load_pallet_info
{
     logh("BEGIN load_pallet_info ");

     my ($origin_type_code, $pallet_id, $country, $base_div_nbr, $club, $vendor_nbr, $order_seq_nbr, $po) = @_;
     my $l_rc = 0;
     my $receiving_id = 0;

     logh("Attempting select from pack_receiving table with pallet_id = [$pallet_id]");
     $select_pack_receiving->execute($origin_type_code, 0, $vendor_nbr, $pallet_id, $order_seq_nbr, $po);
     $receiving_id = $select_pack_receiving->fetchrow_array;
     logh("d", "Selected rows[".$select_pack_receiving->rows."]\n");
     if($select_pack_receiving->rows == 0)
     {
          $receiving_id = 0;
     }
     logh("Serial receiving ID for pallet_id[$pallet_id]: receiving_id[$receiving_id] error[$DBI::err]\n");

     if(($receiving_id == 0) && (!defined($DBI::err)))
     {

          #logh("d","Inserting into pack_receiving table with pallet_id = [$pallet_id]");
          logh("Inserting into pack_receiving table with pallet_id = [$pallet_id]");
          $insert_pack_receiving->execute($origin_type_code, 0, $vendor_nbr, $pallet_id, $order_seq_nbr, $po);
          if(defined($DBI::err))
          {
               if(($DBI::err == $SQL_DUPLICATE_CONSTR) || ($DBI::err == $SQL_DUPLICATE_INDEX))
               {
                    logh("Duplicate insert attempted.  Skipping this record");
               }
               else
               {
                    logh("err = [$DBI::err]");
                    logh("err = [$DBI::errstr]");
                    $l_rc = $DBI::err;
                    logh("Error insert pack_receiving for pallet_id with l_rc = [$l_rc]");
               }
          }
          else
          {

               logh("ReAttempting select from pack_receiving table with pallet_id = [$pallet_id]");
               $select_pack_receiving->execute($origin_type_code, 0, $vendor_nbr, $pallet_id, $order_seq_nbr, $po);
               if(defined($DBI::err))
               {
                    logh("err = [$DBI::err]");
                    logh("err = [$DBI::errstr]");
                    $l_rc = $DBI::err;
                    logh("Error select ReAttempt from pack_receiving for pallet_id[$pallet_id]. l_rc[$l_rc]");
               }
               else
               {
                    $receiving_id = $select_pack_receiving->fetchrow_array;
                    logh("d", "Selected rows[".$select_pack_receiving->rows."]\n");
                    if($select_pack_receiving->rows == 0)
                    {
                         $l_rc += 100;
                    }
               }
               logh("Serial receiving ID for pallet_id[$pallet_id]: receiving_id[$receiving_id] l_rc[$l_rc]\n");

          }
     }
     else
     {
          logh("pack_receiving receiving_id= [$receiving_id]");
          logh("Updating pack_receiving table with pallet_id = [$pallet_id]. Marking for audit.");
          $update_pack_receiving->execute($origin_type_code, 0, $vendor_nbr, $pallet_id, $order_seq_nbr, $po);

          if(defined($DBI::err))
          {
               logh("err = [$DBI::err]");
               logh("err = [$DBI::errstr]");
               $l_rc = $DBI::err;
               logh("Error updating pack_receiving for pallet_id with l_rc = [$l_rc]");
          }
     }

     logh("END load_pallet_info");
     return(($l_rc, $receiving_id));
}

#===============================================================================
#    name: logh
#    args: what will be written to the log file
# returns: none
#   notes: This is the logging function for this script
#===============================================================================
sub logh
{
     my $line = shift(@_);
     my $dbg_flg = 0;

     (my $sec, my $min, my $hour, my $mday, my $mon, my $year, my $wday, my $yda, my $isdst) = localtime(time);
     $mon  += 1; $wday += 1; $year += 1900;

     if($line eq "d")
     {
          $line = shift(@_);
          $dbg_flg = 1;
     }


     #if debug mode
     if($opt{d} && $dbg_flg)
     #if($dbg_flg)
     {
           printf LOG_FILE ("%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d  %s\n",
                            $mon,$mday,$year,$hour,$min,$sec,$line);
     }
     #ignore debug statements
     elsif(!$dbg_flg)
     {
          printf LOG_FILE ("%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d  %s\n",
                         $mon,$mday,$year,$hour,$min,$sec,$line);
     }
}

#=======================================================================
#    name: init_prepare_statement
#    args: none
# returns: none
#   notes: This will initialise the prepare statement
#=======================================================================
sub init_prepare_statement
{
     my ($database_name) = @_ ;
     my $l_rc = 0;

     logh("Begin of init_prepare_statement");


     if(!$l_rc)
     {
          $select_pack_receiving = $db_conn->prepare(
          qq{
               SELECT first 1 nvl(receiving_id, 0) as receiving_id
                 FROM }.$database_name.qq{:pack_receiving
                WHERE origin_type_code = ?
                  AND dc_nbr = ?
                  AND vendor_nbr = ?
                  AND pack_nbr = ?
                  AND order_seq_nbr = ?
                  AND po_nbr = ?
               ;
          });
                  #AND user_id = "ISD"
                  #AND rcvg_action_code = 0
                  #AND action_reason_code = 0
                  #AND audit_type_code = 0
                  #AND pack_damaged_ind = 0
                  #AND recv_appt_nbr = 0
                  #AND asn_id IS NULL
                  #AND receipt_nbr IS NULL
                  #AND last_upd_pgm_id = "}.$program_name.qq{"

          if( defined($DBI::err))
          {
               logh("err = [$DBI::err]");
               logh("err = [$DBI::errstr]");
               $l_rc = $DBI::err;
               logh("Error prepare select_pack_receiving l_rc = [$l_rc]");
          }
     }


     if(!$l_rc)
     {
          $insert_pack_receiving = $db_conn->prepare(
          qq{
               insert into }.$database_name.qq{:pack_receiving
               (origin_type_code, dc_nbr, vendor_nbr, pack_nbr, order_seq_nbr,
                po_nbr, asn_id, user_id, rcvg_action_code, action_reason_code, audit_type_code, pack_damaged_ind,
                recv_appt_nbr, receipt_nbr, rcvg_action_ts, last_upd_pgm_id
               )
               values
               (?, ?, ?, ?, ?,
                ?, NULL, "ISD", 0, 0, 0, 0,
                0, NULL, CURRENT, "}.$program_name.qq{"
               )
          });


          if( defined($DBI::err))
          {
               logh("err = [$DBI::err]");
               logh("err = [$DBI::errstr]");
               $l_rc = $DBI::err;
               logh("Error prepare insert_pack_receiving l_rc = [$l_rc]");
          }
     }



     if(!$l_rc)
     {
          $update_pack_receiving = $db_conn->prepare(
          qq{
               UPDATE }.$database_name.qq{:pack_receiving
                  SET audit_type_code = 0
                WHERE origin_type_code = ?
                  AND dc_nbr = ?
                  AND vendor_nbr = ?
                  AND pack_nbr = ?
                  AND order_seq_nbr = ?
                  AND po_nbr = ?
               ;
          });

          if( defined($DBI::err))
          {
               logh("err = [$DBI::err]");
               logh("err = [$DBI::errstr]");
               $l_rc = $DBI::err;
               logh("Error prepare update_pack_receiving l_rc = [$l_rc]");
          }
     }

     logh("END OF Prepare statemnt initialisation. l_rc[$l_rc]");
     return($l_rc);
}

#===============================================================================
#    name: init_global_variables
#    args: none
# returns: none
#   notes:This will initialise the global variables
#===============================================================================
sub init_global_variables
{
     $cur_date = `date +'%m%d%y'`;
     chomp($cur_date);
     $cur_time = `date +'%H%M%S'`;
     chomp($cur_time);

     $log_file = "/u/spool/07/$program_name.LOG.$cur_date";
     open(LOG_FILE, ">> $log_file") or die "can't open $log_file $!";

     #Set variable to flush after each write to the file
     LOG_FILE->autoflush(1);
}

#================================================================
#   name: close_db
#   args: none
#returns: none
#  notes: This will close the db session
#================================================================
sub close_db
{
     if(defined $db_conn)
     {
          $db_conn->disconnect();
          logh("Connection to database is now disconnected");
     }
     logh("END OF close_db");

}

# 2  
Old 09-24-2015
The one function we need to see is the one function you didn't include..
# 3  
Old 09-24-2015
I agree with Corona688. You need to post the code for get_po_nbr for people to help you.
# 4  
Old 09-25-2015
Quote:
Code:
                        if($po_nbr_from_invoice != 0)
                          {
                                $po = $po_nbr_from_invoice ;
                          }
                         else
                          {
                                $po = 0 ;
                          }

This and similar flow control conditions are extraneous. Think about it.
If the value of $po_nbr_from_invoice is not a zero $po gets it. However, if is zero $po gets zero, which is what $po_nbr_from_invoice has already, therefore the whole if-else block could be reduced to just the assigment:
Code:
$po = $po_nbr_from_invoice;

# 5  
Old 09-25-2015
here is the get_po_nbr function
Code:
#============================================================================
# name: get_po_nbr
# args: po number
# returns: PO number
# notes: Retrieves the PO_nbr from table for PO number
#============================================================================
sub get_po_nbr
{
my ($invoice_nbr)=@_;
my $po_nbr = 0;

logh("Query table for po_nbr[$invoice_nbr]");
$query_ponbr->execute($invoice_nbr);
$po_nbr = $query_ponbr->fetchrow_array;
if($query_ponbr->rows == 0)
{
$po_nbr = 0;
}
logh("Returned po_nbr[$po_nbr] number for Invoice_nbr[$invoice_nbr] \n");

return $po_nbr;
}

Last edited by selvankj; 09-25-2015 at 04:10 PM.. Reason: added code tags
Login or Register to Ask a Question

Previous Thread | Next Thread

10 More Discussions You Might Find Interesting

1. Shell Programming and Scripting

Perl Script Integer Test

Working out a small problem, I have a need of a Perl snippet which might look something like this: use integer; ... if ($changingNumber / 2) { do something; } else { do something else; } ... What I want to happen is for "if" to resolve as "true" every time a whole... (3 Replies)
Discussion started by: LinQ
3 Replies

2. Shell Programming and Scripting

Perl: backslash in front of integer like \32768

In Perl, what does a backslash preceding an integer do like \32768 ? The $/ section of perlvar writes: local $/ = \32768; # or \"32768", or \$var_containing_32768 How is \32768 different from just 32768 without backslash? I do not understand the backslashes in \"32768" and... (1 Reply)
Discussion started by: LessNux
1 Replies

3. Homework & Coursework Questions

Process, where each process generates a random integer

Hello all, I am writing a program where user enters an integer and the program creates that number of processes. Each child process generates a random integer. When a child process calls a procedure say Myprocedure it should terminate where as the parent process wait for the child to terminate. (4 Replies)
Discussion started by: manisum
4 Replies

4. Shell Programming and Scripting

Perl output with negative and positive numbers

Hello, For my weather station I have made a little perl script to put the data into cacti. The next problem I have. I can only get positive numbers or negative numbers. What do I do: Though a shell scrip I call the perl script. Shell script: #!/bin/sh cat data.txt | stats.pl Perl... (4 Replies)
Discussion started by: rbl-blacklight
4 Replies

5. Shell Programming and Scripting

Perl - Inserting text

Hey, I have 10 lines of text ... And I would like to Insert prefix for each line with static text. perl -pi -e 's/()/$1 TEST$./' data.txt Each line will have different static prefix, Code above works perfectly for 1st line ... I'm just not sure how I can run same command for 2nd line 3rd... (4 Replies)
Discussion started by: NDxiak
4 Replies

6. Shell Programming and Scripting

Random Numbers - Perl

Hi Guys I have a script to find Ranomd numbers. But I want to make the file to produce more random. Could u guys help me plz. In this Script I have the code that generates random in for loop and the range I have specified in my %chromlength input and out put will be like this chrno start end... (3 Replies)
Discussion started by: repinementer
3 Replies

7. Shell Programming and Scripting

Need Help in Inserting a new line in a file using PERL

I need a perl script to find and replace a specific pattern in a file to a new line. BAsically I have a single line data in a file with 10 mb to 200 MB. I want to put a new line based on a specific pattern to open the file in Excel / Access. Following is the sample data in a file ... (1 Reply)
Discussion started by: portalfaq
1 Replies

8. Shell Programming and Scripting

Inserting into first record using perl

hi all... i got some requirment where i need to insert some values into first record of flat file. i am using perl for that job. var1=456 var2=789 echo `perl -p -i -e "s/U/\${var1}U${var2}/g;" myFile.txt` but it is writing into all records which has U.... can anyone help me out in this... (7 Replies)
Discussion started by: shreekrishnagd
7 Replies

9. Shell Programming and Scripting

how do i generate random integer using only shell script

Hi All, I need to generate 4 digit random no using only shell script. Please help in this ASAP. Thanks in advance... Regards, sridhar. (1 Reply)
Discussion started by: sridhusha
1 Replies

10. Shell Programming and Scripting

Perl: random select

How do I: 1. Have a list of names. JOE, JOHN, PETER, PAT. how do i get perl to randomly select any two and put them in $name1 and put the other two in $name2 ? (1 Reply)
Discussion started by: perleo
1 Replies
Login or Register to Ask a Question