Overloading for List Context

Zaxo has asked for the wisdom of the Perl Monks concerning the following question:

Replying to educated_foo's excellent question at Re: Basic Objects with Overloaded Operators, I quoted an example of overloading the diamond operator <> from the Camel Book, 3rd ed., p355. I mentioned my uneasiness about how closely the overloaded operator followed the 'rules' (whatever they are). Here is the overloaded module:

#!/usr/bin/perl -w
use strict;

package LuckyDraw;
use overload
    '<>' => sub {
        my $self = shift;
        splice @$self, rand @$self, 1;
    };
sub new {
    my $class = shift;
    bless [@_], $class;
}
[download]

It implements drawing elements from an array without replacement

I worried about whether false values in the array would interfere with while (<$foo>) {}, and whether list context would fail.

Sooo... I expanded the example to test a number of cases. It turns out that while <> is fine with zeros in the array. If undef is present, it ends the while loop, but the remainder of the array is still available. As I feared, list context fails to read the entire array. That means that neither my @foo = <$foo>; nor for (<$foo>) {} works as expected.

I rewrote a version of the module which I thought should do the right thing in list context. It doesn't. Anyone see what I'm forgetting?

Here is the test code:

package main;

my $cards = LuckyDraw->new(1..52);
for (1..5) {
    my $card = <$cards>;
    print name_card($card),$/;
}

my $alltrue = LuckyDraw->new(qw/foo bar baz/);
print 'All True:', $/;
print while <$alltrue>;
print $/;

my $onezero = LuckyDraw->new(0..9);
print 'One Zero:', $/;
print while <$onezero>;
print $/;

my $onefalse = LuckyDraw->new(0..9);
print 'One False:', $/;
$_+=0, print while <$onefalse>;
print $/;

my $onenil = LuckyDraw->new(undef,1..9);
print 'One Undef:', $/;
print while <$onenil>;
print $/;
print 'continuing...',$/;
print while <$onenil>;
print $/;

my $shuffle = new LuckyDraw(1..52);
print name_card($_),' ' for <$shuffle>;
print $/;

sub name_card {
    my $card = shift;
    sprintf "%s of %s",
        (qw/Ace Deuce Trey Four Five
         Six Seven Eight Nine Ten
         Jack Queen King/)[$card % 13],
        (qw/Clubs Diamonds Hearts Spades/)[$card / 13];
}
[download]

And here is the unsuccessful new code:

package LuckyDeck;
use overload
    '<>' => sub {
        my $self = shift;
        return splice( @$self, rand @$self, 1) unless wantarray;
        my @deck;
        push @deck, splice( @$self, rand @$self, 1) while @$self;
        @deck;
    };
sub new {
    my $class = shift;
    bless [@_], $class;
}

package main;

my $quux = LuckyDeck->new(0..9);
print 'List Context',$/;
print for <$quux>;
print $/;
[download]

Why am I not getting a list back?

The code here is organized so that it runs as a single file.

After Compline,
Zaxo

Back to Seekers of Perl Wisdom