our $VERSION = '0.01';
-sub import {
- eval q|
+#sub import {
+# eval q|
package SCALAR;
use Moose;
with 'Moose::Autobox::Scalar';
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;
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) = @_;
[ 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) = @_;
$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;
sub defined { 1 }
-sub do {
- my ($self, $block) = @_;
- local $_ = $self;
- $block->($self);
-}
-
1;
\ No newline at end of file
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) = @_;
--- /dev/null
+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
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
with 'Moose::Autobox::Defined';
+
+
1;
\ No newline at end of file
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
--- /dev/null
+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
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
ok($h->exists('two'), '... exists works');
ok(!$h->exists('five'), '... !exists works');
-
-
use strict;
use warnings;
-use Test::More tests => 18;
+use Test::More tests => 20;
BEGIN {
use_ok('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');
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
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More tests => 5;
BEGIN {
use_ok('Moose::Autobox');
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');
+
--- /dev/null
+#!/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');
projects / gitmo/Moose-Autobox.git / commitdiff