Perl program to write a .xlsx file

×

Error message

  • Deprecated function: implode(): Passing glue string after array is deprecated. Swap the parameters in drupal_get_feeds() (line 394 of /home4/ccollins/public_html/ccollins/includes/common.inc).
  • Deprecated function: The each() function is deprecated. This message will be suppressed on further calls in menu_set_active_trail() (line 2405 of /home4/ccollins/public_html/ccollins/includes/menu.inc).

So I made this return file for a client and the sales person got their panties up in their ass because they wanted it as a .xlsx formated to each store. So i wrote this to make life easier for myself.


return.csv

STORE,ITEM,BUNDLE,BEG_CARD,END_CARD,TRACKING,ORDER,QTY
T0684,17312001010,10006650,6001760806021262250,6001760806021262490,590698842944,470712,12



env.in

# EMAIL for the program
emailSENDER = jetitmanager@
emailRECIPIENTS = christopherc@
RETURNFILE=/mnt/pcard/TJX/Return
RETURNFILEWINDOWS=\\jservdc01\pcard\TJX\Return

FormatReturn.pl


FormatReturn.pl



FormatReturn.pl


#!/usr/bin/perl
#######
## Collins, Chris type
## Nov 2014
########
## Format the return file

use strict ;
use warnings ;

push( @INC, "/jet/prod/include" ) ;

use Getopt::Long ;
use Data::Dumper ;
use POSIX qw( strftime ) ;
use File::Basename ;
use File::Path qw(make_path remove_tree) ;
use Log::Log4perl ;
use DBI ;
use Time::Local ;
use Date::Calc qw(Delta_Days) ;
use Sys::Hostname ;
use SendMail 2.04 ;
use File::Spec::Functions ;
use Array::Utils qw(:all) ;
use List::MoreUtils 'true' ;
use Excel::Writer::XLSX ;

my $Help ;
my $Date ;
my $Log ;
my $noEmail ;
my $file ;
my $BATCH_PREFIX ;
my $ref           = {} ;
my $verbose       = 1 ;
my $simulateError = 0 ;
my $testDB        = 0 ;
my $hostname      = hostname ;

$Data::Dumper::Sortkeys = 1 ;
$|++ ;

my $script = &scriptName ($ref) ;
&getOptions ($ref) ;

if ($testDB) { $ref->{TESTDB} = 1 ; }

if ( $Help || ( !defined $file ) ) {
    &Help (@_) ;
}

&getLocalEnv ($ref) ;
&getDate     ($ref) ;
&getEnv      ("/jet/prod/T/env.ini") ;
my $log = &log4p () ;

$log->info ("On $ref->{config}->{ENV}") ;

my $lines = [] ;

&fileToArray ( $file, $lines ) ;

&getWorkbooks ( $ref, $lines ) ;

&writeExcel ( $ref, $file, $lines ) ;

unless ($noEmail) {
    &sendEmail ($ref) ;
}

$log->info ("The End") ;
exit(0) ;

############################
#functions
############################
sub fileToArray
{
    my $file  = shift(@_) ;
    my $lines = shift(@_) ;

    my $inFile = $ref->{config}->{RETURNFILE} . "/" . $file ;

    $ref->{FILE}->{inFile} = $inFile ;

    my $function = ( caller(0) )[3] ;
    $log->debug ("$function") ;

    open( FH, "<", "$inFile" ) ;
    @{$lines} = <FH> ;
    close(FH) ;
    return ;
}

sub createOutFile
{
    my $ref  = shift(@_) ;
    my $file = shift(@_) ;

    my $function = ( caller(0) )[3] ;
    $log->debug ("$function") ;

    # Date used for the logs
    my $date = &getDateTime () ;

    # create the out file
    $file =~ s/-\d+\.csv$/-$date\.xlsx/ ;
    my $outputFile = $ref->{config}->{RETURNFILE} . "/" . $file ;
    $ref->{FILE}->{outFile} = $outputFile ;

    return $outputFile ;
}

