stk_kitajimaの日記

元はClass::DBI.

ほとんどコピペじゃねーの

みたいな。

更新系は全部sql書かないといけないし

意味ねーんじゃねーのみたいな

てかお前HASH使いたかっただけちゃうんか

みたいな。

あと命名センスねーよなみたいな。

そんな晒しあげ。

すみません。

華麗にスルーして。

package Hoge::DB;
use base qw/Class::Data::Inheritable/;
use DBI;
use Carp;
use strict;

__PACKAGE__->mk_classdata('__dns');
__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__->__dns('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); #(;´Д｀)ガッカリ感…

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