perlquestion
Zaxo
<p>Replying to [educated_foo]'s excellent question at [id://168794], I quoted an example of overloading the diamond operator <tt><></tt> 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:<code>
#!/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;
}
</code><br/>It implements drawing elements from an array without replacement</p>
<p>I worried about whether false values in the array would interfere with <tt>while (<$foo>) {}</tt>, and whether list context would fail.</p>
<p>Sooo... I expanded the example to test a number of cases. It turns out that <tt>[while] <></tt> 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 <tt>my @foo = <$foo>;</tt> nor <tt>for (<$foo>) {}</tt> works as expected.</p>
<p>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?</p>
<p>Here is the test code:<READMORE><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];
}
</code>
And here is the unsuccessful new code:<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 $/;
</code><br/>Why am I not getting a list back?</p>
<p>The code here is organized so that it runs as a single file.</p>
</READMORE>
<p>After Compline,<br/>Zaxo</p>