Finding and Drawing a blank...

Dev Shed Forums Sponsor:

September 10th, 2012, 08:43 AM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

Finding and Drawing a blank...

I have a script (duh) that looks at part of a file, line by line, and sees if there is white space in a place where there should be a future date. If there isn't a date set, it creates a set future date and outputs the info to a new file.

I have tried several things to get this to work. Reading the .clr file seems to be okay. Output to the .out file is exactly same thing that is in the .clr file. So no checking is occurring.

I am not a perl person but have been tasked to resolve this issue at work because this is something that we need for compliance at the college where I work at. So any help is greatly appreciated

Here is the script:

perl Code:

Original - perl Code

 
#!/opt/perl58/bin/perl
#look for blank Anticipated Graduation Dates in tape format (non-delimited)
#output for NSLC
#
 
open(FILE, @ARGV[0]) || warn "can't open file $!\n";
$i=0;
#while (read(FILE, $buf, 250)){
#   print "$buf\n";
#   $i++;
#   }
#print "there are $i records\n";
#exit;
############################### no record delimiters!!!!
#get header
read(FILE,$buf,250);
print $buf;
 
#start reading record at a time
#everything up 1-201 
while (read(FILE,$buf,201)){
    $i++;
    if ($buf =~ /^D./){
        print $buf;
        read(FILE, $agd,8);
        if ($agd eq "        " ){
            print "20180515";
            }
        else{
            print $agd;
            }
        read(FILE, $buf,41);
        print "$buf";
        }
    else{
    # This is the trailer, read everything else and print 
        print $buf;
        read(FILE, $buf, 49);
        print $buf;
        }
    }

Here are two sample records from the .clr file. If it has a date on the last column it should skip it. If it is blank then it should add a set future date (I placed the text in PHP tags to preserve the white space) :

Code:

D123456789John                  Doe                                                   H        1234 Some Road St                                           Some City           CA123451234               20140509123456789012345678901234NN               
D9876543216Jane                 Doe                                                   W201206054321 Another Road                                           Same City           CA12345                           098765432109876543210987NN

Each record should be 250 and the beginning of where it checks is 201

Last edited by ishnid : September 10th, 2012 at 12:57 PM. Reason: PHP tags can make a mess of Perl code

September 10th, 2012, 12:56 PM

Laurent_R

Contributing User

Join Date: Jun 2012

Posts: 511

Time spent in forums: 4 Days 19 h 58 m 22 sec
Reputation Power: 405

Hi,

you should probably not use the low-level read function for reading a text file. The read function is for reading binary data. Use a function that reads the file line bvy line.

You should do something like this (untested):

Code:

