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]

In reply to To print the file in spool with the new format of input file also by skr302

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.