| Subject: | Need to get values from junctions |
I discovered that sometimes I need to create a new junction based on an
old junction. Actually, I need to sometimes add and delete values from
junctions, but since I think they're intended to be immutable, I decided
that just being able to fetch and filter the scalar values to create new
functions was a good alternative. For example:
my $number = any( 0 .. 19 );
while ($number->values) {
my $random_number int(rand(20));
if ( $number == $random_number ) {
# handle some task and discard the number
$number = any(
grep { $_ != $random_number } $number->values
);
}
}
Not being able to build new junctions based on old ones has been a huge
obstacle in what I'm currently working on and I didn't want to merely do
something like @$junction since that's violating encapsulation.
I've attached a patch which allows this functionality (it might look a
bit strange because I've done some refactoring which utilizes documented
overload behavior). I've updated the docs, but not increased the
version number because I'm unfamiliar with your versioning scheme.
Cheers,
Ovid
| Subject: | perl6-junction.patch |
diff -uNr Perl6-Junction.orig/Changes Perl6-Junction/Changes
--- Perl6-Junction.orig/Changes 2007-05-11 13:37:02.000000000 +0100
+++ Perl6-Junction/Changes 2008-06-12 15:27:57.000000000 +0100
@@ -1,3 +1,6 @@
+ - Added 'values' method to ensure that we can fetch data from junctions
+ and create new junctions based upon old ones.
+
1.30000 2007-05-11
- Non-development release.
diff -uNr Perl6-Junction.orig/MANIFEST Perl6-Junction/MANIFEST
--- Perl6-Junction.orig/MANIFEST 2007-05-11 13:37:16.000000000 +0100
+++ Perl6-Junction/MANIFEST 2008-06-12 15:25:33.000000000 +0100
@@ -1,5 +1,6 @@
Changes
lib/Perl6/Junction.pm
+lib/Perl6/Junction/Base.pm
lib/Perl6/Junction/All.pm
lib/Perl6/Junction/Any.pm
lib/Perl6/Junction/None.pm
diff -uNr Perl6-Junction.orig/lib/Perl6/Junction/All.pm Perl6-Junction/lib/Perl6/Junction/All.pm
--- Perl6-Junction.orig/lib/Perl6/Junction/All.pm 2007-05-11 13:36:06.000000000 +0100
+++ Perl6-Junction/lib/Perl6/Junction/All.pm 2008-06-12 14:00:49.000000000 +0100
@@ -2,28 +2,7 @@
use strict;
our $VERSION = '1.30000';
-use overload(
- '==' => \&num_eq,
- '!=' => \&num_ne,
- '>=' => \&num_ge,
- '>' => \&num_gt,
- '<=' => \&num_le,
- '<' => \&num_lt,
- 'eq' => \&str_eq,
- 'ne' => \&str_ne,
- 'ge' => \&str_ge,
- 'gt' => \&str_gt,
- 'le' => \&str_le,
- 'lt' => \&str_lt,
- 'bool' => \&bool,
- '""' => sub {shift},
-);
-
-sub all {
- my ( $proto, @param ) = @_;
-
- return bless \@param, $proto;
-}
+use base 'Perl6::Junction::Base';
sub num_eq {
return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
diff -uNr Perl6-Junction.orig/lib/Perl6/Junction/Any.pm Perl6-Junction/lib/Perl6/Junction/Any.pm
--- Perl6-Junction.orig/lib/Perl6/Junction/Any.pm 2007-05-11 13:36:10.000000000 +0100
+++ Perl6-Junction/lib/Perl6/Junction/Any.pm 2008-06-12 14:01:10.000000000 +0100
@@ -2,28 +2,7 @@
use strict;
our $VERSION = '1.30000';
-use overload(
- '==' => \&num_eq,
- '!=' => \&num_ne,
- '>=' => \&num_ge,
- '>' => \&num_gt,
- '<=' => \&num_le,
- '<' => \&num_lt,
- 'eq' => \&str_eq,
- 'ne' => \&str_ne,
- 'ge' => \&str_ge,
- 'gt' => \&str_gt,
- 'le' => \&str_le,
- 'lt' => \&str_lt,
- 'bool' => \&bool,
- '""' => sub {shift},
-);
-
-sub any {
- my ( $proto, @param ) = @_;
-
- return bless \@param, $proto;
-}
+use base 'Perl6::Junction::Base';
sub num_eq {
return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
diff -uNr Perl6-Junction.orig/lib/Perl6/Junction/Base.pm Perl6-Junction/lib/Perl6/Junction/Base.pm
--- Perl6-Junction.orig/lib/Perl6/Junction/Base.pm 1970-01-01 00:00:00.000000000 +0000
+++ Perl6-Junction/lib/Perl6/Junction/Base.pm 2008-06-12 15:02:15.000000000 +0100
@@ -0,0 +1,60 @@
+package Perl6::Junction::Base;
+use strict;
+our $VERSION = '1.30000';
+
+BEGIN {
+ my @methods = qw(
+ num_eq
+ num_ne
+ num_ge
+ num_gt
+ num_le
+ num_lt
+ str_eq
+ str_ne
+ str_ge
+ str_gt
+ str_le
+ str_lt
+ bool
+ );
+
+ # See "Inheritance and overloading" in "perldoc overload". This behavior
+ # is correct, but OH MY GOD it's confusing as hell.
+ # Basically, overloading doesn't allow you to override these methods, so
+ # you need to redispatch to the correct class. Calling
+ foreach my $method (@methods) {
+ no strict 'refs';
+ *$method = sub { shift->$method(@_) };
+ }
+}
+
+use overload(
+ '==' => \&num_eq,
+ '!=' => \&num_ne,
+ '>=' => \&num_ge,
+ '>' => \&num_gt,
+ '<=' => \&num_le,
+ '<' => \&num_lt,
+ 'eq' => \&str_eq,
+ 'ne' => \&str_ne,
+ 'ge' => \&str_ge,
+ 'gt' => \&str_gt,
+ 'le' => \&str_le,
+ 'lt' => \&str_lt,
+ 'bool' => \&bool,
+ '""' => sub {shift},
+);
+
+sub new {
+ my ( $class, @param ) = @_;
+ return bless \@param, $class;
+}
+
+sub values {
+ my $self = shift;
+ return wantarray ? @$self : [ @$self ];
+}
+
+1;
+
diff -uNr Perl6-Junction.orig/lib/Perl6/Junction/None.pm Perl6-Junction/lib/Perl6/Junction/None.pm
--- Perl6-Junction.orig/lib/Perl6/Junction/None.pm 2007-05-11 13:36:14.000000000 +0100
+++ Perl6-Junction/lib/Perl6/Junction/None.pm 2008-06-12 14:01:45.000000000 +0100
@@ -2,28 +2,7 @@
use strict;
our $VERSION = '1.30000';
-use overload(
- '==' => \&num_eq,
- '!=' => \&num_ne,
- '>=' => \&num_ge,
- '>' => \&num_gt,
- '<=' => \&num_le,
- '<' => \&num_lt,
- 'eq' => \&str_eq,
- 'ne' => \&str_ne,
- 'ge' => \&str_ge,
- 'gt' => \&str_gt,
- 'le' => \&str_le,
- 'lt' => \&str_lt,
- 'bool' => \&bool,
- '""' => sub {shift},
-);
-
-sub none {
- my ( $class, @param ) = @_;
-
- return bless \@param, $class;
-}
+use base 'Perl6::Junction::Base';
sub num_eq {
return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
diff -uNr Perl6-Junction.orig/lib/Perl6/Junction/One.pm Perl6-Junction/lib/Perl6/Junction/One.pm
--- Perl6-Junction.orig/lib/Perl6/Junction/One.pm 2007-05-11 13:36:18.000000000 +0100
+++ Perl6-Junction/lib/Perl6/Junction/One.pm 2008-06-12 14:01:26.000000000 +0100
@@ -2,28 +2,7 @@
use strict;
our $VERSION = '1.30000';
-use overload(
- '==' => \&num_eq,
- '!=' => \&num_ne,
- '>=' => \&num_ge,
- '>' => \&num_gt,
- '<=' => \&num_le,
- '<' => \&num_lt,
- 'eq' => \&str_eq,
- 'ne' => \&str_ne,
- 'ge' => \&str_ge,
- 'gt' => \&str_gt,
- 'le' => \&str_le,
- 'lt' => \&str_lt,
- 'bool' => \&bool,
- '""' => sub {shift},
-);
-
-sub one {
- my ( $class, @param ) = @_;
-
- return bless \@param, $class;
-}
+use base 'Perl6::Junction::Base';
sub num_eq {
return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
diff -uNr Perl6-Junction.orig/lib/Perl6/Junction.pm Perl6-Junction/lib/Perl6/Junction.pm
--- Perl6-Junction.orig/lib/Perl6/Junction.pm 2007-05-11 13:34:00.000000000 +0100
+++ Perl6-Junction/lib/Perl6/Junction.pm 2008-06-12 15:10:54.000000000 +0100
@@ -15,19 +15,19 @@
our %EXPORT_TAGS = ( ALL => [@routines] );
sub all {
- return Perl6::Junction::All->all(@_);
+ return Perl6::Junction::All->new(@_);
}
sub any {
- return Perl6::Junction::Any->any(@_);
+ return Perl6::Junction::Any->new(@_);
}
sub none {
- return Perl6::Junction::None->none(@_);
+ return Perl6::Junction::None->new(@_);
}
sub one {
- return Perl6::Junction::One->one(@_);
+ return Perl6::Junction::One->new(@_);
}
1;
@@ -124,11 +124,22 @@
Returns true only if B<one and only one> argument tests true according to
the operator used.
+=head1 ALTERING JUNCTIONS
+
+You cannot alter junctions. Instead, you can create new junctions out of old
+junctions. You can do this by calling the C<values> method on a junction.
+
+ my $numbers = any(qw/1 2 3 4 5/);
+ print $numbers == 3 ? 'Yes' : 'No'; # Yes
+
+ $numbers = any( grep { $_ != 3 } $numbers->values );
+ print $numbers == 3 ? 'Yes' : 'No'; # No
+
=head1 EXPORT
'all', 'any', 'none', 'one', as requested.
-All subroutines can be called by it's fully qualified name, if you don't
+All subroutines can be called by its fully qualified name, if you don't
want to export them.
use Perl6::Junction;
diff -uNr Perl6-Junction.orig/t/all.t Perl6-Junction/t/all.t
--- Perl6-Junction.orig/t/all.t 2007-01-08 16:49:42.000000000 +0000
+++ Perl6-Junction/t/all.t 2008-06-12 15:21:29.000000000 +0100
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 87;
+use Test::More tests => 90;
use Perl6::Junction 'all';
@@ -105,3 +105,11 @@
ok( !all( 'a', undef, 'c' ), '! bool' );
like( all( 1, 2 ), qr/^Perl6::Junction::All=/, 'stringified to ref' );
+
+my @data = qw(3 4 5 6 7);
+my $junction = all(@data);
+can_ok $junction, 'values';
+my @values = $junction->values;
+is_deeply \@values, \@data, 'values() in list context';
+my $values = $junction->values;
+is_deeply $values, \@data, 'values() in scalar context';
diff -uNr Perl6-Junction.orig/t/any.t Perl6-Junction/t/any.t
--- Perl6-Junction.orig/t/any.t 2007-01-08 16:49:44.000000000 +0000
+++ Perl6-Junction/t/any.t 2008-06-12 15:21:47.000000000 +0100
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 72;
+use Test::More tests => 75;
use Perl6::Junction 'any';
@@ -91,3 +91,10 @@
like( any( 1, 2 ), qr/^Perl6::Junction::Any=/, 'stringified to ref' );
+my @data = qw(3 4 5 6 7);
+my $junction = any(@data);
+can_ok $junction, 'values';
+my @values = $junction->values;
+is_deeply \@values, \@data, 'values() in list context';
+my $values = $junction->values;
+is_deeply $values, \@data, 'values() in scalar context';
diff -uNr Perl6-Junction.orig/t/none.t Perl6-Junction/t/none.t
--- Perl6-Junction.orig/t/none.t 2007-01-08 16:49:43.000000000 +0000
+++ Perl6-Junction/t/none.t 2008-06-12 15:22:08.000000000 +0100
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 78;
+use Test::More tests => 81;
use Perl6::Junction 'none';
@@ -97,3 +97,10 @@
like( none( 1, 2 ), qr/^Perl6::Junction::None=/, 'stringified to ref' );
+my @data = qw(3 4 5 6 7);
+my $junction = none(@data);
+can_ok $junction, 'values';
+my @values = $junction->values;
+is_deeply \@values, \@data, 'values() in list context';
+my $values = $junction->values;
+is_deeply $values, \@data, 'values() in scalar context';
diff -uNr Perl6-Junction.orig/t/one.t Perl6-Junction/t/one.t
--- Perl6-Junction.orig/t/one.t 2007-01-08 16:49:43.000000000 +0000
+++ Perl6-Junction/t/one.t 2008-06-12 15:22:34.000000000 +0100
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 95;
+use Test::More tests => 98;
use Perl6::Junction 'one';
@@ -114,3 +114,10 @@
like( one( 1, 2 ), qr/^Perl6::Junction::One=/, 'stringified to ref' );
+my @data = qw(3 4 5 6 7);
+my $junction = one(@data);
+can_ok $junction, 'values';
+my @values = $junction->values;
+is_deeply \@values, \@data, 'values() in list context';
+my $values = $junction->values;
+is_deeply $values, \@data, 'values() in scalar context';