sub writeExcel
{
    my $ref   = shift(@_) ;
    my $file  = shift(@_) ;
    my $lines = shift(@_) ;

    my $function = ( caller(0) )[3] ;
    $log->debug ("$function") ;

    my $lineCount = scalar @{$lines} ;

    $log->info ("Number of lines in file : $lineCount") ;

    # put them in a hash
    my $hashref = {} ;
    foreach my $line ( @{$lines} ) {
        next if ( $line =~ /STORE/ ) ;
        next if ( $line =~ /^,/ ) ;

        # remove \'
        $line =~ s/\\\'//g ;

        # remove '
        $line =~ s/\'//g ;

        my @array = split( ",", $line ) ;

        my $TYPE     = substr( $array[0], 0, 1 ) ;
        my $STORE    = $array[0] ;
        my $ITEM     = $array[1] ;
        my $BUNDLE   = $array[2] ;
        my $BEG_CARD = $array[3] ;
        my $END_CARD = $array[4] ;
        my $TRACKING = $array[5] ;

        $hashref->{$TYPE}->{$STORE}->{$ITEM}->{$BUNDLE}->{BEG_CARD} = $BEG_CARD ;
        $hashref->{$TYPE}->{$STORE}->{$ITEM}->{$BUNDLE}->{END_CARD} = $END_CARD ;
        $hashref->{$TYPE}->{$STORE}->{$ITEM}->{$BUNDLE}->{TRACKING} = $TRACKING ;
    }

    my $outputFile = &createOutFile ( $ref, $file ) ;

    # Create a new Excel workbook
    my $workbook = Excel::Writer::XLSX->new ("$outputFile") ;
    $log->info ("Out File : $outputFile ") ;

    # create each batch
    foreach my $BATCH_NUMBER ( sort { $a cmp $b } ( keys %{ $ref->{BATCH} } ) ) {
        my $row = 0 ;
        my $col = 0 ;

        # massage the batch_numver into a name  e.g. T
        my $batch = $ref->{BATCH}->{$BATCH_NUMBER} ;

        my $batch_initial = uc( substr( $BATCH_NUMBER, 0, 1 ) ) ;

        my $worksheet = $workbook->add_worksheet ($batch) ;
        $log->info ("Creating worksheet : $batch") ;

        $worksheet->write ( $row, $col, 'STORE' ) ;
        $col++ ;
        $worksheet->write ( $row, $col, 'ITEM' ) ;
        $col++ ;
        $worksheet->write ( $row, $col, 'BUNDLE' ) ;
        $col++ ;
        $worksheet->write ( $row, $col, 'BEG_CARD' ) ;
        $col++ ;
        $worksheet->write ( $row, $col, 'END_CARD' ) ;
        $col++ ;
        $worksheet->write ( $row, $col, 'TRACKING' ) ;

        # print totals
        $worksheet->write ( 'H1', 'TOTAL' ) ;
        $worksheet->write ( 'H2', '=COUNTA(A:A) -1' ) ;

        my $count ;

        foreach my $store ( sort { $a cmp $b } ( keys %{ $hashref->{$batch_initial} } ) ) {

            #                           $log->debug("STORE : $store");

            foreach my $item ( sort { $a <=> $b } ( keys %{ $hashref->{$batch_initial}->{$store} } ) ) {

                #                                       $log->debug("  ITEM : $item");

                foreach my $bundle ( sort { $a <=> $b } ( keys %{ $hashref->{$batch_initial}->{$store}->{$item} } ) ) {

                    #                                   $log->debug("    BUNDLE : $bundle");

                    $row++ ;

                    my $beg =
                      $hashref->{$batch_initial}->{$store}->{$item}->{$bundle}->{BEG_CARD} ;
                    my $end =
                      $hashref->{$batch_initial}->{$store}->{$item}->{$bundle}->{END_CARD} ;
                    my $tra =
                      $hashref->{$batch_initial}->{$store}->{$item}->{$bundle}->{TRACKING} ;

                    $col = 0 ;
                    $worksheet->write ( $row, $col, $store ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $item ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $bundle ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $beg ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $end ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $tra ) ;
                    $col++ ;
                }
            }
        }
    }
    #
    # now make the data workbook with all fields
    #
    my $row       = 0 ;
    my $col       = 0 ;
    my $worksheet = $workbook->add_worksheet ('DATA') ;
    $log->info ("Creating worksheet : 'DATA'") ;
    $worksheet->write ( $row, $col, 'STORE' ) ;
    $col++ ;
    $worksheet->write ( $row, $col, 'ITEM' ) ;
    $col++ ;
    $worksheet->write ( $row, $col, 'BUNDLE' ) ;
    $col++ ;
    $worksheet->write ( $row, $col, 'BEG_CARD' ) ;
    $col++ ;
    $worksheet->write ( $row, $col, 'END_CARD' ) ;
    $col++ ;
    $worksheet->write ( $row, $col, 'TRACKING' ) ;

    # print totals
    $worksheet->write ( 'H1', 'TOTAL' ) ;
    $worksheet->write ( 'H2', '=COUNTA(A:A) -1' ) ;

    foreach my $batch_initial ( sort { $a cmp $b } ( keys %{$hashref} ) ) {
        foreach my $store ( sort { $a cmp $b } ( keys %{ $hashref->{$batch_initial} } ) ) {

            #         $log->debug("STORE : $store");

            foreach my $item ( sort { $a <=> $b } ( keys %{ $hashref->{$batch_initial}->{$store} } ) ) {

                #            $log->debug("  ITEM : $item");

                foreach my $bundle ( sort { $a <=> $b } ( keys %{ $hashref->{$batch_initial}->{$store}->{$item} } ) ) {

                    #            $log->debug("    BUNDLE : $bundle");

                    $row++ ;

                    my $beg =
                      $hashref->{$batch_initial}->{$store}->{$item}->{$bundle}->{BEG_CARD} ;
                    my $end =
                      $hashref->{$batch_initial}->{$store}->{$item}->{$bundle}->{END_CARD} ;
                    my $tra =
                      $hashref->{$batch_initial}->{$store}->{$item}->{$bundle}->{TRACKING} ;

                    $col = 0 ;
                    $worksheet->write ( $row, $col, $store ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $item ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $bundle ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $beg ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $end ) ;
                    $col++ ;
                    $worksheet->write_string ( $row, $col, $tra ) ;
                    $col++ ;
                }
            }
        }
    }

    # print totals
    $worksheet->write ( 'I1', 'TOTAL' ) ;
    $worksheet->write ( 'H2', 'T' ) ;
    $worksheet->write ( 'I2', '=T!H2' ) ;
    $worksheet->write ( 'H3', 'MARSHALLS' ) ;
    $worksheet->write ( 'I3', '=MARSHALLS!H2' ) ;
    $worksheet->write ( 'H4', 'HOMEGOODS' ) ;
    $worksheet->write ( 'I4', '=HOMEGOODS!H2' ) ;
    $worksheet->write ( 'I5', '=SUM(I2:I4)' ) ;
    $worksheet->write ( 'J5', 'Totals in Sheets' ) ;
    $worksheet->write ( 'I6', '=COUNTA(A:A) -1' ) ;
    $worksheet->write ( 'J6', 'Total for all records' ) ;

    $workbook->close () ;
    return ;
}

