[oak perl] Perl Script

[David Fetter]

On Thu, Jun 16, 2005 at 02:37:03AM -0700, kenneth Jideofor wrote:
> Hi George,
> 
> Good reading from you.
> It's my pleasure having my name in your mailing list.
> 
> I believe this is a very good opportunity for me to
> develop my self on Perl.
> I look forward to getting what it takes to become a
> Perl guru from the group.
> 
> Meanwhile, I have this task to perform and I believe
> Perl will offer me a better solution to accomplishing
> it.
> 
> I have tried doing it with an awk script but I
> couldn't get exactly what I wanted.
> I need an assistance on how to go about it with Perl
> script.
> 
> I have a file (FILE1)made up of two columns of data.

> Column 1 contains numbers while Column 2 contains
> letters. FILE1 is as shown below:
> 
> FILE1:
> __________________
> 7240185	A
> 	B
> 	C
> 7240943	C
> 7240207	A
> 	B
> 7240194	B
> 	C
> 7240190	A
> 	B
> 	C
> ____________________
> 
> I need to produce two files (FILE2 and FILE3)from
> FILE1 based on the following conditions:
> 
> Each number in Column 1 is expected to have
> corresponding letters A, B, and C in Column 2. I need
> to print out to FILE2 all the numbers that do not have
> their corresponding letters A, B, and C, while those
> that have their corresponding letters A, B, and C
> should be saved in FILE3.
> 
> >From FILE1, the following numbers
> do not have their corresponding letters A, B, and C:
> 
> 7240943
> 7240207
> 7240194
> 
> while the following numbers have their corresponding
> letters A, B, and C
> 
> 7240185
> 7240190
> 
> Hence, FILE2 should contain the following numbers:
> 
> 7240943
> 7240207
> 7240194
> 
> while FILE3 should contain the following numbers:
> 
> 7240185
> 7240190
> 
> Could anyone, please, assist me with a Perl solution
> to perform this task?

The columns in FILE1 are separated by tabs, so this makes parsing
unambiguous :)

Warning: untest code ahead.

my ($file1, $file2, $file3);
my ($data, $current_num);
open $file1, '<', 'FILE1'
    or die "Can't open FILE1 for reading: $!";
while(<$file1>) {
    m/^(\d*)\t(.*)/;
    $current_num = $1 if $1 =~ /^\d+$/;
    if ($current_num !~ /^\d+$/) {
        close $file1;
        die "Malformed file: no current number.\n"
    }
    push @{ $data->{$curren_num} }, $2;
}
close $file1;
open $file2, '>', 'FILE2'
    or die "Can't open FILE2 for writing: $!";
open $file3, '>', 'FILE3'
    or die "Can't open FILE3 for writing: $!";
foreach my $key (sort keys %$data) {
    if ( ('A','B','C') eq sort @{$data->{$key}}) {
        print $file2 "$key\n";
    } else {
        print $file3 "$key\n";
    }
}
close $file2;
close $file3;

Cheers,
D
-- 
David Fetter david at fetter.org http://fetter.org/
phone: +1 510 893 6100   mobile: +1 415 235 3778

Remember to vote!