From: Stevan Little <stevan.little@iinteractive.com>
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?a=commitdiff_plain;h=5f654d8ec893246d215ae8a3b0fa9b467d50b3b9;p=gitmo%2FMoose-Autobox.git

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 E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+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