File Coverage

blib/lib/Class/Builtin/Hash.pm

Criterion	Covered	Total	%
statement	34	78	43.5
branch	0	6	0.0
condition	1	3	33.3
subroutine	11	25	44.0
pod	1	20	5.0
total	47	132	35.6

package Class::Builtin::Hash;
use 5.008001;
use warnings;
use strict;
our $VERSION = sprintf "%d.%02d", q$Revision: 0.3 $ =~ /(\d+)/g;

use Carp;

use overload (
    '""' => \&Class::Builtin::Hash::dump,
);

sub new{
    my $class = shift;
    my $href  = shift;
    my %self;
    while(my ($k, $v) = each %$href){
	$self{$k} = Class::Builtin->new($v);
    }
    bless \%self, $class;
}

sub clone{
    __PACKAGE__->new({ %{$_[0]} });
}

sub get { $_[0]->{ $_[1] } }

sub set { $_[0]->{ $_[1] } = Class::Builtin->new( $_[2] ) }

sub unbless {
    my $self = shift;
    my %hash;
    while(my ($k, $v) = each %$self){
	$hash{$k} = eval { $v->can('unbless') } ? $v->unbless: $v;
    }
    \%hash;
}

sub dump {
    local ($Data::Dumper::Terse)  = 1;
    local ($Data::Dumper::Indent) = 0;
    local ($Data::Dumper::Useqq)  = 1;
    sprintf 'OO(%s)', Data::Dumper::Dumper($_[0]->unbless);
}

sub delete {
    my $self = shift;
    my @deleted = CORE::delete @{$self}{@_};
    Class::Builtin::Array->new([@deleted]);
}

sub exists {
    my $self = shift;
    my $key  = shift;
    CORE::exists $self->{$key}
}

for my $meth (qw/keys values/){
    eval qq{
      sub Class::Builtin::Hash::$meth
      {
        Class::Builtin::Array->new([CORE::$meth \%{\$_[0]}])
      }
    };
    croak $@ if $@;
}

sub length{
    CORE::length keys %{$_[0]};
}

sub each {
    my $self = shift;
    my $block = shift || croak;
    while (my ($k, $v) = each %$self){
	$block->($k, $v);
    }
}

sub print {
    my $self = shift;
    @_ ? CORE::print {$_[0]} %$self : CORE::print %$self;
}

sub say {
    my $self = shift;
    local $\ = "\n";
    local $, = ",";
    @_ ? CORE::print {$_[0]} %$self : CORE::print %$self;
}



sub methods {
    Class::Builtin::Array->new(
        [ sort grep { defined &{$_} } keys %Class::Builtin::Hash:: ] );
}

# Scalar::Util related
for my $meth (qw/blessed isweak refaddr reftype weaken/){
    eval qq{
      sub Class::Builtin::Hash::$meth
      {
	my \$self = CORE::shift;
	my \$ret  = Scalar::Util::$meth(\$self);
	__PACKAGE__->new(\$ret);
      }
    };
    croak $@ if $@;
}

1; # End of Class::Builtin::Hash

=head1 NAME

Class::Builtin::Hash - Hash as an object

=head1 VERSION

$Id: Hash.pm,v 0.3 2009/06/22 15:52:18 dankogai Exp $

=head1 SYNOPSIS

  use Class::Builtin::Hash;                             # use Class::Builtin;
  my $oo = Class::Builtin::Hash->new({key => 'value'}); # OO({key =>'value'});
  print $oo->keys->[0]; # 'key'

=head1 EXPORT

None.  But see L

=head1 METHODS

This section is under construction. For the time being, try

  print Class::Builtin::Hash->new({})->methods->join("\n")

=head1 TODO

This section itself is to do :)

=over 2

=item * more methods

=back

=head1 SEE ALSO

L, L, L L

=head1 AUTHOR

Dan Kogai, C<<  >>

=head1 ACKNOWLEDGEMENTS

L, L, L

=head1 COPYRIGHT & LICENSE

Copyright 2009 Dan Kogai, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut