File Coverage

blib/lib/Data/Mapper.pm

Criterion	Covered	Total	%
statement	24	99	24.2
branch	0	30	0.0
condition	0	6	0.0
subroutine	8	20	40.0
pod	5	12	41.6
total	37	167	22.1

package Data::Mapper;
use 5.008001;
use strict;
use warnings;
use parent qw(Data::Mapper::Class);

our $VERSION = '0.06';

use Carp         ();
use Scalar::Util ();
use Class::Load  ();

use Data::Mapper::Data;

sub create {
    my $self = shift;
    my $name = shift;
    my $data = $self->adapter->create($name => @_);

    $self->map_data($name, $data);
}

sub find {
    my $self = shift;
    my $name = shift;
    my $data = $self->adapter->find($name => @_);

    $data && $self->map_data($name, $data);
}

sub search {
    my $self = shift;
    my $name = shift;
    my $data = $self->adapter->search($name => @_);

    die 'results returned from search() method must be an ArrayRef'
        if ref $data ne 'ARRAY';

    my @result;
    push @result, $self->map_data($name, $_) for @$data;

    \@result;
}

sub update {
    my ($self, $data) = @_;
    my $result;
    my $has_changes = $data->isa('Data::Mapper::Data');

    return if $has_changes && not $data->is_changed;

    my $params = $self->mapped_params($data);
    $result = $self->adapter->update(
        $params->{table} => $params->{set} => $params->{where}
    );

    $data->discard_changes if $has_changes;

    $result;
}

sub delete  {
    my ($self, $data) = @_;
    my $params = $self->mapped_params($data);
    $self->adapter->delete($params->{table} => $params->{where});
}

sub adapter {
    my ($self, $adapter) = @_;
    $self->{adapter} = $adapter if defined $adapter;
    $self->{adapter} || die 'You must set an adapter first';
}

our %DATA_CLASSES = ();
sub data_class {
    my ($self, $name) = @_;

    $DATA_CLASSES{ref $self}{$name} ||= do {
        my $data_class = join '::', (ref $self), 'Data', $self->to_class_name($name);

        eval { Class::Load::load_class($data_class) };
        Carp::croak("no such data class: $data_class for $name") if $@;

        $data_class;
    }
}

### PRIVATE_METHODS ###

sub to_class_name {
    my ($self, $name) = @_;
    return $name if !$name;

    my @parts = split /_/, $name;
    join '', (map { ucfirst } @parts);
}

sub to_table_name {
    my ($self, $data) = @_;
    my ($table) = ((ref $data) =~ /::([^:]+)$/);

    $table =~ s/([A-Z])/'_' . lc $1/eg;
    $table =~ s/^_//;
    $table;
}

sub as_serializable {
    my ($self, $data) = @_;
    +{
        map { $_ => $data->{$_} } grep { !/^_/ } keys %$data
    };
}

sub map_data {
    my ($self, $name, $data) = @_;
    my $data_class = $self->data_class($name);

    if (Scalar::Util::blessed($data)) {
        if ($data->can('as_serializable')) {
            $data = $data->as_serializable;
        }
        elsif (Scalar::Util::reftype($data) eq 'HASH') {
            $data = $self->as_serializable($data);
        }
        else {
            Carp::croak('$data must be either a Hash-based object or a plain HashRef');
        }
    }

    $data_class->new($data);
}

sub mapped_params {
    my ($self, $data) = @_;
    my $table  = $self->to_table_name($data);
    my $schema = $self->adapter->schemata->{$table}
        or Carp::croak("no such table: $table");

    my $primary_keys = $schema->primary_keys;
    die "Data::Mapper doesn't support tables which have no primary keys"
        if !scalar @$primary_keys;

    my $result = { set => {}, where => {}, table => $table };

    # Data::Mapper::Data-based object
    if ($data->isa('Data::Mapper::Data')) {
        $result->{set} = $data->changes;

        for my $key (@$primary_keys) {
            $result->{where}{$key} = $data->param($key);
        }
    }

    # Hash-based POPO
    else {
        $result->{set} = $self->as_serializable($data);

        for my $key (@$primary_keys) {
            $result->{where}{$key} = $data->{$key};
        }
    }

    Carp::croak("where clause is empty")
        if !keys %{$result->{where}};

    $result;
}

!!1;

__END__