One example of this is an app I had to do some time ago that filtered a file following user given constraints. To simplify the case, let's imagine we have a textfile with names of students followed by a qualification. We'd like to do some data managing on them. For example, get the average qualification of all students that passed.
In my case, I couldn't keep everything in memory, As I had to parse multiline objects in a 2Gb file, so I had to filter them "á lá" File::Find.
Here's the basic (simplifyed) code.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use warnings; | |
use List::Util qw(sum); | |
sub foreachLine { | |
my ($const, $finalize) = @_; | |
while (<DATA>) { | |
$const->($_); | |
} | |
$finalize->(); | |
} | |
{ | |
#closure | |
my @keep; | |
sub constrain { | |
my $student = shift; # gets a line like "Raimon Grau 6.4" | |
my ($qualif) = $student =~ m/ ([^ ]*)$/; | |
push @keep, $student if ($qualif > 5); | |
} | |
sub end_do { | |
my @a = map{ | |
my ($qualif) = m/ ([^ ]*)$/; | |
$qualif | |
} @keep; | |
print sum(@a)/@a , "\n"; | |
} | |
} | |
foreachLine(\&constrain , \&end_do); | |
__DATA__ | |
foo 6.3 | |
bar 4.3 | |
baz 8.3 | |
quux 8.3 |
What if we wanted to change the condition based on a parameter? I thought of two different approaches, one being more clear on the code side, and the other being more robust.
One option would be getting the parameter before the closure. That way, the constraint function will be able to access the $par variable. This option works, and the code does not get much affected. On the other side, The code becomes flaky in the extensibility side. Changing the location of the closure makes the program fail. Using global variables this way isn't really nice either.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use warnings; | |
use List::Util qw(sum); | |
my $par = shift; | |
sub foreachLine { | |
my ($const, $finalize) = @_; | |
while (<DATA>) { | |
$const->($_); | |
} | |
$finalize->(); | |
} | |
{ | |
#closure | |
my @keep; | |
sub constrain { | |
my $student = shift; # gets a line like "Raimon Grau 6.4" | |
my ($qualif) = $student =~ m/ ([^ ]*)$/; | |
push @keep, $student if ($qualif > $par); | |
} | |
sub end_do { | |
my @a = map{ | |
my ($qualif) = m/ ([^ ]*)$/; | |
$qualif | |
} @keep; | |
print sum(@a)/@a , "\n"; | |
} | |
} | |
foreachLine(\&constrain , \&end_do); | |
__DATA__ | |
foo 6.3 | |
bar 4.3 | |
baz 8.3 | |
quux 8.3 |
Last way I tried is making a higher order function that generates the constrain function. It ressembles some kind of currying. Well, here's the code.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use warnings; | |
use List::Util qw(sum); | |
sub foreachLine { | |
my ($const, $finalize) = @_; | |
while (<DATA>) { | |
$const->($_); | |
} | |
$finalize->(); | |
} | |
{ | |
#closure | |
my @keep; | |
sub gen_fun { | |
my $par = shift; | |
my $k = \@keep; | |
return sub { | |
my $student = shift; # gets a line like "Raimon Grau 6.4" | |
my ($qualif) = $student =~ m/ ([^ ]*)$/; | |
push @$k, $student if ($qualif > $par); | |
} | |
} | |
sub end_do { | |
print "@keep\n"; | |
my @a = map{ | |
my ($qualif) = m/ ([^ ]*)$/; | |
$qualif | |
} @keep; | |
print sum(@a)/@a , "\n"; | |
} | |
} | |
my $a = gen_fun(shift); | |
foreachLine($a , \&end_do); | |
__DATA__ | |
foo 6.3 | |
bar 4.3 | |
baz 8.3 | |
quux 8.3 |
The'@keep' juggling isn't needed on newer perl versions, but you'll need it in perl 5.8.8 .
Dear lazyweb, do you have any preference for one or other technique? Is there another trick to use in this case that could help me?
Here's a bit of help on 'variable X will not stay shared' warning.
Bye