#!/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->());