元はClass::DBI.

ほとんどコピペじゃねーの
みたいな。
更新系は全部sql書かないといけないし
意味ねーんじゃねーのみたいな
てかお前HASH使いたかっただけちゃうんか
みたいな。
あと命名センスねーよなみたいな。

そんな晒しあげ。

すみません。

華麗にスルーして。

package Hoge::DB;

use base qw/Class::Data::Inheritable/;

use DBI;

use Carp;

use strict;
__PACKAGE__->mk_classdata('__dsn');

__PACKAGE__->mk_classdata('__is_update');

__PACKAGE__->mk_classdata('__table');

__PACKAGE__->mk_classdata('__column');


sub _load_dbh {

    my $self = shift;

    my $dbh = DBI::->connect($self->__dns,{ RaiseError => 1, dbi_connect_method => 'connect' })

    or Carp::croak("!!$self load_dbh_ connect error $DBI::errstr!!");

    return $dbh;

}

sub do_{

    my $self = shift;

    my $sql = shift;

    return undef if(!$sql);

    my @replace;

    if(ref $_[0] eq 'HASH'){

        push @replace,$_[0]{$_} for split /\,/,$self->__column;

    } elsif(ref $_[0] eq 'ARRAY'){

        @replace = @{$_[0]};

    } elsif(@_ > 0){

        @replace = @_;

    }

    $sql = $self->_do_transformation($sql);

    if($sql =~ /^(\s)*(update|insert|delete)/i){

        return undef unless($self->__is_update); #slave

    }

    return $self->do_sql($sql,@replace);

}

sub do_sql{

    my($self,$sql,@replace) = @_;

    my $dbh = $self->_load_dbh;

    my $sth = $dbh->prepare($sql);

    $sth->execute(@replace);

    ##Carp::croak("!!$self transaction aborted because : $@") if($@); 

#なんかmysqlのverによってはcharsetのエラーになることがある。そんなオプションねーよみたいな。

    return $sth;

}
sub retrieve_from_sql{

    my($self,$sql,@replace) = @_;

    return wantarray ? () : undef if(!$sql);

    $sql = $self->_do_transformation($self->_sql_retrieve_from_sql($sql));

    my $entries = $self->do_sql_buffer($sql,@replace);

    return wantarray ? () : undef if(!$entries);

    return wantarray ? @$entries : $entries;

}
sub do_sql_buffer{

    my($self,$sql,@replace) = @_;

    my $dbh = $self->_load_dbh;

    my $sth = $dbh->prepare($sql);

    $sth->execute(@replace);

    return undef if(!$sth->rows);

    my %data;

    my @rows;

    $sth->bind_columns(\(@data{@{$sth->{NAME_lc}}}));

    push @rows,{%data} while $sth->fetch;

    return \@rows;

}
sub search {

    my $sql = shift;

    my $sql = shift;

    return undef if(!$sql);

    my @replace;

    if(ref $_[0] eq 'HASH'){

        push @replace,$_[0]{$_} for split /\,/,$self->__column;

    } elsif(ref $_[0] eq 'ARRAY'){

        @replace = @{$_[0]};

    } elsif(@_ > 0){

        @replace = @_;

    }

    $sql = $self->_do_transformation($self->_sql_retrieve_from_sql($sql));

    my $obj = $self->do_sql_buffer($sql,@replace);

    return undef if(!$obj);

    warn "!!extra inflated object!!" if @$obj > 1;

    return @$obj[0];

}

sub _do_transformation {

    my ( $self, $sql ) = @_;

    $sql =~ s/__TABLE\(?(.*?)\)?__/$self->__table/eg;

    $sql =~ s/__ESSENTIAL\(?(.*)\)?__/$self->__column/eg;

    return $sql;

}

sub _sql_retrieve_from_sql {

    my ($self, $identifier) = @_;

    my $sql = << '__SQL__';

SELECT __ESSENTIAL__

FROM __TABLE__

WHERE %s

__SQL__

    return sprintf($sql,$identifier);

}
1;

__END__

スキーマ定義

package Hoge::Data::Member;

use base qw/Hoge::DB/;

use strict;

__PACKAGE__->__dsn('dbi:mysql:database=member;host=foo');

__PACKAGE__->__table('member');

__PACKAGE__->__is_update(1);

__PACKAGE__->__column('id,name,office,phone');

1;

使用方法。

package main;

use Hoge::Data::Member;
my @entries = Hoge::Data::Member->retrieve_from_sql("member_id = ?",1);

my %hash;

$hash{id} = 1;

$hash{name} = 'stk_kitajima';

$hash{office} = 'おふぃすけろけろ';

$hash{phone} = '0123456789';

Hoge::Data::Member->do_("insert into __TABLE__ ( __ESSENTIAL__ ) values (?,?,?,?)",%hash); #(;´Д｀)ガッカリ感…

おわり。#一部修正動作未確認

タイトルが途中で切れてるけど全然きにしない。