File Coverage

lib/Badger/Data.pm

Criterion	Covered	Total	%
statement	18	26	69.2
branch	8	20	40.0
condition	5	11	45.4
subroutine	6	10	60.0
pod	9	9	100.0
total	46	76	60.5

#========================================================================
#
# Badger::Data
#
# DESCRIPTION
#   Base class module for objects representing various different data
#   types.
#
# AUTHOR
#   Andy Wardley
#
#========================================================================

package Badger::Data;

use Badger::Class
    version      => 0.01,
    debug        => 0,
    base         => 'Badger::Prototype',
    import       => 'class CLASS',
    utils        => 'md5_hex self_params refaddr',
    auto_can     => 'method',      # anything in $METHODS can become a method
    constants    => 'HASH TRUE FALSE',
    constant     => {
        # tell Badger what class to strip off to generate id()
        base_id  => __PACKAGE__,
        id       => 'type',
    },
    alias        => {
        # alias type() to id() method provided by Badger::Base
        type     => 'id',
    };


# Define a lexical scope with a $METADATA table for storing any out-of-band
# information about text objects.  The methods defined below can be called
# as subroutines (as part of the vmethod mechanism), so the first argument
# can be a non-reference text string in place of the usual $self object
# reference (which itself is just a blessed reference to a scalar text
# string).  To handle this case, we use an md5_hex encoding of the text
# to determine a unique handle for it (or close enough to unique for
# practical purposes)

{
    my $METADATA = { };

    sub metadata {
        my $meta = $METADATA->{
            $_[0] && ref $_[0]
                ? refaddr $_[0]
                : md5_hex $_[0]
        } ||= { };

        # short-cut: return metadata hash when called without arguments
        return $meta if @_ == 1;

        # short-cut: return item in the metadata hash when called with a
        # single (non-hashref) item
        return $meta->{ $_[1] } if @_ == 2 && ref $_[1] ne HASH;

        # add metadata items when called with a HASH ref or multiple args
        my ($self, $params) = self_params(@_);
        @$meta{ keys %$params } = values %$params;
        return $meta;
    }
}

# This is a throwback to the Template::TT3::Type object on which this is
# based... these methods probably won't be staying here - they should be
# in Badger::Data::Type

our $METHODS = {
    method    => \&method,       # TODO: can() as alias to method()?
    methods   => \&methods,
    type      => \&type,
    ref       => \&ref,
    def       => \&defined,
    undef     => \&undefined,
    defined   => \&defined,
    undefined => \&undefined,
    true      => \&true,
    false     => \&false,
};


sub init {
    my ($self, $config) = @_;

    # merge everything in $config into $self for now
    @$self{ keys %$config } = values %$config;

    # merge all config methods with class $METHODS
    $self->{ methods } = $self->class->hash_vars(
        METHODS => $config->{ methods }
    );

    return $self;
}


sub method {
    my $self = shift->prototype;

    # return item from hash or the hash itself when called without arguments
    return @_
        ? $self->{ methods }->{ $_[0] }
        : $self->{ methods };
}


sub methods {
    my $self = shift->prototype;

    # return hash ref when called without argument
    return $self->{ methods } unless @_;

    # add items to hash when called with hash ref or multiple args
    my $items = @_ == 1 && ref $_[0] eq HASH ? shift : { @_ };
    my $hash  = $self->{ methods };
    @$hash{ keys %$items } = values %$items;
    return $hash;
}


sub ref {
    return CORE::ref($_[0]);
}


sub defined {
    CORE::defined $_[0] ? TRUE : FALSE;
}


sub undefined {
    CORE::defined $_[0] ? FALSE : TRUE;
}


sub true {
    $_[0] ? $_[0] : FALSE;
}


sub false {
    $_[0] ? FALSE : TRUE;
}


1;

__END__