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"; }