Skip Menu |
 

This queue is for tickets about the Perl6-Junction CPAN distribution.

Report information
The Basics
Id: 36687
Status: resolved
Priority: 0/
Queue: Perl6-Junction

People
Owner: Nobody in particular
Requestors: ovid [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 1.30000
Fixed in: (no value)



Subject: Need to get values from junctions
Download (untitled) / with headers
text/plain 1.1k
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';
Download (untitled) / with headers
text/plain 1.3k
On Thu Jun 12 10:49:21 2008, OVID wrote: Show quoted text
> 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.
I should submit an updated patch. In the new base class, switching from code references to strings for the overloaded methods makes the pain (see the awful *$method = sub { shift->$method } bit) Cheers, Ovid
Download (untitled) / with headers
text/plain 454b
Thanks, I've applied the patch - though after following the use.perl.org thread, I changed the overloading from \&foo to "foo", and was able to remove the funky BEGIN block. Show quoted text
> I've updated the docs, but not increased the > version number because I'm unfamiliar with your versioning scheme.
Hmm, looking at the history of version numbers, it seems neither am I ;) However, I've dreamed up a new number and uploaded a new release to cpan. Cheers, carl
Subject: Re: [rt.cpan.org #36687] Need to get values from junctions
Date: Fri, 20 Jun 2008 10:18:36 +0100 (BST)
To: bug-Perl6-Junction [...] rt.cpan.org, ovid [...] cpan.org
From: Ovid <curtis_ovid_poe [...] yahoo.com>
Download (untitled) / with headers
text/plain 875b
Thanks! I'm looking forward to it. It will save us a lot of trouble :) Cheers, Ovid --- Carl Franks via RT <bug-Perl6-Junction@rt.cpan.org> wrote: Show quoted text
> <URL: http://rt.cpan.org/Ticket/Display.html?id=36687 > > > Thanks, I've applied the patch - though after following the > use.perl.org > thread, I changed the overloading from \&foo to "foo", and was able > to > remove the funky BEGIN block. >
> > I've updated the docs, but not increased the > > version number because I'm unfamiliar with your versioning scheme.
> > Hmm, looking at the history of version numbers, it seems neither am I > ;) > > However, I've dreamed up a new number and uploaded a new release to > cpan. > > Cheers, > carl > >
-- Buy the book - http://www.oreilly.com/catalog/perlhks/ Personal blog - http://publius-ovidius.livejournal.com/ Tech blog - http://use.perl.org/~Ovid/journal/


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.