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

Hi Monks,

This is a continuation from Re^3: Text Massage.

What is the meaning of the following code?
Would you place # comments at the end of each line.
When I run the script, the output files are empty.

#!/usr/bin/perl -w
use strict;
$| =1;

my $curve1_out = 'curve1.out';
my $curve2_out = 'curve2.out';
my $in ='curve12.data';

open (IN,     '<', $in)         or die "cannot open $in $!";
open (my $c1, '>', $curve1_out) or die "cannot open $curve1_out $!";
open (my $c2, '>', $curve2_out) or die "cannot open $curve2_out $!";

while (<IN>)
{
   if (/^Curve(\d):/.../^\s*$/)
   {
     if (defined($1) && $1==1 && /^\d/) {print $c1 "$_\n";};
     if (defined($1) && $1==2 && /^\d/) {print $c2 "$_\n"};
   }
}

[download]

Replies are listed 'Best First'.
Re: # Translation
by toolic (Bishop) on Apr 09, 2009 at 17:17 UTC
[reply]
Re: # Translation
by jwkrahn (Abbot) on Apr 09, 2009 at 17:57 UTC 
    while (<IN>)
{

    [download]

    Read the file 'curve12.data' line by line and put the current line in the $_ variable. 

       if (/^Curve(\d):/.../^\s*$/)
   {

    [download]

    Look for a block of text that starts with the line matching /^Curve(\d):/ and ends with the line matching /^\s*$/ and store a single numerical digit between 'Curve' and ':' in the $1 variable. 

         if (defined($1) && $1==1 && /^\d/) {print $c1 "$_\n";};
     if (defined($1) && $1==2 && /^\d/) {print $c2 "$_\n"};

    [download]

    If $1 is defined, which it always is because we wouldn't get here unless (\d) matched, and $1 is equal to one and the current line starts with a numerical digit then print the current line with an additional trailing newline to the file 'curve1.out'.   Also, if $1 is equal to two then print the current line with an additional trailing newline to the file 'curve2.out'.

    Could also be written as: 

    #!/usr/bin/perl
use warnings;
use strict;


my %out = map {
    my $name = "curve$_.out";
    open my $FH, '>', $name or die "cannot open $name $!";
    $_ => $FH;
    } 1, 2;

my $in ='curve12.data';
open my $IN, '<', $in or die "cannot open $in $!";

while ( <$IN> ) {
    if ( /^Curve(\d):/ .. /^\s*$/ ) {
        next unless /^\d/;
        exists $out{ $1 } and print { $out{ $1 } } "$_\n";
    }
}

    [download]
[reply]
[d/l]
[select]
Re: # Translation
by bichonfrise74 (Vicar) on Apr 09, 2009 at 19:24 UTC
    Most people here would appreciate it if you show some effort in trying to solve your problem. In this case, it looks like you even did not read some beginner Perl books.
[reply]
Re: # Translation
by JavaFan (Canon) on Apr 09, 2009 at 17:04 UTC
    What is the meaning of the following code?
    Beats me. I don't think the if()s surrounding the prints is ever true (but I haven't tried it), so my guess is that the code generates two empty files.
    Would you place # comments at the end of each line.
    No.
[reply]
      use strict;
use warnings;
use strict;

while (<DATA>)
{
   if (/^Curve(\d):/.../^\s*$/)
   {
     if (defined($1) && $1==1 && /^\d/) {print "C1: $_\n";};
     if (defined($1) && $1==2 && /^\d/) {print "C2: $_\n"};
   }
}

__DATA__
Curve1:
123, 456
   end 123

Curve2:
789, 101
   end 123

      [download]

      Prints:

      C1: 123, 456

C2: 789, 101

      [download]

      Using $1 etc after a failed match is generally an error, but not in this case. The fact that $1 is not reset is relied on by the code.

      True laziness is hard work
[reply]
[d/l]
[select]
Re: # Translation
by codeacrobat (Chaplain) on Apr 10, 2009 at 06:42 UTC
    The second match in the flipflop operator /startpat/ ... /endpat/ destroys the captured Number ($1) of the left side. Consider these shell snippets. 
    # no regex in end pattern of flipflop
$ echo "Curve4 " | perl -lne 'if (/Curve(\d+)/ ... eof) {print $1}'
4

# code similar to your example
$ echo "Curve4 " | perl -lne 'if (/Curve(\d+)/ ... /^\s*/) {print $1}'

    [download]
    print+qq(\L@{[ref\&@]}@{['@'x7^'!#2/"!4']});
[reply]
[d/l]
[select]
Re: # Translation
by Anonymous Monk on Apr 10, 2009 at 06:09 UTC
[reply]

Back to Seekers of Perl Wisdom