sub getWorkbooks
{
    my $ref   = shift(@_) ;
    my $lines = shift(@_) ;

    my $function = ( caller(0) )[3] ;
    $log->info ("$function") ;

    foreach my $line ( @{$lines} ) {
        next if ( $line =~ /STORE/ ) ;
        my $BATCH_NUMBER = substr( $line, 0, 1 ) ;

        $ref->{BATCH}->{$BATCH_NUMBER} = $BATCH_NUMBER ;

        if ( $BATCH_NUMBER =~ /^T/ ) {
            $ref->{BATCH}->{$BATCH_NUMBER} = 'T' ;
        } elsif ( $BATCH_NUMBER =~ /^M/ ) {
            $ref->{BATCH}->{$BATCH_NUMBER} = 'M' ;
        } elsif ( $BATCH_NUMBER =~ /^H/ ) {
            $ref->{BATCH}->{$BATCH_NUMBER} = 'H' ;
        } else {
            $log->info ("Could not find a batch for $BATCH_NUMBER ") ;
            exit ;
        }
    }
    foreach my $batch ( keys %{ $ref->{BATCH} } ) {
        $log->info ("Workbook : $ref->{BATCH}->{$batch} ") ;
    }
    return ;
}

sub sendEmail()
{

    my $ref = shift(@_) ;

    my $function = ( caller(0) )[3] ;
    $log->debug ("$function") ;

    $log->debug ("Sending Email") ;

    my $ENV = $ref->{config}->{ENV} ;

    my $fullFile = $ref->{FILE}->{outFile} ;

    my $msg .= $ref->{CARD}->{SID} ;
    $msg    .= "\n" ;
    $msg    .= $fullFile ;
    $msg    .= "\n" ;
    $msg    .= "\n" ;
    $msg    .= "Log File" ;
    $msg    .= "\n" ;
    $msg    .= "$ref->{config}->{Log} \n" ;
    $msg    .= "\n" ;

    my $emailSUBJ = "T Retrun for $ref->{config}->{Date} ($0 on $hostname)" ;

    my $emailSENDER = 'jetitmanager@jetlitho.com' ;    # use the sender's address here
    my @emailRECIPIENTS ;

    if ( $ref->{config}->{simulateError} == 1 || $ref->{TESTDB} ) {
        @emailRECIPIENTS = qw(christopherc@jetlitho.com) ;
    } else {
        @emailRECIPIENTS = split( /,/, $ref->{config}->{emailRECIPIENTS} ) ;
    }

    my $sm = new SendMail ("jet-mail") ;
    $sm->From        ($emailSENDER) ;
    $sm->To          (@emailRECIPIENTS) ;
    $sm->Subject     ($emailSUBJ) ;
    $sm->setMailBody ($msg) ;

    if ( -x $fullFile ) {
        $log->info  ("Attaching file : $fullFile") ;
        $sm->Attach ($fullFile) ;
    } else {
        $log->error ("Could not locate : $fullFile") ;
    }

    $log->debug ("--[ From: $emailSENDER") ;
    $log->debug ( "--[ To: (" . join( ' ', @emailRECIPIENTS ) . ")" ) ;
    $log->debug ("--[ Subject: $emailSUBJ") ;
    $log->debug ("--[ Body: $msg") ;

    my $rv = $sm->sendMail () ;

    if ( $rv != 0 ) {
        $log->debug ("\n\n\tAttempt to send mail failed \n $!\n") ;
    } else {
        $log->debug ("\n\n\tAttempt to send mail successful\n") ;
    }

    return ;
}

