package List::Merger;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(gen_merger);
use strict;
use warnings;
use List::Util 'first';
our $VERSION = '0.01';
sub gen_merger {
my ($list, $fetch, $compare, $finish) = @_;
my @item = map $fetch->($_), @$list;
my $done;
return sub {
return $finish if $done;
my $idx = first {$item[$_] ne $finish} 0 .. $#item;
my $next = $item[$idx];
for ($idx + 1 .. $#item) {
next if $item[$_] eq $finish;
my $result = $compare->($next, $item[$_]);
$next = $item[$_] if $result == 1;
}
$item[$idx] = $fetch->($list->[$idx]);
$done = 1 if ! first {$item[$_] ne $finish} $idx .. $#item;
return $next;
};
}
####
my $finish = 'A val that is guaranteed not to be present in any list';
my @list = (\@arr1, \@arr2, \@arr3, \@arr4, \@arr5);
my $fetch = sub {
my $item = shift @_;
return $finish if ! $@item;
return shift $@item;
};
my $compare = sub {
my ($item1, $item2) = @_;
return uc($item1) cmp uc($item2);
}
my $next = gen_merger(\@list, $fetch, $compare, $finish);
while (1) {
my $item = $next->();
last if defined $item && $item eq $finish;
print "$item\n";
}
####
my $finish = 'A val that is guaranteed not to be present in any list';
my @list = ($fh1, $fh2, $fh3, $fh4, $fh5);
my $fetch = sub {
my $fh = shift @_;
return $finish if eof $fh;
return scalar <$fh>;
};
my $compare = sub {
my ($line1, $line2) = @_;
my ($stamp1) = $line1 =~ /^(\d+)/;
my ($stamp2) = $line2 =~ /^(\d+)/;
return $stamp1 <=> $stamp2;
}
my $next = gen_merger(\@list, $fetch, $compare, $finish);
while (1) {
my $item = $next->();
last if defined $item && $item eq $finish;
print "$item\n";
}