Class::DBIのカラムマッピング

Perl

このような表題でいいのかわかりませんが、
あるカラムのコードに対する名称をマッピングしたい場合以下のように実装してみました。

テーブル構成



 create table shiharai (

     code_id int(2) NOT NULL,

     PRIMARY KEY(code_id)

 )

 +---------+--------+------+-----+---------+-------+

 | Field   | Type   | Null | Key | Default | Extra |

 +---------+--------+------+-----+---------+-------+

 | code_id | int(2) |      | PRI | 0       |       |

 +---------+--------+------+-----+---------+-------+

 insert into shiharai values (1);

 insert into shiharai values (2);

 insert into shiharai values (3);

 +---------+

 | code_id |

 +---------+

 |       1 |

 |       2 |

 |       3 |

 +---------+

こんなテーブル構成ありえないのですが、実験ですので＾＾；

で、マッピングモジュールは



package Shiharai;

use strict;

use warnings;

use base 'Class::DBI';

__PACKAGE__->connection('dbi:mysql:nekodb','nekokak','******');

__PACKAGE__->columns( Primary   => qw[ code_id ]);

__PACKAGE__->has_a(

    code_id => 'MappingSIHARAI',

    inflate => sub { MappingSIHARAI->set_name(shift) },

);

1;

code_idへマッピングするモジュールは



package MappingSIHARAI;

use strict;

use warnings;

our %SIHARAI = (

 "1" => "カード",

 "2" => "コンビニ",

 "3" => "銀行振込",

);

our $NAME;

sub new {

    my $class = shift;

    my $self = {};

    bless($self,$class);

    $self;

}

sub set_name {

    my $self = shift;

    my $code = shift;

    $NAME = $SIHARAI{$code};

    return;

}

sub get_name {

    $NAME;

}

1;

テストスクリプトは



#! /usr/bin/perl

use strict;

use warnings;

use Shiharai;

my $it = Shiharai->retrieve_all;

while (my $line = $it->next) {

    print $line->code_id->get_name,"\n";

}

こんなのです。

いかかでしょうか？
実行結果は



カード

コンビニ

銀行振込

と表示されます。

処理の実行順は、

１、retrieve_allの実行
２、inflateの実行
３、nextの実行の時点でMappingSIHARAIがnewされる
４、get_nameの実行

こんな感じでした。


ちなみに、MappingSIHARAIのset_nameメソッドを



sub set_name {

    my $self = shift;

    my $code = shift;

    $NAME = $SIHARAI{$code};

    $NAME;

}

このようにすると、テストスクリプト側では、



$line->code_id->[0]

これでアクセスできます。