sub log4p
{

    my $function = ( caller(0) )[3] ;
    print "$function \n" ;

    # Date used for the logs
    my $date = &getDate () ;

    unless ($Log) { $Log = $script . "-" . $date . ".log" ; }

    $ref->{config}->{logDir}        = "/jet/prod/log/$date/T" ;
    $ref->{config}->{Log}           = $ref->{config}->{logDir} . "/" . $Log ;
    $ref->{config}->{Debug}         = $ref->{config}->{logDir} . "/" . "Debug.out" ;
    $ref->{config}->{simulateError} = $simulateError ;

    # make the path
    make_path ( $ref->{config}->{logDir} ) ;

    my $log_conf = qq(
            log4perl.rootLogger              = DEBUG, LOG, SCREEN
            log4perl.appender.LOG            = Log::Log4perl::Appender::File
            log4perl.appender.LOG.filename   = $ref->{config}->{Log}
            log4perl.appender.LOG.mode       = append
            log4perl.appender.LOG.layout     = Log::Log4perl::Layout::PatternLayout
            log4perl.appender.LOG.Threshold  = info 
            log4perl.appender.LOG.layout.ConversionPattern = %d %p %m %n
            log4perl.appender.SCREEN           = Log::Log4perl::Appender::Screen
            log4perl.appender.SCREEN.stderr    = 0
            log4perl.appender.SCREEN.layout    = Log::Log4perl::Layout::PatternLayout
            log4perl.appender.SCREEN.Threshold = info 
            log4perl.appender.SCREEN.layout.ConversionPattern = %d %p %m %n
      ) ;

    Log::Log4perl::init ( \$log_conf ) ;

    my $log = Log::Log4perl->get_logger () ;

    return $log ;
}

sub checkDay
{
    my $ref = shift(@_) ;

    my $function = ( caller(0) )[3] ;
    $log->info ("$function") ;

    my @months    = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) ;
    my @nummonths = qw(01 02 03 04 05 06 07 08 09 10 11 12) ;
    my @weekDays  = qw(SUN MON TUE WED THU FRI SAT) ;
    my ( $second, $minute, $hours, $dayOfMonth, $months, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings ) =
      localtime() ;
    my $theTime = "$weekDays[$dayOfWeek]" ;
    return $theTime ;
}

