Initial Commit

database/perl/vendor/lib/Syntax/Keyword/Junction/All.pm

@@ -0,0 +1,242 @@
+package Syntax::Keyword::Junction::All;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.003008'; # VERSION
+
+use parent 'Syntax::Keyword::Junction::Base';
+
+BEGIN {
+  if ($] >= 5.010001) {
+    eval q|
+sub match {
+    my ( $self, $other, $is_rhs ) = @_;
+    no if $] > 5.017010, warnings => 'experimental::smartmatch';
+
+    if ($is_rhs) {
+        for (@$self) {
+            return unless $other ~~ $_;
+        }
+
+        return 1;
+    }
+
+    for (@$self) {
+        return unless $_ ~~ $other;
+    }
+
+    return 1;
+}
+|
+  }
+}
+
+sub num_eq {
+    return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return unless $_ == $test;
+    }
+
+    return 1;
+}
+
+sub num_ne {
+    return regex_ne(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return unless $_ != $test;
+    }
+
+    return 1;
+}
+
+sub num_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_le( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ >= $test;
+    }
+
+    return 1;
+}
+
+sub num_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_lt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ > $test;
+    }
+
+    return 1;
+}
+
+sub num_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_ge( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ <= $test;
+    }
+
+    return 1;
+}
+
+sub num_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_gt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ < $test;
+    }
+
+    return 1;
+}
+
+sub str_eq {
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return unless $_ eq $test;
+    }
+
+    return 1;
+}
+
+sub str_ne {
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return unless $_ ne $test;
+    }
+
+    return 1;
+}
+
+sub str_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_le( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ ge $test;
+    }
+
+    return 1;
+}
+
+sub str_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_lt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ gt $test;
+    }
+
+    return 1;
+}
+
+sub str_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_ge( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ le $test;
+    }
+
+    return 1;
+}
+
+sub str_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_gt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return unless $_ lt $test;
+    }
+
+    return 1;
+}
+
+sub regex_eq {
+    my ( $self, $test, $switch ) = @_;
+
+    for (@$self) {
+        return unless $_ =~ $test;
+    }
+
+    return 1;
+}
+
+sub regex_ne {
+    my ( $self, $test, $switch ) = @_;
+
+    for (@$self) {
+        return unless $_ !~ $test;
+    }
+
+    return 1;
+}
+
+sub bool {
+    my ($self) = @_;
+
+    for (@$self) {
+        return unless $_;
+    }
+
+    return 1;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Syntax::Keyword::Junction::All
+
+=head1 VERSION
+
+version 0.003008
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
+
+=item *
+
+Carl Franks
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

database/perl/vendor/lib/Syntax/Keyword/Junction/Any.pm

@@ -0,0 +1,242 @@
+package Syntax::Keyword::Junction::Any;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.003008'; # VERSION
+
+use parent 'Syntax::Keyword::Junction::Base';
+
+BEGIN {
+  if ($] >= 5.010001) {
+    eval q|
+sub match {
+    no if $] > 5.017010, warnings => 'experimental::smartmatch';
+    my ( $self, $other, $is_rhs ) = @_;
+
+    if ($is_rhs) {
+        for (@$self) {
+            return 1 if $other ~~ $_;
+        }
+
+        return;
+    }
+
+    for (@$self) {
+        return 1 if $_ ~~ $other;
+    }
+
+    return;
+}
+|
+  }
+}
+
+sub num_eq {
+    return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return 1 if $_ == $test;
+    }
+
+    return;
+}
+
+sub num_ne {
+    return regex_ne(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return 1 if $_ != $test;
+    }
+
+    return;
+}
+
+sub num_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_le( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ >= $test;
+    }
+
+    return;
+}
+
+sub num_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_lt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ > $test;
+    }
+
+    return;
+}
+
+sub num_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_ge( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ <= $test;
+    }
+
+    return;
+}
+
+sub num_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_gt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ < $test;
+    }
+
+    return;
+}
+
+sub str_eq {
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return 1 if $_ eq $test;
+    }
+
+    return;
+}
+
+sub str_ne {
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return 1 if $_ ne $test;
+    }
+
+    return;
+}
+
+sub str_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_le( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ ge $test;
+    }
+
+    return;
+}
+
+sub str_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_lt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ gt $test;
+    }
+
+    return;
+}
+
+sub str_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_ge( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ le $test;
+    }
+
+    return;
+}
+
+sub str_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_gt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return 1 if $_ lt $test;
+    }
+
+    return;
+}
+
+sub regex_eq {
+    my ( $self, $test, $switch ) = @_;
+
+    for (@$self) {
+        return 1 if $_ =~ $test;
+    }
+
+    return;
+}
+
+sub regex_ne {
+    my ( $self, $test, $switch ) = @_;
+
+    for (@$self) {
+        return 1 if $_ !~ $test;
+    }
+
+    return;
+}
+
+sub bool {
+    my ($self) = @_;
+
+    for (@$self) {
+        return 1 if $_;
+    }
+
+    return;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Syntax::Keyword::Junction::Any
+
+=head1 VERSION
+
+version 0.003008
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
+
+=item *
+
+Carl Franks
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

database/perl/vendor/lib/Syntax/Keyword/Junction/Base.pm

@@ -0,0 +1,77 @@
+package Syntax::Keyword::Junction::Base;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.003008'; # VERSION
+
+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},
+    $] >= 5.010001 ? ('~~' => 'match') : (),
+);
+
+
+sub new { bless \@_, shift }
+
+sub values {
+    my $self = shift;
+    return wantarray ? @$self : [ @$self ];
+}
+
+sub map {
+    my ( $self, $code ) = @_;
+    my $class = ref $self;
+    $class->new( map { $code->( $_ ) } $self->values );
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Syntax::Keyword::Junction::Base
+
+=head1 VERSION
+
+version 0.003008
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
+
+=item *
+
+Carl Franks
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

database/perl/vendor/lib/Syntax/Keyword/Junction/None.pm

@@ -0,0 +1,242 @@
+package Syntax::Keyword::Junction::None;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.003008'; # VERSION
+
+use parent 'Syntax::Keyword::Junction::Base';
+
+BEGIN {
+  if ($] >= 5.010001) {
+    eval q|
+sub match {
+    no if $] > 5.017010, warnings => 'experimental::smartmatch';
+    my ( $self, $other, $is_rhs ) = @_;
+
+    if ($is_rhs) {
+        for (@$self) {
+            return if $other ~~ $_;
+        }
+
+        return 1;
+    }
+
+    for (@$self) {
+        return if $_ ~~ $other;
+    }
+
+    return 1;
+}
+|
+  }
+}
+
+sub num_eq {
+    return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return if $_ == $test;
+    }
+
+    return 1;
+}
+
+sub num_ne {
+    return regex_ne(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return if $_ != $test;
+    }
+
+    return 1;
+}
+
+sub num_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_le( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ >= $test;
+    }
+
+    return 1;
+}
+
+sub num_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_lt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ > $test;
+    }
+
+    return 1;
+}
+
+sub num_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_ge( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ <= $test;
+    }
+
+    return 1;
+}
+
+sub num_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_gt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ < $test;
+    }
+
+    return 1;
+}
+
+sub str_eq {
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return if $_ eq $test;
+    }
+
+    return 1;
+}
+
+sub str_ne {
+    my ( $self, $test ) = @_;
+
+    for (@$self) {
+        return if $_ ne $test;
+    }
+
+    return 1;
+}
+
+sub str_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_le( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ ge $test;
+    }
+
+    return 1;
+}
+
+sub str_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_lt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ gt $test;
+    }
+
+    return 1;
+}
+
+sub str_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_ge( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ le $test;
+    }
+
+    return 1;
+}
+
+sub str_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_gt( $self, $test ) if $switch;
+
+    for (@$self) {
+        return if $_ lt $test;
+    }
+
+    return 1;
+}
+
+sub regex_eq {
+    my ( $self, $test, $switch ) = @_;
+
+    for (@$self) {
+        return if $_ =~ $test;
+    }
+
+    return 1;
+}
+
+sub regex_ne {
+    my ( $self, $test, $switch ) = @_;
+
+    for (@$self) {
+        return if $_ !~ $test;
+    }
+
+    return 1;
+}
+
+sub bool {
+    my ($self) = @_;
+
+    for (@$self) {
+        return if $_;
+    }
+
+    return 1;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Syntax::Keyword::Junction::None
+
+=head1 VERSION
+
+version 0.003008
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
+
+=item *
+
+Carl Franks
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut

database/perl/vendor/lib/Syntax/Keyword/Junction/One.pm

@@ -0,0 +1,321 @@
+package Syntax::Keyword::Junction::One;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.003008'; # VERSION
+
+use parent 'Syntax::Keyword::Junction::Base';
+
+BEGIN {
+  if ($] >= 5.010001) {
+    eval q|
+sub match {
+    no if $] > 5.017010, warnings => 'experimental::smartmatch';
+    my ( $self, $other, $is_rhs ) = @_;
+
+    my $count = 0;
+
+    if ($is_rhs) {
+
+        for (@$self) {
+            if ($other ~~ $_) {
+              return if $count;
+              $count = 1;
+            }
+        }
+
+        return($count == 1);
+    }
+
+    for (@$self) {
+        if ($_ ~~ $other) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return($count == 1);
+}
+|
+  }
+}
+
+sub num_eq {
+    return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ == $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub num_ne {
+    return regex_ne(@_) if ref( $_[1] ) eq 'Regexp';
+
+    my ( $self, $test ) = @_;
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ != $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub num_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_le( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ >= $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub num_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_lt( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ > $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub num_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_ge( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ <= $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub num_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return num_gt( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ < $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub str_eq {
+    my ( $self, $test ) = @_;
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ eq $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub str_ne {
+    my ( $self, $test ) = @_;
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ ne $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub str_ge {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_le( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ ge $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub str_gt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_lt( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ gt $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub str_le {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_ge( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ le $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub str_lt {
+    my ( $self, $test, $switch ) = @_;
+
+    return str_gt( $self, $test ) if $switch;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ lt $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub regex_eq {
+    my ( $self, $test, $switch ) = @_;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ =~ $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub regex_ne {
+    my ( $self, $test, $switch ) = @_;
+
+    my $count = 0;
+
+    for (@$self) {
+        if ( $_ !~ $test ) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+sub bool {
+    my ($self) = @_;
+    my $count = 0;
+
+    for (@$self) {
+        if ($_) {
+            return if $count;
+            $count = 1;
+        }
+    }
+
+    return 1 if $count;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Syntax::Keyword::Junction::One
+
+=head1 VERSION
+
+version 0.003008
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
+
+=item *
+
+Carl Franks
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Arthur Axel "fREW" Schmidt.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut