view release on metacpan or  search on metacpan

lib/Data/Mapper.pm  view on Meta::CPAN

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;
}