From: Stevan Little <stevan.little@iinteractive.com>
Date: Mon, 5 Jun 2006 04:54:34 +0000 (+0000)
Subject: autoboxing
X-Git-Tag: 0_02~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6cf5bcf23399cc82e234f91a2e78f262bf70eab1;p=gitmo%2FMoose-Autobox.git

autoboxing
---

diff --git a/lib/Moose/Autobox.pm b/lib/Moose/Autobox.pm
index 1967bfe..967778e 100644
--- a/lib/Moose/Autobox.pm
+++ b/lib/Moose/Autobox.pm
@@ -9,8 +9,8 @@ use Scalar::Util ();
 
 our $VERSION = '0.01';
             
-sub import {
-    eval q|
+#sub import {
+#    eval q|
 package SCALAR;
 use Moose;
 with 'Moose::Autobox::Scalar';
@@ -26,9 +26,9 @@ with 'Moose::Autobox::Hash';
 package CODE;
 use Moose;
 with 'Moose::Autobox::Code';    
-    |;
-    confess 'Could not create autobox packages because - ' . $@ if $@;
-}               
+#    |;
+#    confess 'Could not create autobox packages because - ' . $@ if $@;
+#}               
 
 1;
 
diff --git a/lib/Moose/Autobox/Array.pm b/lib/Moose/Autobox/Array.pm
index 6144e6f..a33c1b5 100644
--- a/lib/Moose/Autobox/Array.pm
+++ b/lib/Moose/Autobox/Array.pm
@@ -6,8 +6,45 @@ our $VERSION = '0.01';
 
 with 'Moose::Autobox::Ref',
      'Moose::Autobox::List';
+    
+## Array Interface
+
+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; 
+}
 
