From: Stevan Little Date: Thu, 1 Jun 2006 14:47:52 +0000 (+0000) Subject: foo X-Git-Tag: 0_02~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoose-Autobox.git;a=commitdiff_plain;h=5f654d8ec893246d215ae8a3b0fa9b467d50b3b9 foo --- diff --git a/lib/Moose/Autobox.pm b/lib/Moose/Autobox.pm new file mode 100644 index 0000000..7b9838f --- /dev/null +++ b/lib/Moose/Autobox.pm @@ -0,0 +1,87 @@ + +package Moose::Autobox; + +use strict; +use warnings; + +use Moose (); +use Scalar::Util (); + +our $VERSION = '0.01'; + +sub import { + eval q| +package SCALAR; +use Moose; +with 'Moose::Autobox::Scalar'; + +package ARRAY; +use Moose; +with 'Moose::Autobox::Array'; + +package HASH; +use Moose; +with 'Moose::Autobox::Hash'; + +package CODE; +use Moose; +with 'Moose::Autobox::Code'; + |; +} + +1; + +__END__ + +=pod + +=head1 NAME + +Moose::Autobox - autoboxed for her pleasure + +=head1 SYNOPOSIS + +=head1 DESCRIPTION + + Any + Item + Bool + Undef + Defined + Value + Num + Int + Str + Ref + ScalarRef + ArrayRef + HashRef + CodeRef + RegexpRef + Object + Role + + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + + +=cut + + diff --git a/lib/Moose/Autobox/Array.pm b/lib/Moose/Autobox/Array.pm new file mode 100644 index 0000000..37cc777 --- /dev/null +++ b/lib/Moose/Autobox/Array.pm @@ -0,0 +1,70 @@ +package Moose::Autobox::Array; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Ref'; + +sub length { + my ($array) = @_; + CORE::scalar @$array; +} + +sub grep { + my ($array, $sub) = @_; + [ CORE::grep { $sub->($_) } @$array ]; +} + +sub map { + my ($array, $sub) = @_; + [ CORE::map { $sub->($_) } @$array ]; +} + +sub join { + my ($array, $sep) = @_; + CORE::join $sep, @$array; +} + +sub reverse { + my ($array) = @_; + [ CORE::reverse @{$array} ]; +} + +sub sort { + my ($array, $sub) = @_; + $sub ||= sub { $a cmp $b }; + [ CORE::sort { $sub->($a, $b) } @$array ]; +} + +sub pop { + my ($array) = @_; + CORE::pop @{$array}; +} + +sub push { + my ($array, @rest) = @_; + CORE::push @$array, @rest; + $array; +} + +sub unshift { + my ($array, @rest) = @_; + CORE::unshift @{$array}, @rest; + $array; +} +sub exists { + my ($array, $index) = @_; + CORE::exists $array->[$index]; +} + +sub delete { + my ($array, $index) = @_; + CORE::delete $array->[$index]; +} + +sub shift { + my ($array) = @_; + CORE::shift @$array; +} + +1; diff --git a/lib/Moose/Autobox/Code.pm b/lib/Moose/Autobox/Code.pm new file mode 100644 index 0000000..f58b9a7 --- /dev/null +++ b/lib/Moose/Autobox/Code.pm @@ -0,0 +1,34 @@ +package Moose::Autobox::Code; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Ref'; + +sub curry { + my ($f, @a) = @_; + return sub { $f->(@a, @_) } +} + +sub rcurry { + my ($f, @a) = @_; + return sub { $f->(@_, @a) } +} + +sub compose { + my ($f, $f2, @rest) = @_; + return $f if !$f2; + return (sub { $f2->($f->(@_)) })->compose(@rest); +} + +sub disjoin { + my ($f, $f2) = @_; + return sub { $f->(@_) || $f2->(@_) } +} + +sub conjoin { + my ($f, $f2) = @_; + return sub { $f->(@_) && $f2->(@_) } +} + +1; \ No newline at end of file diff --git a/lib/Moose/Autobox/Defined.pm b/lib/Moose/Autobox/Defined.pm new file mode 100644 index 0000000..a71010a --- /dev/null +++ b/lib/Moose/Autobox/Defined.pm @@ -0,0 +1,10 @@ +package Moose::Autobox::Defined; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Item'; + +sub defined { 1 } + +1; \ No newline at end of file diff --git a/lib/Moose/Autobox/Hash.pm b/lib/Moose/Autobox/Hash.pm new file mode 100644 index 0000000..2cc99a3 --- /dev/null +++ b/lib/Moose/Autobox/Hash.pm @@ -0,0 +1,22 @@ +package Moose::Autobox::Hash; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Ref'; + +sub exists { + my ($hash, $key) = @_; + CORE::exists $hash->{$key}; +} +sub keys { + my ($hash) = @_; + [ CORE::keys %{$hash} ]; +} + +sub values { + my ($hash) = @_; + [ CORE::values %{$hash} ]; +} + +1; \ No newline at end of file diff --git a/lib/Moose/Autobox/Item.pm b/lib/Moose/Autobox/Item.pm new file mode 100644 index 0000000..f7316b2 --- /dev/null +++ b/lib/Moose/Autobox/Item.pm @@ -0,0 +1,6 @@ +package Moose::Autobox::Item; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +1; \ No newline at end of file diff --git a/lib/Moose/Autobox/Ref.pm b/lib/Moose/Autobox/Ref.pm new file mode 100644 index 0000000..76631b0 --- /dev/null +++ b/lib/Moose/Autobox/Ref.pm @@ -0,0 +1,8 @@ +package Moose::Autobox::Ref; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Defined'; + +1; \ No newline at end of file diff --git a/lib/Moose/Autobox/Scalar.pm b/lib/Moose/Autobox/Scalar.pm new file mode 100644 index 0000000..a5879b0 --- /dev/null +++ b/lib/Moose/Autobox/Scalar.pm @@ -0,0 +1,9 @@ +package Moose::Autobox::Scalar; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Value', + 'Moose::Autobox::Ref'; + +1; \ No newline at end of file diff --git a/lib/Moose/Autobox/Undef.pm b/lib/Moose/Autobox/Undef.pm new file mode 100644 index 0000000..c6af495 --- /dev/null +++ b/lib/Moose/Autobox/Undef.pm @@ -0,0 +1,10 @@ +package Moose::Autobox::Undef; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Item'; + +sub defined { 0 } + +1; \ No newline at end of file diff --git a/lib/Moose/Autobox/Value.pm b/lib/Moose/Autobox/Value.pm new file mode 100644 index 0000000..b9bce83 --- /dev/null +++ b/lib/Moose/Autobox/Value.pm @@ -0,0 +1,8 @@ +package Moose::Autobox::Value; +use Moose::Role 'with'; + +our $VERSION = '0.01'; + +with 'Moose::Autobox::Defined'; + +1; \ No newline at end of file diff --git a/t/000_load.t b/t/000_load.t new file mode 100644 index 0000000..7650751 --- /dev/null +++ b/t/000_load.t @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More no_plan => 1; + +BEGIN { + use_ok('Moose::Autobox'); +} \ No newline at end of file diff --git a/t/001_basic.t b/t/001_basic.t new file mode 100644 index 0000000..9bb67e3 --- /dev/null +++ b/t/001_basic.t @@ -0,0 +1,136 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More no_plan => 1; + +BEGIN { + use_ok('Moose::Autobox'); + use_ok('Moose::Autobox::Undef'); +} + +use autobox UNDEF => 'Moose::Autobox::Undef'; + +# SCALAR & UNDEF + +my $s; +ok(!$s->defined, '... got a undefined value'); + +$s = 5; +ok($s->defined, '... got a defined value'); + +# CODE + +my $f1 = sub { @_ }; +ok($f1->defined, '... created function'); + +my $f2 = eval { $f1->curry(1, 2, 3) }; +ok($f2->defined, '... created curried function'); + +my $f3 = eval { $f1->rcurry(1, 2, 3) }; +ok($f3->defined, '... created right-curried function'); + +is_deeply( +[ $f2->(4, 5, 6) ], +[ 1, 2, 3, 4, 5, 6 ], +'... got the right return value from the curried function'); + +is_deeply( +[ $f3->(4, 5, 6) ], +[ 4, 5, 6, 1, 2, 3 ], +'... got the right return value from the r-curried function'); + +ok((sub { 1 })->disjoin(sub { 0 })->(), '... disjoins properly'); +ok(!(sub { 1 })->conjoin(sub { 0 })->(), '... conjoins properly'); + +#my $compose = (sub { 1, @_ })->compose(sub { 2, @_ }); + +#is_deeply( +#[ $compose->() ], +#[ 1, 2 ], +#'... got the right return value for compose'); + + +# ARRAY + +my $a = [ 4, 2, 6, 78, 101, 2, 3 ]; + +is($a->length, 7, '... got the right length'); +ok($a->defined, '... got the right defined value'); + +is_deeply( +$a->map(sub { $_ + 2 }), +[ map { $_ + 2 } (4, 2, 6, 78, 101, 2, 3) ], +'... got the right return value for map'); + +is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged'); + +is_deeply( +$a->reverse(), +[ 3, 2, 101, 78, 6, 2, 4 ], +'... got the right return value for reverse'); + +is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged'); + +is_deeply( +$a->grep(sub { $_ < 50 }), +[ grep { $_ < 50 } (4, 2, 6, 78, 101, 2, 3) ], +'... got the right return value grep'); + +is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged'); + +is($a->join(', '), '4, 2, 6, 78, 101, 2, 3', '... got the right joined string'); +ok($a->exists(0), '... exists works'); +ok(!$a->exists(10), '... exists works'); + +is($a->pop(), 3, '... got the right pop-ed value'); +is_deeply($a, [ 4, 2, 6, 78, 101, 2 ], '... original value is now changed'); + +is($a->shift(), 4, '... got the right unshift-ed value'); +is_deeply($a, [ 2, 6, 78, 101, 2 ], '... original value is now changed'); + +is_deeply( +$a->unshift(10), +[ 10, 2, 6, 78, 101, 2 ], +'... got the correct unshifted value'); + +is_deeply( +$a->unshift(15, 20, 30), +[ 15, 20, 30, 10, 2, 6, 78, 101, 2 ], +'... got the correct unshifted value (multiple values)'); + +is_deeply( +$a->push(10), +[ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10 ], +'... got the correct pushed value'); + +is_deeply( +$a->push(15, 20, 30), +[ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], +'... got the correct pushed value (multiple values)'); + +is_deeply( +$a->sort(sub { $_[0] <=> $_[1] }), +[ 2, 2, 6, 10, 10, 15, 15, 20, 20, 30, 30, 78, 101 ], +'... got the correct sorted value'); + +is_deeply( +$a, +[ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], +'... the original values are unchanged'); + +is_deeply( +[]->push(10, 20, 30)->map(sub { ($_, $_ + 5) })->reverse, +[ 35, 30, 25, 20, 15, 10 ], +'... got the correct chained value'); + +# Hash + +my $h = { one => 1, two => 2, three => 3 }; + +ok($h->defined, '... got the right defined value'); + + + + diff --git a/t/001_example.t b/t/001_example.t new file mode 100644 index 0000000..e69de29