#!/usr/bin/env perl

use Modern::Perl;
use Data::Dump qw(pp);

my ($foo, $bar) = ("abcdef", "abdfec");

sub pop_char {
    my @chars;
    { no warnings; @chars = map { split '' } @_; }
    return sub { return shift @chars; }
}

sub cmp_str {
    my ($i, $s1, $s2) = (0, @_);
    $s1 = pop_char $s1 if not ref $s1;
    $s2 = pop_char $s2 if not ref $s2;
    return sub {
        no warnings;
        my ($c1, $c2) = ($s1->(), $s2->());
        return ($c1 or $c2) ? [ $i++, $c1 cmp $c2, $c1, $c2 ] : undef;
    }
}

my ($cmp_foo_bar, $cmp_char);

say "\nNull case: both strings empty";
$cmp_foo_bar = cmp_str;
say pp $cmp_char while defined ($cmp_char = $cmp_foo_bar->());

say "\nSecond string null";
$cmp_foo_bar = cmp_str $foo;
say pp $cmp_char while defined ($cmp_char = $cmp_foo_bar->());

say "\nFirst string null";
$cmp_foo_bar = cmp_str '', $bar;
say pp $cmp_char while defined ($cmp_char = $cmp_foo_bar->());

$cmp_foo_bar = cmp_str $foo, $bar;
say "\nBoth strings same length";
say pp $cmp_char while defined ($cmp_char = $cmp_foo_bar->());

$cmp_foo_bar = cmp_str $foo.$bar, $bar;
say "\nFirst string longer";
say pp $cmp_char while defined ($cmp_char = $cmp_foo_bar->());

exit;

$cmp_foo_bar = cmp_str $foo.$bar, sub { return 'A'; };
say "\nBoth strings against infinite A's";
say pp $cmp_char while defined ($cmp_char = $cmp_foo_bar->());

##</code><code>##


Null case: both strings empty

Second string null
[0, 1, "a", undef]
[1, 1, "b", undef]
[2, 1, "c", undef]
[3, 1, "d", undef]
[4, 1, "e", undef]
[5, 1, "f", undef]

First string null
[0, -1, undef, "a"]
[1, -1, undef, "b"]
[2, -1, undef, "d"]
[3, -1, undef, "f"]
[4, -1, undef, "e"]
[5, -1, undef, "c"]

Both strings same length
[0, 0, "a", "a"]
[1, 0, "b", "b"]
[2, -1, "c", "d"]
[3, -1, "d", "f"]
[4, 0, "e", "e"]
[5, 1, "f", "c"]

First string longer
[0, 0, "a", "a"]
[1, 0, "b", "b"]
[2, -1, "c", "d"]
[3, -1, "d", "f"]
[4, 0, "e", "e"]
[5, 1, "f", "c"]
[6, 1, "a", undef]
[7, 1, "b", undef]
[8, 1, "d", undef]
[9, 1, "f", undef]
[10, 1, "e", undef]
[11, 1, "c", undef]