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

   1 package Perl6::Junction::One;
   2 use strict;
   3 our $VERSION = '1.40000';
   4
   5 use base 'Perl6::Junction::Base';
   6
   7 sub num_eq {
   8     return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
   9
  10     my ( $self, $test ) = @_;
  11     my $count = 0;
  12
  13     for (@$self) {
  14         if ( $_ == $test ) {
  15             return if $count;
  16             $count = 1;
  17         }
  18     }
  19
  20     return 1 if $count;
  21 }
  22
  23 sub num_ne {
  24     return regex_ne(@_) if ref( $_[1] ) eq 'Regexp';
  25
  26     my ( $self, $test ) = @_;
  27     my $count = 0;
  28
  29     for (@$self) {
  30         if ( $_ != $test ) {
  31             return if $count;
  32             $count = 1;
  33         }
  34     }
  35
  36     return 1 if $count;
  37 }
  38
  39 sub num_ge {
  40     my ( $self, $test, $switch ) = @_;
  41
  42     return num_le( $self, $test ) if $switch;
  43
  44     my $count = 0;
  45
  46     for (@$self) {
  47         if ( $_ >= $test ) {
  48             return if $count;
  49             $count = 1;
  50         }
  51     }
  52
  53     return 1 if $count;
  54 }
  55
  56 sub num_gt {
  57     my ( $self, $test, $switch ) = @_;
  58
  59     return num_lt( $self, $test ) if $switch;
  60
  61     my $count = 0;
  62
  63     for (@$self) {
  64         if ( $_ > $test ) {
  65             return if $count;
  66             $count = 1;
  67         }
  68     }
  69
  70     return 1 if $count;
  71 }
  72
  73 sub num_le {
  74     my ( $self, $test, $switch ) = @_;
  75
  76     return num_ge( $self, $test ) if $switch;
  77
  78     my $count = 0;
  79
  80     for (@$self) {
  81         if ( $_ <= $test ) {
  82             return if $count;
  83             $count = 1;
  84         }
  85     }
  86
  87     return 1 if $count;
  88 }
  89
  90 sub num_lt {
  91     my ( $self, $test, $switch ) = @_;
  92
  93     return num_gt( $self, $test ) if $switch;
  94
  95     my $count = 0;
  96
  97     for (@$self) {
  98         if ( $_ < $test ) {
  99             return if $count;
 100             $count = 1;
 101         }
 102     }
 103
 104     return 1 if $count;
 105 }
 106
 107 sub str_eq {
 108     my ( $self, $test ) = @_;
 109     my $count = 0;
 110
 111     for (@$self) {
 112         if ( $_ eq $test ) {
 113             return if $count;
 114             $count = 1;
 115         }
 116     }
 117
 118     return 1 if $count;
 119 }
 120
 121 sub str_ne {
 122     my ( $self, $test ) = @_;
 123     my $count = 0;
 124
 125     for (@$self) {
 126         if ( $_ ne $test ) {
 127             return if $count;
 128             $count = 1;
 129         }
 130     }
 131
 132     return 1 if $count;
 133 }
 134
 135 sub str_ge {
 136     my ( $self, $test, $switch ) = @_;
 137
 138     return str_le( $self, $test ) if $switch;
 139
 140     my $count = 0;
 141
 142     for (@$self) {
 143         if ( $_ ge $test ) {
 144             return if $count;
 145             $count = 1;
 146         }
 147     }
 148
 149     return 1 if $count;
 150 }
 151
 152 sub str_gt {
 153     my ( $self, $test, $switch ) = @_;
 154
 155     return str_lt( $self, $test ) if $switch;
 156
 157     my $count = 0;
 158
 159     for (@$self) {
 160         if ( $_ gt $test ) {
 161             return if $count;
 162             $count = 1;
 163         }
 164     }
 165
 166     return 1 if $count;
 167 }
 168
 169 sub str_le {
 170     my ( $self, $test, $switch ) = @_;
 171
 172     return str_ge( $self, $test ) if $switch;
 173
 174     my $count = 0;
 175
 176     for (@$self) {
 177         if ( $_ le $test ) {
 178             return if $count;
 179             $count = 1;
 180         }
 181     }
 182
 183     return 1 if $count;
 184 }
 185
 186 sub str_lt {
 187     my ( $self, $test, $switch ) = @_;
 188
 189     return str_gt( $self, $test ) if $switch;
 190
 191     my $count = 0;
 192
 193     for (@$self) {
 194         if ( $_ lt $test ) {
 195             return if $count;
 196             $count = 1;
 197         }
 198     }
 199
 200     return 1 if $count;
 201 }
 202
 203 sub regex_eq {
 204     my ( $self, $test, $switch ) = @_;
 205
 206     my $count = 0;
 207
 208     for (@$self) {
 209         if ( $_ =~ $test ) {
 210             return if $count;
 211             $count = 1;
 212         }
 213     }
 214
 215     return 1 if $count;
 216 }
 217
 218 sub regex_ne {
 219     my ( $self, $test, $switch ) = @_;
 220
 221     my $count = 0;
 222
 223     for (@$self) {
 224         if ( $_ !~ $test ) {
 225             return if $count;
 226             $count = 1;
 227         }
 228     }
 229
 230     return 1 if $count;
 231 }
 232
 233 sub bool {
 234     my ($self) = @_;
 235     my $count = 0;
 236
 237     for (@$self) {
 238         if ($_) {
 239             return if $count;
 240             $count = 1;
 241         }
 242     }
 243
 244     return 1 if $count;
 245 }
 246
 247 1;
 248