To print the file in spool with the new format of input file also

skr302 has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I am totally new to Perl and this is my first post. Currently i have a perl script which takes the files with a fixed format and prints it to restricted spools. If the file name is not standard then it sends them to Unhandled folder. Also, it uses the filename to determine the folder they go to. Currenty it will process a sample file which is in standard format like:

 
ISSU------__DCR2?DC???_YYYYMMDD_HHMMSS_USER-ID---_nnnnnnnn.???
ISSU------__??????????_YYYYMMDD_HHMMSS_USER-ID---_nnnnnnnn.??? 
ISSU------ denotes - 4 character Issuer code
[download]

and the output .DAT and .RPT file will be generated in a particular folder like below:

 
ABC-_DCR2FDCGBP_20151014_093010_ABCFBTEST3_00000000.DAT 
ABC-_DCR2FDCGBP_20151014_093010_ABCFBTEST3_00000000.RPT
[download]

Now, the requirement is to modify the perl script to take the file of the below format also in addition with the existing format:

ISSU------__CQB???_YYMMDD_HHMMSS_---.??? 
Name of a sample file: 
ABC-_BOANZD_151013034247_589.TXT
[download]

Format is like: ==================

Issuer code - 4 characters 
Underscore 
Bank id - Always CQB ( 3 characters) 
Currency code - for example AUD, NZD etc for autralian dollar, new zea
+land dollar etc 
Underscore 
Date - in YYMMDD format - 6 digit date 
Time - in hhmmss format - 6 digit time 
Underscore 
File counter - 3 digits file counter or sequence 
Dot 
Extension - 3 digit (it should be TXT)
[download]

Can some please send me the modified code. I am attaching the current code

#*********************************************************************
+**********
#  Report Title    : sample file
#*********************************************************************
+**********

$PROG = $0;

use Env qw(SPOOL_LOC);

@Args = @ARGV ;

# Define Subroutines
sub logfile
{
    my ($lineno) = @_[0] ;
    my ($logmsg) = @_[1] ;
    $syscmd = "perl " . $SPOOL_LOC . $delimiter . "spool_logs.pl $SPOO
+L_LOC" . $delimiter . "logs $spool_name \"Success\" $origname $lineno
+ \"" . $logmsg . "\"";
    system($syscmd);
}

sub abort
{
    my ($lineno) = @_[0] ;
    my ($logmsg) = @_[1] ;
    print __LINE__,"$PROG: @_\n";
    $syscmd = "perl " . $SPOOL_LOC . $delimiter . "spool_logs.pl $SPOO
+L_LOC" . $delimiter . "logs $spool_name \"Failed\" $origname $lineno 
+\"" . $logmsg . "\"";
    system($syscmd);
    exit 1;
}

# Get the filename from the args
$filename = shift;
$origname = $filename;

($exportlocn,$exportfile) = $filename =~ m|^(.*[/\\])([^/\\]+?)$|;

# set the OS delimiter
if ($^O eq "MSWin32") {
    $delimiter='\\';
}
elsif ($^O eq "linux") {
    $delimiter='/';
}
else {
    $delimiter='/';
}

