Belden

At a previous employer, one of the things I ran into from time to time was the need to get the keys of a hash back out in the same order they were provided. Yes, Tie::IxHash exists to solve this problem: but it always felt like a heavy-weight solution to a simple problem. Why bother adding a new dependency to the system when I could just swap my %hash out for a @hashlike array?

    my @hashlike = (1..10);    # generally the return value of a subroutine

    while (my ($k, $v) = splice @hashlike, 0, 2) {

        ...  # do something with $k, $v

    }

This has the possibly undesired side effect of destroying @hashlike; by the time the loop is done, @hashlike is empty. As far as processing tuples in some orderly fashion it works pretty well though.

Recently while tidying up Hash::MostUtils for CPAN, I realized that the functions lkeys() and lvalues() [which return the "keys" and "values" of a list, respectively] were missing a companion: leach(). Since I work best with tests to guide me, I wrote one for leach():

    my @hashlike = (1..10);
    my @collected;

    while (my ($k, $v) = leach @hashlike) {

        push @collected, $k, $v;

    }

    is_deeply( \@collected, [1..10], 'collected all tuples' );

    is_deeply( \@hashlike, \@collected, 'did not destroy @hashlike' );

And here's what leach() looks like:

    {
        my %end;

        sub leach (+) {

            my $data = shift;

            my $ident = "$data";

            my $n = 2;

            return () if $#{$data} < ($end{$ident} || 0);

            $end{$ident} += $n;

            return @{$data}[$end{$ident} - $n .. $end{$ident} - 1];

        }

    }

The protoype '(+)' is the interesting bit of this implementation; it comes straight from splice():

    blyman@blyman-lt:~$ perl -de 1
      DB<1> p prototype 'CORE::splice'
    0  '+;$$@'

I guessed that the '+' meant something like, 'Make this thingy into a reference and let me deal with that reference', and indeed that's how it behaves. The next morning I pushed my repo from my laptop, pulled on my desktop, and went through the familiar old steps to prepare a module for CPAN: run tests, make a tarball, upload it.

    blyman@skretting:perl-hash-mostutils$ prove t/leach.t 
    t/leach.t .. Illegal character in prototype for Hash::MostUtils::leach : + at lib/Hash/MostUtils.pm line 110.
    Malformed prototype for Hash::MostUtils::leach : + at t/leach.t line 110.
    # Looks like your test exited with 2 before it could output anything.

Yikes! Sure enough, asking the debugger what my desktop's notion of splice()'s prototype is gave a very different answer:

    blyman@skretting:~$ perl -de 1
      DB<1> p prototype 'CORE::splice'
    0  '\@;$$@'

The versions of perl between my desktop and my laptop are different: my laptop has system perl 5.14 installed, where (+) is the correct prototype for leach() to use, whereas my desktop has system perl 5.10 installed, where (\@) is the correct prototype to use. So there's the problem; now what's the solution? Somehow I need to apply a different prototype to leach() depending on the version of perl that I can detect? I tried to imagine my reaction if some colleague were to introduce this to our codebase:

    sub _leach { ...basically what you saw earlier ... }

    if ($] > $some_cutoff_version) {

        eval 'sub leach (+) { goto &_leach }';

    } else {

        eval 'sub leach (\\@) { goto &_leach }';

    }

"Ugh," I heard myself say. "Why not use Scalar::Util::set_prototype instead?"

    use Scalar::Util qw(set_prototype);

    sub leach { ... }

    if ($] > $some_cutoff_version) {

        set_prototype \&leach, '+';

    } else {

        set_prototype \&leach, '\\@';

    }

This is a little better, but not all versions of Scalar::Util provide set_prototype(). [Granted, you have to be on a pretty old system perl not to have this function available.]

Since 'use' is just a 'require' then 'import', we can write our own module to choose between two separate modules, and re-export functions:

    use strict;
    use warnings;
    package Hash::MostUtils::leach;
    use base qw(Exporter);

    our @EXPORT = qw(leach);

    sub import {

        my ($class) = @_;

        if ($] > $some_cutoff_version) {

            require Hash::MostUtils::leach::prototype_is_plus;

            Hash::MostUtils::leach::prototype_is_plus->import;

        } else {

            require Hash::MostUtils::leach::prototype_is_backslash_at;

            Hash::MostUtils::leach::prototype_is_backslash_at->import;

        }

    }

    1;

Now we can just implement and @EXPORT leach() in each of those two modules:

    use strict;
    use warnings;
    package Hash::MostUtils::leach::prototype_is_plus;
    use base qw(Exporter);

    our @EXPORT = qw(leach);

    sub leach (+) { ...what you saw before... }

    1;

Err, and, what - we'll just copy-paste that module, change the package name, filename, and prototype to make the other version? Again, me-the-coworker didn't like that. It's fair to gather similar functionality together in Hash::MostUtils::leach.pm, like so:

    use strict;
    use warnings;
    package Hash::MostUtils::leach;
    use base qw(Exporter);

    our @EXPORT = qw(leach);

    sub import { ...you've already seen this... }

    sub _leach { ...and you've already seen this... }

    1;

And now both the ::prototype_is_plus and ::_prototype_is_backslash_at classes write themselves:

    use strict;
    use warnings;
    package Hash::MostUtils::leach::prototype_is_plus;
    use base qw(Exporter);

    our @EXPORT = qw(leach);

    require Hash::MostUtils::leach;

    sub leach (+) { goto &Hash::MostUtils::leach::_leach }

    1;

(You can imagine what ::_prototype_is_backslash_at.pm looks like.)

All that was left at this point was figuring out what the $some_cutoff_version is that I kept glossing over in Hash::MostUtils::leach->import(). Logan Bell gave me a painless introduction to perlbrew, and I found the cutoff point: for $] >= 5.013000, I need to use '(+)'; for versions lower, I need to use '(\@)'.

Well, not quite "all that was left." I decided to write this up, and in the course of doing so decided that maybe someone else is going to face this same problem - so I wrote provide.pm to gloss away the small details inside Hash::MostUtils::leach->import. Here's what that module looks like now:

    use strict;
    use warnings;
    package Hash::MostUtils::leach;

    use provide (

        if => ge => 5.013000 => 'Hash::MostUtils::leach::v5_013',

        else                 => 'Hash::MostUtils::leach::v5_008',

    );

    {

        my %end;

        sub _leach {

            my $data = shift;

            my $ident = "$data";

            my $n = 2;

            return () if $#{$data} < ($end{$ident} || 0);

            $end{$ident} += $n;

            return @{$data}[$end{$ident} - $n .. $end{$ident} - 1];

        }

    }

    1;