sub Help
{
    print <<"EOF";
                       --[ $0 
                       --[ Write the formated file to .xslx 
                       --[ -f file name to read
                       --[   $0 -f 45564_Return-20141105170325.csv
                       --[ -n
                       --[   don't sends email                  
EOF
    exit(1) ;
}

sub getEnv
{
    my $file = shift(@_) ;

    my $function = ( caller(0) )[3] ;
    print "$function \n" ;

    unless ( -f $file ) {
        print "Could not find $file.\n" ;
        exit(1) ;
    }

    open( FILE, "< $file" ) ;
    while (<FILE>) {
        chomp ;
        next if /^\s*\#/ ;
        next unless /=/ ;
        my ( $key, $variable ) = split( /=/, $_, 2 ) ;
        $variable =~ s/\s+//g ;
        $key =~ s/\s+//g ;
        $ref->{config}->{$key} = $variable ;
    }
    close FILE ;

    if ( $ref->{TESTDB} ) {
        $ref->{CARD}->{SID}  = $ref->{config}->{CARDTESTSID} ;
        $ref->{CARD}->{SVER} = $ref->{config}->{CARDTESTSVER} ;
        $ref->{CARD}->{USER} = $ref->{config}->{CARDTESTUSER} ;
        $ref->{CARD}->{PASS} = $ref->{config}->{CARDTESTPASS} ;
        $ref->{CARD}->{PRT}  = $ref->{config}->{CARDTESTPRT} ;

        $ref->{PRISM}->{SID}  = $ref->{config}->{PRISMTESTSID} ;
        $ref->{PRISM}->{SVER} = $ref->{config}->{PRISMTESTSVER} ;
        $ref->{PRISM}->{USER} = $ref->{config}->{PRISMTESTUSER} ;
        $ref->{PRISM}->{PASS} = $ref->{config}->{PRISMTESTPASS} ;
        $ref->{PRISM}->{PRT}  = $ref->{config}->{PRISMTESTPRT} ;
    } else {
        $ref->{CARD}->{SID}  = $ref->{config}->{CARDSID} ;
        $ref->{CARD}->{SVER} = $ref->{config}->{CARDSVER} ;
        $ref->{CARD}->{USER} = $ref->{config}->{CARDUSER} ;
        $ref->{CARD}->{PASS} = $ref->{config}->{CARDPASS} ;
        $ref->{CARD}->{PRT}  = $ref->{config}->{CARDPRT} ;

        $ref->{PRISM}->{SID}  = $ref->{config}->{PRISMSID} ;
        $ref->{PRISM}->{SVER} = $ref->{config}->{PRISMSVER} ;
        $ref->{PRISM}->{USER} = $ref->{config}->{PRISMUSER} ;
        $ref->{PRISM}->{PASS} = $ref->{config}->{PRISMPASS} ;
        $ref->{PRISM}->{PRT}  = $ref->{config}->{PRISMPRT} ;
    }
}

sub getDate
{
    my $ref = shift(@_) ;
    my $me  = ( caller(0) )[3] ;
    print("$me \n") ;
    unless ($Date) {
        $Date = strftime ( '%Y%m%d', localtime ) ;
        $ref->{config}->{Date} = $Date ;
    }
}

sub getDateTime
{
    my $ref = shift(@_) ;
    my $me  = ( caller(0) )[3] ;
    print("$me \n") ;
    my $Date = strftime ( '%Y%m%d%H%M%S', localtime ) ;
    return $Date ;
}

sub changeDir
{
    my $dir = shift(@_) ;
    my $me  = ( caller(0) )[3] ;
    $log->info ("$me ") ;

    chdir($dir) ;

    $log->info ("Change dir to $dir") ;
}

sub getOptions
{
    my $ref = shift(@_) ;
    my $me  = ( caller(0) )[3] ;
    print("$me \n") ;

    GetOptions (
                 "Help"   => \$Help,
                 "h"      => \$Help,
                 "file=s" => \$file,
                 "f=s"    => \$file,
                 "b=s"    => \$BATCH_PREFIX,
                 "t"      => \$testDB,
                 "testDB" => \$testDB,
                 "n"      => \$noEmail,
               )    # flag
      or warn("Error in command line arguments &Help\n") ;
}

sub scriptName
{
    my $ref = shift(@_) ;
    my $me  = ( caller(0) )[3] ;
    print("$me \n") ;
    my $script = basename ($0) ;
    $script =~ s/\.pl// ;
    return $script ;
}

sub scriptFullName
{
    my $ref = shift(@_) ;
    my $me  = ( caller(0) )[3] ;
    print("$me \n") ;
    my $script = basename ($0) ;
    $script =~ s/\.\/// ;
    return $script ;
}

sub getLocalEnv
{
    my $ref = shift(@_) ;
    my $me  = ( caller(0) )[3] ;
    print("$me \n") ;

    my $env = $ENV{ENV} ;
    chomp($env) ;
    my $ENV = uc($env) ;
    $ref->{config}->{ENV} = $ENV ;
}

sub trim
{
    my $s = shift ;
    $s =~ s/^\s+|\s+$//g ;
    return $s ;
}