-## List interface
+sub delete { 
+    my ($array, $index) = @_;    
+    CORE::delete $array->[$index];
+}
+
+sub shift { 
+    my ($array) = @_;    
+    CORE::shift @$array; 
+}     
+
+# NOTE: 
+# sprintf args need to be reversed, 
+# because the invocant is the array
+sub sprintf { CORE::sprintf $_[1], @{$_[0]} }
+
+## ::List interface implementation
+
+sub head { $_[0]->[0] }
+sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] }
  
 sub length {
     my ($array) = @_;
@@ -41,28 +78,16 @@ sub sort {
     [ CORE::sort { $sub->($a, $b) } @$array ]; 
 }    
 
-# ...
+# ::Value requirement
 
-sub reduce {
-    my ($array, $func) = @_;
-    my $a = $array->values;
-    my $acc = $a->shift;
-    $a->map(sub { $acc = $func->($acc, $_) });
-    return $acc;
-}
+sub print { CORE::print @{$_[0]} }
 
-sub zip {
-    my ($array, $other) = @_;
-    ($array->length < $other->length 
-        ? $other 
-        : $array)
-            ->keys
-            ->map(sub {
-                [ $array->[$_], $other->[$_] ]
-            });
-}
+## ::Indexed implementation
 
-## 
+sub exists {
+    my ($array, $index) = @_;    
+    CORE::exists $array->[$index];    
+}
 
 sub keys { 
     my ($array) = @_;    
@@ -79,37 +104,4 @@ sub kv {
     $array->keys->map(sub { [ $_, $array->[$_] ] });
 }
 
-## Array Interface
-
-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/Defined.pm b/lib/Moose/Autobox/Defined.pm
index 210b22b..a71010a 100644
--- a/lib/Moose/Autobox/Defined.pm
+++ b/lib/Moose/Autobox/Defined.pm
@@ -7,10 +7,4 @@ with 'Moose::Autobox::Item';
             
 sub defined { 1 }
 
-sub do { 
-    my ($self, $block) = @_;
-    local $_ = $self;
-    $block->($self);
-}
-
 1;
\ No newline at end of file
diff --git a/lib/Moose/Autobox/Hash.pm b/lib/Moose/Autobox/Hash.pm
index 52238c7..50d77dc 100644
--- a/lib/Moose/Autobox/Hash.pm
+++ b/lib/Moose/Autobox/Hash.pm
@@ -3,7 +3,15 @@ use Moose::Role 'with';
 
 our $VERSION = '0.01';
 
-with 'Moose::Autobox::Ref';
+with 'Moose::Autobox::Ref',
+     'Moose::Autobox::Indexed';
+
+sub delete { 
+    my ($hash, $key) = @_;
+    CORE::delete $hash->{$key}; 
+}
+
+# ::Indexed implementation
 
 sub exists { 
     my ($hash, $key) = @_;
diff --git a/lib/Moose/Autobox/Indexed.pm b/lib/Moose/Autobox/Indexed.pm
new file mode 100644
index 0000000..9b923cf
--- /dev/null
+++ b/lib/Moose/Autobox/Indexed.pm
@@ -0,0 +1,8 @@
+package Moose::Autobox::Indexed;     
+use Moose::Role 'requires';
+
+our $VERSION = '0.01';
+
+requires qw/exists keys values kv/;
+
+1;
\ No newline at end of file
diff --git a/lib/Moose/Autobox/List.pm b/lib/Moose/Autobox/List.pm
index 0569854..4431dc1 100644
--- a/lib/Moose/Autobox/List.pm
+++ b/lib/Moose/Autobox/List.pm
@@ -1,19 +1,38 @@
 
 package Moose::Autobox::List;
 use Moose::Role 'with', 'requires';
+use autobox;
 
 our $VERSION = '0.01';
 
-with 'Moose::Autobox::Value';
+with 'Moose::Autobox::Indexed';
 
 requires qw/
+    head
+    tail
     length 
     join     
     grep map sort
     reverse
-    reduce
-    zip
 /;
 
+sub reduce {
+    my ($array, $func) = @_;
+    my $a = $array->values;
+    my $acc = $a->head;
+    $a->tail->map(sub { $acc = $func->($acc, $_) });
+    return $acc;
+}
+
+sub zip {
+    my ($array, $other) = @_;
+    ($array->length < $other->length 
+        ? $other 
+        : $array)
+            ->keys
+            ->map(sub {
+                [ $array->[$_], $other->[$_] ]
+            });
+}
 
 1;
\ No newline at end of file
diff --git a/lib/Moose/Autobox/Ref.pm b/lib/Moose/Autobox/Ref.pm
index 76631b0..a5221d6 100644
--- a/lib/Moose/Autobox/Ref.pm
+++ b/lib/Moose/Autobox/Ref.pm
@@ -5,4 +5,6 @@ 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
index b0307ab..dc8a12d 100644
--- a/lib/Moose/Autobox/Scalar.pm
+++ b/lib/Moose/Autobox/Scalar.pm
@@ -3,6 +3,11 @@ use Moose::Role 'with';
 
 our $VERSION = '0.01';
 
-with 'Moose::Autobox::Value';
+with 'Moose::Autobox::Value',
+     'Moose::Autobox::String';
+
+# ::Value requirement     
+     
+sub print { CORE::print $_[0] }
      
 1;
\ No newline at end of file
diff --git a/lib/Moose/Autobox/String.pm b/lib/Moose/Autobox/String.pm
new file mode 100644
index 0000000..1a57f4a
--- /dev/null
+++ b/lib/Moose/Autobox/String.pm
@@ -0,0 +1,21 @@
+package Moose::Autobox::String;
+use Moose::Role;
+
+our $VERSION = '0.01';
+
+# perl built-ins
+
+sub lc      { CORE::lc      $_[0] }
+sub lcfirst { CORE::lcfirst $_[0] }
+sub uc      { CORE::uc      $_[0] }
+sub ucfirst { CORE::ucfirst $_[0] }
+sub chomp   { CORE::chomp   $_[0] }
+sub chop    { CORE::chop    $_[0] }
+sub reverse { CORE::reverse $_[0] }
+sub length  { CORE::length  $_[0] }
+sub index   { CORE::index   $_[0], $_[1], (defined $_[2] ? $_[2] : ()) }
+
+# FIXME: this is not working 
+#sub rindex  { CORE::rindex  $_[0], $_[1], (defined $_[2] ? $_[2] : ()) }
+     
+1;
\ No newline at end of file
diff --git a/lib/Moose/Autobox/Value.pm b/lib/Moose/Autobox/Value.pm
index b9bce83..4121148 100644
--- a/lib/Moose/Autobox/Value.pm
+++ b/lib/Moose/Autobox/Value.pm
@@ -1,8 +1,16 @@
 package Moose::Autobox::Value;     
-use Moose::Role 'with';
+use Moose::Role 'with', 'requires';
 
 our $VERSION = '0.01';
 
 with 'Moose::Autobox::Defined';
 
+requires 'print';
+
+sub do { 
+    my ($self, $block) = @_;
+    local $_ = $self;
+    $block->($self);
+}
+
 1;
\ No newline at end of file
diff --git a/t/001_basic.t b/t/001_basic.t
index 8bd55e5..3cba7b3 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -167,5 +167,3 @@ $h->values->sort,
 
 ok($h->exists('two'), '... exists works');
 ok(!$h->exists('five'), '... !exists works');
-
-
diff --git a/t/002_example.t b/t/002_example.t
index cd7c7d4..553950d 100644
--- a/t/002_example.t
+++ b/t/002_example.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 18;
+use Test::More tests => 20;
 
 BEGIN {
     use_ok('Moose::Autobox');
@@ -16,11 +16,13 @@ ok(SCALAR->does('Moose::Autobox::Scalar'),      '... SCALAR does Moose::Autobox:
       
 ok(ARRAY->does('Moose::Autobox::Array'),        '... ARRAY does Moose::Autobox::Array');
   ok(ARRAY->does('Moose::Autobox::List'),       '... ARRAY does Moose::Autobox::List');
+    ok(ARRAY->does('Moose::Autobox::Indexed'),  '... ARRAY does Moose::Autobox::Indexed');  
   ok(ARRAY->does('Moose::Autobox::Ref'),        '... ARRAY does Moose::Autobox::Ref');
     ok(ARRAY->does('Moose::Autobox::Defined'),  '... ARRAY does Moose::Autobox::Defined');
       ok(ARRAY->does('Moose::Autobox::Item'),   '... ARRAY does Moose::Autobox::Item');      
       
 ok(HASH->does('Moose::Autobox::Hash'),          '... HASH does Moose::Autobox::Hash');
+  ok(HASH->does('Moose::Autobox::Indexed'),     '... HASH does Moose::Autobox::Indexed');  
   ok(HASH->does('Moose::Autobox::Ref'),         '... HASH does Moose::Autobox::Ref');
     ok(HASH->does('Moose::Autobox::Defined'),   '... HASH does Moose::Autobox::Defined');
       ok(HASH->does('Moose::Autobox::Item'),    '... HASH does Moose::Autobox::Item');
@@ -28,4 +30,8 @@ ok(HASH->does('Moose::Autobox::Hash'),          '... HASH does Moose::Autobox::H
 ok(CODE->does('Moose::Autobox::Code'),          '... CODE does Moose::Autobox::Code');
   ok(CODE->does('Moose::Autobox::Ref'),         '... CODE does Moose::Autobox::Ref');
     ok(CODE->does('Moose::Autobox::Defined'),   '... CODE does Moose::Autobox::Defined');
-      ok(CODE->does('Moose::Autobox::Item'),    '... CODE does Moose::Autobox::Item');      
\ No newline at end of file
+      ok(CODE->does('Moose::Autobox::Item'),    '... CODE does Moose::Autobox::Item'); 
+
+
+
+     
\ No newline at end of file
diff --git a/t/004_list_compressions.t b/t/004_list_compressions.t
index d97775f..ebbaef4 100644
--- a/t/004_list_compressions.t
+++ b/t/004_list_compressions.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 5;
 
 BEGIN {
     use_ok('Moose::Autobox');
@@ -19,4 +19,20 @@ is_deeply(
 is_deeply(
 [ 1 .. 5 ]->map(sub { $_ * $_ })->do(sub { $_->zip($_) }),
 [ [1, 1], [4, 4], [9, 9], [16, 16], [25, 25] ],
-'... got the expected return values');
\ No newline at end of file
+'... got the expected return values');
+
+is( # sprintf an array ...
+[ 1 .. 5 ]->sprintf("%d -> %d -> %d"),
+'1 -> 2 -> 3',
+'... got the sprintf-ed values');
+
+is( # sprintf an array ...
+[ 1 .. 5 ]->do(sub {
+    $_->sprintf(
+        $_->keys
+          ->map(sub { '%d (' . $_ . ')' })
+          ->join(' -> '))
+}),
+'1 (0) -> 2 (1) -> 3 (2) -> 4 (3) -> 5 (4)',
+'... got a more elaboratly sprintf-ed values');
+
diff --git a/t/005_string.t b/t/005_string.t
new file mode 100644
index 0000000..3926a38
--- /dev/null
+++ b/t/005_string.t
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 15;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose::Autobox');
+}
+
+use autobox;
+
+is('Hello World'->lc, 'hello world', '... $str->lc');
+is('Hello World'->uc, 'HELLO WORLD', '... $str->uc');
+
+is('foo'->ucfirst, 'Foo', '... $str->ucfirst');
+is('Foo'->lcfirst, 'foo', '... $str->lcfirst');
+
+dies_ok { ('Hello')->chop } '... cannot modify a read-only';
+{
+    my $greeting = 'Hello';
+    is($greeting->chop, 'o', '... got the chopped off portion of the string');
+    is($greeting, 'Hell', '... and are left with the rest of the string');
+}
+
+dies_ok { "Hello\n"->chomp } '... cannot modify a read-only';
+{
+    my $greeting = "Hello\n";
+    is($greeting->chomp, '1', '... got the chopped off portion of the string');
+    is($greeting, 'Hello', '... and are left with the rest of the string');
+}
+
+is('reverse'->reverse, 'esrever', '... got the string reversal');
+is('length'->length, 6, '... got the string length');
+
+is('Hello World'->index('World'), 6, '... got the correct index');
+
+is('Hello World, Hello'->index('Hello'), 0, '... got the correct index');
+
+#is('Hello World, Hello'->rindex('World'), 13, '... got the correct right index');
+#diag CORE::rindex('Hello World, Hello', 'Hello');