while (my $line = <FILE>) {
    chomp $line;
    if ($line =~ /^D\/) {
        if (substr ($line, 202) !~ /\d{8}/) {
            $line =~s /\s{8}$/20180515/;
        }
        print $line, "\n";
    }
    else { # ... processing header or footer
}

There are numerous other wrong things in your code. The $i variable is incremented but never used. You should declare your variables with my. You should use strict and use warnings. etc.

September 10th, 2012, 01:54 PM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

Thank you for your response I will take a look at it and see if what you posted works. I have never done anything in perl and this isn't even my code. I was just told to make it work. So here I am...

September 10th, 2012, 03:48 PM

Laurent_R

Contributing User

Join Date: Jun 2012

Posts: 511

Time spent in forums: 4 Days 19 h 58 m 22 sec
Reputation Power: 405

I must say that I am not being nice with you. I am telling you that you should rewrite your program differently, whereas it is not your program, it is a program you're just trying to improve.

Still, I think the program you've got is very poorly written, and I think it should be improved. If you are willing to follow my advice, I pledge I will continue to help you until it works properly (so long as life is with me).

And I think most people on this forum will agree with me that this program needs a complete overhaul.

So, it is up to you: are you willing to take the chance of trusting me? Do what I suggest. Why should you trust me? I don't claim I am an authority. I might make some mistakes. There may be a couple of iterations before the code gets really right, well, that's life.

The one thing I can tell you is that I have so far always succeeded to have Perl do what I wanted.

September 10th, 2012, 04:02 PM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

Like I said thank you for your assistance. I will try what you suggest. I would love to be able to sit down and spend all day looking and learning Perl but right now it just isn't going to happen. I have to trust in what you have written and see if it works. Its just running against a file so if it does something to that file oh well. I can use the backup. No big deal. If the code is sloppy I "have to trust you" that what you are saying is true. Regardless I do not write perl on a regular basis hence this is why I asked for assistance.

Quote:

Originally Posted by Laurent_R

September 11th, 2012, 06:23 AM

Laurent_R

Contributing User

Join Date: Jun 2012

Posts: 511

Time spent in forums: 4 Days 19 h 58 m 22 sec
Reputation Power: 405

It is usually not possible to read a file and write to it at the same time. So what you do, generally, is that you read from a file and write to another file. Then, when both files are closed, you can rename the original to, says, source.old et the output file to source.new, or whatever. The renaming can be done automatically (un the perl script) or manually after the execution of the script, depending on your needs.

The code I have suggested only replaces the while loop of the original perl script, since the rest probably works more or less OK.

September 11th, 2012, 06:55 AM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

Yeah all I am asking to be looked at is the while loop. That's the trouble area. There is a different output file and it is created at the cmd line when the script is ran. All that seems to be okay. Its just that the output content is exactly the same as the input content.

Quote:

Originally Posted by Laurent_R

September 11th, 2012, 08:39 AM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

Response

This is the output response that I got when trying to run the above script:

Backslash found where operator expected at ./clnnslc-test2.pl line 24, near "if (substr ($line, 202) !~ /\"
(Might be a runaway multi-line // string starting on line 23)
(Do you need to predeclare if?)
Backslash found where operator expected at ./clnnslc-test2.pl line 25, near "$line =~s /\"
(Might be a runaway multi-line // string starting on line 24)
(Missing operator before \?)
Bareword found where operator expected at ./clnnslc-test2.pl line 27, near "print $line"
(Might be a runaway multi-line $$ string starting on line 25)
(Do you need to predeclare print?)
syntax error at ./clnnslc-test2.pl line 24, near "if (substr ($line, 202) !~ /\"
syntax error at ./clnnslc-test2.pl line 25, near "$line =~s /\"
Execution of ./clnnslc-test2.pl aborted due to compilation errors.

September 11th, 2012, 09:37 AM

FishMonger

Contributing User

Dev Shed Intermediate (1500 - 1999 posts)

Join Date: Apr 2009

Posts: 1,652

Time spent in forums: 1 Month 2 Weeks 2 Days 6 h 21 sec
Reputation Power: 1170

There is a typo in this line causing a syntax error.

Code:

if ($line =~ /^D\/) {

It should be:

Code:

if ($line =~ /^\D/) {

If you still have problems after making that correction, then please post the complete script and error message so we can help with the troubleshooting.

Last edited by FishMonger : September 11th, 2012 at 09:40 AM.

#10

September 11th, 2012, 10:10 AM

Laurent_R

Contributing User

Join Date: Jun 2012

Posts: 511

Time spent in forums: 4 Days 19 h 58 m 22 sec
Reputation Power: 405

Actually not. It should be:

Code:

if ($line =~ /^D/) {

We're just looking dor a D at the begining of the line.

@ sdo3lg: I have sent you message.

#11

September 12th, 2012, 01:54 PM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

I made this change and I still get the same results where the output results are identical to the input results. Any other ideas/suggestions?

Quote:

Originally Posted by Laurent_R

Actually not. It should be:

Code:

if ($line =~ /^D/) {

We're just looking dor a D at the begining of the line.

@ sdo3lg: I have sent you message.

#12

September 12th, 2012, 07:04 PM

keath

!~ /m$/

Join Date: May 2004

Location: Reno, NV

Posts: 4,086

Time spent in forums: 2 Weeks 4 Days 6 h 59 m 11 sec
Reputation Power: 1809

You supplied the following example:

Code:

D123456789John                  Doe       
D9876543216Jane                 Doe

I would expect the first names to line up on the same column, but they are off by one. Is that a typo?

If you have a fixed column widths, just unpack and then repack the line. You could then check any column for data by name.

Code:

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my @fields = qw/id first last mi date1 address city st zip zip2 empty1 date2 ttn empty2/;
my $pattern = 'A10 A21 A54 A1 A8 A60 A20 A2 A5 A4 A15 A8 A26 A15';

while (<>) {
	my %row;
	@row{@fields} = unpack $pattern;
	$row{date2} = '_future_' unless $row{date2};
	#print Dumper \%row;
	my $string = pack $pattern, @row{@fields};
	print "$string\n";
}

That was based on the following data:

Code:

D123456789John                 Doe                                                   H        1234 Some Road St                                           Some City           CA123451234               20140509123456789012345678901234NN               
D987654321Jane                 Doe                                                   W201206054321 Another Road                                           Same City           CA12345                           098765432109876543210987NN

You can name every column, or if you only care about things starting from position 200, you could grab all the leading stuff with A200 for example.

#13

September 13th, 2012, 08:37 AM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

Nice catch! Yes it was a typo. My attempt at protecting the users personal information. So looks like the A## sets the column length? If so then I will have to go through and verify the actual lengths because the first one says 10 and it should be 11. That's if I am understanding it correctly.

Quote:

Originally Posted by keath

You supplied the following example:

Code:

D123456789John                  Doe       
D9876543216Jane                 Doe

Code:

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my @fields = qw/id first last mi date1 address city st zip zip2 empty1 date2 ttn empty2/;
my $pattern = 'A10 A21 A54 A1 A8 A60 A20 A2 A5 A4 A15 A8 A26 A15';

while (<>) {
	my %row;
	@row{@fields} = unpack $pattern;
	$row{date2} = '_future_' unless $row{date2};
	#print Dumper \%row;
	my $string = pack $pattern, @row{@fields};
	print "$string\n";
}

That was based on the following data:

Code:

D123456789John                 Doe                                                   H        1234 Some Road St                                           Some City           CA123451234               20140509123456789012345678901234NN               
D987654321Jane                 Doe                                                   W201206054321 Another Road                                           Same City           CA12345                           098765432109876543210987NN

You can name every column, or if you only care about things starting from position 200, you could grab all the leading stuff with A200 for example.

#14

September 13th, 2012, 09:18 AM

keath

!~ /m$/

Join Date: May 2004

Location: Reno, NV

Posts: 4,086

Time spent in forums: 2 Weeks 4 Days 6 h 59 m 11 sec
Reputation Power: 1809

Yes, that's the column length. Pack and unpack can treat the input in many ways, and the A is basically just text. Probably stands for ascii.

With a good text editor you can see the position you are in when you are at the beginning of the column. In Sublime Text it shows me the length of a selection also when I highlight the column. Comment out the print statement, and uncomment the Dumper line to see how well you have matched the column positions.

The only purpose of the hash, is to allow you to refer to the columns by names that you provide. It's entirely optional. You can just unpack and receive an array, which you then refer to the item by index instead of name.

You'll discover one of the great things about unpack, is that it automatically trims the trailing spaces from any column. But for that reason, it's necessary to pack the finished data using the same pattern, to get back to the original column widths.

#15

September 14th, 2012, 10:48 AM

sdo3lg

Registered User

Join Date: Sep 2012

Posts: 8

Time spent in forums: 1 h 50 m 9 sec
Reputation Power: 0

I got it!

After much research and with all your help I was able to piece together a script that gave me the desired results. Since I didn't know perl scripting I decided to dump the original script that they were using and just write out my own.

Code:

$filename = $ARGV[0];

open FILE,"<$filename" or die "Cannot read the file $filename: $!\n";

while($line = <FILE>)
{
        if ($line =~ /^D./)
                {
                my $beg = substr $line,0,201;
                my $agd = substr $line,201,8;
                my $las = substr $line,209;

                if ($agd =~ "        ")
                        {
                        $agd = "20180515"
                        }
                        print "$beg$agd$las";
                }
        else
                {
                print "$line";
                }
}

Please feel free to critique it as this is my first "real" perl script and attempt at perl of any sort. Any feedback on it would be appreciated!

Last edited by sdo3lg : September 14th, 2012 at 03:46 PM. Reason: Left off the first line of code, whoops.

Finding and Drawing a blank...

Developer Shed Advertisers and Affiliates