BTW I added in the arthimitic. The nice thing about the dynamic way I overload is that it was only a few extra lines of code.
Operator overloading realy is magic. ;) I also added a regex ->match method which alls things like if (any(@strings)->match(all($regex))
package List::Junctions;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(none any all);
use strict;
use vars qw/ $comparisons $compute/;
use overload (
'@{}', sub { my $this = shift; return $this->{data}; },
'""', sub { my $this = shift;
return join($" , @{$this->{data}}) if $this->{type} e
+q 'all';
return $this->{data}->[rand @{$this->{data}}] if $thi
+s->{type} eq 'any';
return '';
},
'bool', sub {my $this = shift; return $this->{bool}; }
);
my @bins = qw(binary 3way_comparison num_comparison str_comparison);
foreach my $op (split " ", "@overload::ops{ @bins }") {
$comparisons->{$op} = eval "sub { return shift() $op shift() }";
eval "use overload '$op' => sub {compare( '$op', \@_) };";
};
@bins = qw(with_assign);
foreach my $op (split " ", "@overload::ops{ @bins }") {
$compute->{$op} = eval "sub { return shift() $op shift() }";
eval "use overload '$op' => sub { compute( '$op', \@_) };";
};
$comparisons->{regex} = sub { return regex(@_) };
sub new {
my $class = shift;
my $type = shift || 'any';
return bless { type => $type , data => [@_], }, $class;
}
sub any { __PACKAGE__->new('any',@_); }
sub all { __PACKAGE__->new('all',@_); }
sub none { __PACKAGE__->new('none',@_); }
sub true { $_[0]->{bool} = 1; $_[0]; }
sub false { $_[0]->{bool} = 0; $_[0]; }
sub match { compare("regex",@_); }
sub compare {
my ($how,$self,$compare, $reverse) = @_;
my ($true,$false) = (all()->true(), all()->false());
foreach my $item (@{$self->{data}}) {
my $test = $reverse ? $comparisons->{$how}->($compare,$item)
: $comparisons->{$how}->($item,$compare);
if ($test) { push @{$true->{data}} , $item; }
else { push @{$false->{data}}, $item; }
}
return $true if (($self->{type} eq 'none') && scalar @{$true} ==
+0)
or (($self->{type} eq 'all') && scalar @{$false} ==
+0)
or (($self->{type} eq 'any') && scalar @{$true} !=
+0);
return $false;
}
sub compute {
my ($how,$self,$compare, $reverse) = @_;
my $new = __PACKAGE__->new($self->{type});
foreach my $item (@{$self->{data}}) {
my $new_item = $reverse ? $compute->{$how}->($compare,$item)
: $compute->{$how}->($item,$compare);
push @{$new->{data}}, $new_item;
+
}
return $new;
}
sub regex {
my ($item,$comparison) = @_;
if (ref($item) eq __PACKAGE__) {
return $item->match($comparison);
} elsif ( ref($comparison) eq __PACKAGE__) {
return $comparison->match($item,1);
} else {
return $item =~ $comparison;
}
}
1;