if ($delimiter eq "/") {
    @script_bits = split(/\//, $PROG);
}
else {
    @script_bits = split(/\\/, $PROG);
}

@spool_bits = split(/\./,@script_bits[-1]);
$spool_name = @spool_bits[0];
$spool_name =~ tr/[a-z]/[A-Z]/;

print __LINE__,"\n\nSpool ** $spool_name ** is processing file $filena
+me.\n\n";
print __LINE__,"\nOperating System is: $^O\n\n";

# Must have 1 arg.
@Args == 1 || @Args == 2
    or abort __LINE__,"expected 1 or 2 arguments";

$ENV_NAME = join( ',' , $script_bits[-2]) ;

# Configuration constants.

@UNZIP =    qw (gzip);
@PRINT =    qw (print);
@MOVE =        qw (move);
@COPY =        qw (copy);
@PRIVS =    qw (icacls);

if ($delimiter eq "/") {
    @UNZIP =    qw (gzip);
    @PRINT =    qw (lp);
    @MOVE =        qw (mv);
    @COPY =        qw (cp);
}

$ROOTSYS =    "D:\\LMS\\output\\" . $ENV_NAME . "\\sydrpm";

if ($ENV_NAME eq "prd") {
    $ROOTSYS =    "\\\\sydrpm\\spool\$";
    if ($delimiter eq "/") {
        $ROOTSYS =    "/mnt/smb/lms-au/sydrpm/spool\$";
    }
}
else {
    if ($delimiter eq "/") {
        $ROOTSYS =    "/mnt/smb/lms-au/lmshbdv06/LMS/output/" . $ENV_N
+AME . "/sydrpm";
    }
}

$SMPLDIR =    $ROOTSYS . $delimiter . "bnerpm" ;

# Check and create default directories
-d $ROOTSYS
    or mkdir $ROOTSYS, 0777
        or abort __LINE__,"failed to make spool directory '$ROOTSYS'."
+;

-d $SMPLDIR
    or mkdir $SMPLDIR, 0777
        or abort __LINE__,"failed to make spool directory '$SMPLDIR'."
+;

$ROOTDIR        =    $SMPLDIR . $delimiter . "Restricted";
$CA_FILE        =    "CA_Files";
$BANKFILE        =    "Bankfiles";

$DUPDIR            =    $SMPLDIR . $delimiter . "duplicate";

$UNHANDLED        =    $SMPLDIR . $delimiter . "unhandled";

# Main.


# Get current Time
($SEC, $MIN, $HOUR, $DAY, $MON, $YEAR) = localtime;

# increment the month (0-11)
$MON++;

# Calc YYYY Year
$YEAR += 1900;

# Prep duplicate file extension

$dupe_extn = sprintf ("-%02d-%02d-%02d_%02d-%02d-%04d", $HOUR, $MIN, $
+SEC, $DAY, $MON, $YEAR) ;

# Check and create default directories
-d $ROOTDIR
    or mkdir $ROOTDIR, 0777
        or abort __LINE__,"failed to make Restricted directory '$ROOTD
+IR'.";

-d $DUPDIR
    or mkdir $DUPDIR, 0777
        or abort __LINE__,"failed to make duplicate directory '$DUPDIR
+'.";

-d $UNHANDLED
    or mkdir $UNHANDLED, 0777
        or abort __LINE__,"failed to make unhandled directory '$UNHAND
+LED'.";

# Check if the filename exists
-f $filename
    or abort __LINE__,"$filename does not exist";

# Get the Printer from the second arg
#($printer) = @ARGV;

# remove "\" or "/" from filename
if ($delimiter eq "/") {
    ($basename = $filename) =~ s/.*\///;
}
else {
    ($basename = $filename) =~ s/.*\\//;
}

#
# Care needs to be taken as the full file name (containing the path) i
+s
# sent to the RPM server.
#

# Validate Filename Structure
unless ($basename =~ /^(.{4}|.{10})_(.{10})_(.{8})_(.{6})_(.{10})_(.{8
+})\.(.{3})(\.gz)?$/) {
    if ((system @COPY, $filename, sprintf "%s%s%s%s", $UNHANDLED, $del
+imiter, $basename, $dupe_extn) == 0) {
        abort __LINE__,"bad filename '$filename', moved to unhandled d
+irectory";
    }
    else {
        abort __LINE__,"failed to move unhandled file '$filename'!";
    }
}
else {
    #
    # File Name Format Fits
    #
    ($issuercode, $outputname, $date, $time, $userid, $sequenceno, $fi
+letype) =
        ($1, $2, $3, $4, $5, $6, $7);
}


# Validate the Issuer Code (Fund Manager)
$issuercode =~ s/^([A-Za-z0-9]+)-*/$1/i
    or abort __LINE__,"filename '$basename': bad issuer code '$issuerc
+ode'";

# Uppercase the Issuer
$issuercode =~ tr/[a-z]/[A-Z]/;

# Uppercase the Output Name
$outputname =~ tr/[a-z]/[A-Z]/;

# Validate the Report
$outputname =~ s/^(\w+)*/$1/i
    or abort __LINE__,"filename '$basename': bad output name '$outputn
+ame'";


$CA_FILE_DIR = $ROOTDIR . $delimiter . $CA_FILE;
$BANKFILEDIR = $ROOTDIR . $delimiter . $BANKFILE;


$FileType = 1;

if ($outputname =~ /(DCR2).(DC).*$/) {
    $FileType = 2;
}

-d $CA_FILE_DIR
    or mkdir $CA_FILE_DIR, 0777
        or abort __LINE__,"failed to make directory '$CA_FILE_DIR'.";

-d $BANKFILEDIR
    or mkdir $BANKFILEDIR, 0777
        or abort __LINE__,"failed to make directory '$BANKFILEDIR'.";

$date =~ /^\d{8}$/
    or abort __LINE__,"filename '$basename': bad date '$date'";

$sdate = substr $date, 0, 6;

$time =~ /^\d{6}$/
    or abort __LINE__,"filename '$basename': bad time '$time'";

$userid =~ s/^([A-Za-z0-9]+)-*/$1/i
    or abort __LINE__,"filename '$basename': bad userid '$userid'";

$sequenceno =~ /^\d{8}$/
    or abort __LINE__,"filename '$basename': bad sequence number '$seq
+uenceno'";


$filetype =~ /^[a-z]{3}$/i
    or abort __LINE__,"filename '$basename': bad file type '$filetype'
+";

#
# Create the Issuer Directory
#

$issuerdir   = $CA_FILE_DIR . $delimiter . $issuercode;
$dateDir     = $issuerdir . $delimiter . $sdate ;

-d $issuerdir
    or mkdir $issuerdir, 0777
        or abort __LINE__,"failed to make directory '$issuerdir'.";

# Create the  if it does not exist
-d $dateDir
    or mkdir $dateDir, 0777
        or abort __LINE__,"failed to make directory '$dateDir'.";

$BankIssuerDir   = $BANKFILEDIR . $delimiter . $issuercode;
$BankDateDir     = $BankIssuerDir . $delimiter . $sdate ;

if ($FileType == 2) {
-d $BankIssuerDir
    or mkdir $BankIssuerDir, 0777
        or abort __LINE__,"failed to make directory '$BankIssuerDir'."
+;

# Create the  if it does not exist
-d $BankDateDir
    or mkdir $BankDateDir, 0777
        or abort __LINE__,"failed to make directory '$BankDateDir'.";
}


$Unzipfile = 1 ;

$filename =~ /^.+\.gz$/
    or $Unzipfile = 0 ;

$filename =~ s/\.gz$//i;
$exportfile =~ s/\.gz$//i;

$basename =~ s/\.gz//i;

$movename = $basename;

$movelocn     = $dateDir . $delimiter . $movename ;
$BankCopyLocn = $BankDateDir . $delimiter . $movename ;

#
# unzip the file
#

if ($Unzipfile == 1) {
    ! -f $filename
        or unlink $filename
            or abort __LINE__,"could not unlink '$filename'.";

    (system "@UNZIP -d < $filename.gz > $filename") == 0
        or abort __LINE__,"unzip of $filename failed!";
}

#if (defined $printer) {
#    (system @PRINT, $filename) == 0
#        or print __LINE__,"warning: failed to print $filename\n";
#}


if ($FileType == 2) {
    if (! -f "$BankCopyLocn") {    
        (system @COPY, $filename, $BankCopyLocn) == 0
            or abort __LINE__,"copy $filename to $BankCopyLocn failed.
+";
        logfile __LINE__,"copied $filename to $BankCopyLocn.";
        if ($^O eq "MSWin32") {
            (system @PRIVS, "$BankDateDir$delimiter$exportfile","/rese
+t") == 0
                or abort __LINE__,"Inheritance reset for $exportfile i
+n $BankDateDir failed.";
        }
    }
}

if (! -f "$movelocn") {    
    if ($Unzipfile == 1) {
        (system @MOVE, $filename, $movelocn) == 0
            or abort __LINE__,"move $filename to $movelocn failed.";
        logfile __LINE__,"moved $filename to $movelocn.";
        if ($^O eq "MSWin32") {
            (system @PRIVS, "$dateDir$delimiter$exportfile","/reset") 
+== 0
                or abort __LINE__,"Inheritance reset for $exportfile i
+n $dateDir failed.";
        }
    }
    else {
        (system @COPY, $filename, $movelocn) == 0
            or abort __LINE__,"copy $filename to $movelocn failed.";
        logfile __LINE__,"copied $filename to $movelocn.";
        if ($^O eq "MSWin32") {
            (system @PRIVS, "$dateDir$delimiter$exportfile","/reset") 
+== 0
                or abort __LINE__,"Inheritance reset for $exportfile i
+n $dateDir failed.";
        }
    }
}
else {
    print __LINE__,"warning: '$basename' already exists in $dateDir, m
+oving $filename to duplicate directory\n";
    if ($Unzipfile == 1) {
        (system @MOVE, $filename, sprintf "%s%s%s%s", $DUPDIR, $delimi
+ter, $basename, $dupe_extn) == 0
            or abort __LINE__,"move of $filename failed.";
        logfile __LINE__,"warning: '$basename' already exists in $date
+Dir, moving $filename to duplicate directory";
        if ($^O eq "MSWin32") {
            (system @PRIVS, "$DUPDIR$delimiter$exportfile$dupe_extn","
+/reset") == 0
                or abort __LINE__,"Inheritance reset for $exportfile$d
+upe_extn in $DUPDIR failed.";
        }
    }
    else {
        (system @COPY, $filename, sprintf "%s%s%s%s", $DUPDIR, $delimi
+ter, $basename, $dupe_extn) == 0
            or abort __LINE__,"copy of $filename failed.";
        logfile __LINE__,"warning: '$basename' already exists in $date
+Dir, copying $filename to duplicate directory";
        if ($^O eq "MSWin32") {
            (system @PRIVS, "$DUPDIR$delimiter$exportfile$dupe_extn","
+/reset") == 0
                or abort __LINE__,"Inheritance reset for $exportfile$d
+upe_extn in $DUPDIR failed.";
        }
    }
}

# Is this needed, file should eb left in the temp location and cleaned
+ up in a couple of days.
#! -f "$filename.gz"
#    or unlink "$filename.gz"
#        or abort __LINE__,"could not unlink '$filename.gz'.";
[download]

Comment on To print the file in spool with the new format of input file also Select or Download Code

Replies are listed 'Best First'.
Re: To print the file in spool with the new format of input file also by GotToBTru (Prior) on Oct 14, 2015 at 19:50 UTC
It looks like line 165 is meant to recognize a valid filename and breaks up $basename into components, and in line 177 those components are named and stored in 7 variables. You could come up with a second regular expression to recognize and decompose the new filename format into those same 7 variables. But if these are truly fixed length and format file names, you might find it easier to use unpack or substr instead of regular expressions for this purpose. It is said that the man who tries to solve his problem with a regular expression now has two problems, and that applies especially for the new programmer. When they work, they can do amazing things. But if you don't really need them, you can save yourself some grief. Dum Spiro Spero	[reply]
Re^2: To print the file in spool with the new format of input file also by flexvault (Monsignor) on Oct 14, 2015 at 23:33 UTC
GotToBTru, ++ Well done and well said...Ed Regards...Ed "Well done is better than well said." - Benjamin Franklin	[reply]
Re^2: To print the file in spool with the new format of input file also by skr302 (Initiate) on Oct 15, 2015 at 04:38 UTC
Hi, I am new to PErl. Can you please modify this script and update if you dont mind. Actually i have not written even a single perl script.	[reply]
Re^3: To print the file in spool with the new format of input file also by GotToBTru (Prior) on Oct 15, 2015 at 12:44 UTC
Actually i have not written even a single perl script. So said every monk ever. There's always a first time! Dum Spiro Spero	[reply]
Re^3: To print the file in spool with the new format of input file also by skr302 (Initiate) on Oct 15, 2015 at 05:02 UTC
Can some one please explain me what is happening here? # # Care needs to be taken as the full file name (containing the path) i +s # sent to the RPM server. # # Validate Filename Structure unless ($basename =~ /^(.{4}\|.{10})_(.{10})_(.{8})_(.{6})_(.{10})_(.{8 +})\.(.{3})(\.gz)?$/) { if ((system @COPY, $filename, sprintf "%s%s%s%s", $UNHANDLED, $del +imiter, $basename, $dupe_extn) == 0) { abort __LINE__,"bad filename '$filename', moved to unhandled d +irectory"; } else { abort __LINE__,"failed to move unhandled file '$filename'!"; } } else { # # File Name Format Fits # ($issuercode, $outputname, $date, $time, $userid, $sequenceno, $fi +letype) = ($1, $2, $3, $4, $5, $6, $7); } [download] what is unless ($basename= .............is doing?	[reply] [d/l]
Re^4: To print the file in spool with the new format of input file also by AppleFritter (Vicar) on Oct 15, 2015 at 10:34 UTC
Re^4: To print the file in spool with the new format of input file also by Laurent_R (Canon) on Oct 15, 2015 at 08:47 UTC
Re^4: To print the file in spool with the new format of input file also by soonix (Canon) on Oct 15, 2015 at 14:18 UTC


Pathologically Eclectic Rubbish Lister
	PerlMonks