local-lib5/lib/perl5/Perl6/Junction.pm

   1 package Perl6::Junction;
   2 use strict;
   3
   4 use Perl6::Junction::All;
   5 use Perl6::Junction::Any;
   6 use Perl6::Junction::None;
   7 use Perl6::Junction::One;
   8
   9 require Exporter;
  10 our $VERSION = '1.40000';
  11
  12 our @ISA = qw/ Exporter /;
  13 my @routines = qw/ all any none one /;
  14 our @EXPORT_OK = @routines;
  15 our %EXPORT_TAGS = ( ALL => [@routines] );
  16
  17 sub all {
  18     return Perl6::Junction::All->new(@_);
  19 }
  20
  21 sub any {
  22     return Perl6::Junction::Any->new(@_);
  23 }
  24
  25 sub none {
  26     return Perl6::Junction::None->new(@_);
  27 }
  28
  29 sub one {
  30     return Perl6::Junction::One->new(@_);
  31 }
  32
  33 1;
  34
  35 __END__
  36
  37 =head1 NAME
  38
  39 Perl6::Junction - Perl6 style Junction operators in Perl5.
  40
  41 =head1 SYNOPSIS
  42
  43   use Perl6::Junction qw/ all any none one /;
  44
  45   if (any(@grant) eq 'su') {
  46     ...
  47   }
  48
  49   if (all($foo, $bar) >= 10) {
  50     ...
  51   }
  52
  53   if (qr/^\d+$/ == all(@answers)) {
  54     ...
  55   }
  56
  57   if (all(@input) <= @limits) {
  58     ...
  59   }
  60
  61   if (none(@pass) eq 'password') {
  62     ...
  63   }
  64
  65   if (one(@answer) == 42) {
  66     ...
  67   }
  68
  69 =head1 DESCRIPTION
  70
  71 This is a lightweight module which provides 'Junction' operators, the most
  72 commonly used being C<any> and C<all>.
  73
  74 Inspired by the Perl6 design docs,
  75 L<http://dev.perl.org/perl6/doc/design/exe/E06.html>.
  76
  77 Provides a limited subset of the functionality of L<Quantum::Superpositions>,
  78 see L</"SEE ALSO"> for comment.
  79
  80 Notice in the L</SYNOPSIS> above, that if you want to match against a
  81 regular expression, you must use C<==> or C<!=>. B<Not> C<=~> or C<!~>. You
  82 must also use a regex object, such as C<qr/\d/>, not a plain regex such as
  83 C</\d/>.
  84
  85
  86 =head1 SUBROUTINES
  87
  88 =head2 all()
  89
  90 Returns an object which overloads the following operators:
  91
  92   '<',  '<=', '>',  '>=', '==', '!=',
  93   'lt', 'le', 'gt', 'ge', 'eq', 'ne',
  94
  95 Returns true only if B<all> arguments test true according to the operator
  96 used.
  97
  98 =head2 any()
  99
 100 Returns an object which overloads the following operators:
 101
 102   '<',  '<=', '>',  '>=', '==', '!=',
 103   'lt', 'le', 'gt', 'ge', 'eq', 'ne',
 104
 105 Returns true if B<any> argument tests true according to the operator used.
 106
 107 =head2 none()
 108
 109 Returns an object which overloads the following operators:
 110
 111   '<',  '<=', '>',  '>=', '==', '!=',
 112   'lt', 'le', 'gt', 'ge', 'eq', 'ne',
 113
 114 Returns true only if B<no> argument tests true according to the operator
 115 used.
 116
 117 =head2 one()
 118
 119 Returns an object which overloads the following operators:
 120
 121   '<',  '<=', '>',  '>=', '==', '!=',
 122   'lt', 'le', 'gt', 'ge', 'eq', 'ne',
 123
 124 Returns true only if B<one and only one> argument tests true according to
 125 the operator used.
 126
 127 =head1 ALTERING JUNCTIONS
 128
 129 You cannot alter junctions.  Instead, you can create new junctions out of old
 130 junctions.  You can do this by calling the C<values> method on a junction.
 131
 132  my $numbers = any(qw/1 2 3 4 5/);
 133  print $numbers == 3 ? 'Yes' : 'No';   # Yes
 134
 135  $numbers = any( grep { $_ != 3 } $numbers->values );
 136  print $numbers == 3 ? 'Yes' : 'No';   # No
 137
 138 =head1 EXPORT
 139
 140 'all', 'any', 'none', 'one', as requested.
 141
 142 All subroutines can be called by its fully qualified name, if you don't
 143 want to export them.
 144
 145   use Perl6::Junction;
 146
 147   if (Perl6::Junction::any( @questions )) {
 148     ...
 149   }
 150
 151 =head1 WARNING
 152
 153 When comparing against a regular expression, you must remember to use a
 154 regular expression object: C<qr/\d/> B<Not> C</d/>. You must also use either
 155 C<==> or C<!=>. This is because C<=~> and C<!~> cannot be overriden.
 156
 157 =head1 TO DO
 158
 159 Add overloading for arithmetic operators, such that this works:
 160
 161   $result = any(2,3,4) * 2;
 162
 163   if ($result == 8) {...}
 164
 165 =head1 SUPPORT / BUGS
 166
 167 Submit to the CPAN bugtracker L<http://rt.cpan.org>
 168
 169 =head1 SEE ALSO
 170
 171 L<Quantum::Superpositions> provides the same functionality as this, and
 172 more. However, this module provides this limited functionality at a much
 173 greater runtime speed, with my benchmarks showing between 500% and 6000%
 174 improvment.
 175
 176 L<http://dev.perl.org/perl6/doc/design/exe/E06.html> - "The Wonderful World
 177 of Junctions".
 178
 179 =head1 AUTHOR
 180
 181 Carl Franks
 182
 183 =head1 ACKNOWLEDGEMENTS
 184
 185 Thanks to C<Curtis "Ovid" Poe> for the L</"ALTERING JUNCTIONS"> changes in
 186 release C<0.40000>.
 187
 188 =head1 COPYRIGHT AND LICENSE
 189
 190 Copyright 2005, Carl Franks.  All rights reserved.
 191
 192 This library is free software; you can redistribute it and/or modify it under
 193 the same terms as Perl itself (L<perlgpl>, L<perlartistic>).
 194
 195 =cut
 196