| ... | ... |
@@ -3,81 +3,79 @@ use Object::Simple; |
| 3 | 3 |
use DBI; |
| 4 | 4 |
use SQL::Abstract; |
| 5 | 5 |
|
| 6 |
+# Model |
|
| 7 |
+sub model : ClassAttr { auto_build => \&_inherit_model }
|
|
| 8 |
+ |
|
| 9 |
+# Inherit super class model |
|
| 10 |
+sub _inherit_model {
|
|
| 11 |
+ $class = shict; |
|
| 12 |
+ my $super = do {
|
|
| 13 |
+ no strict 'refs'; |
|
| 14 |
+ ${"${class}::ISA"}[0];
|
|
| 15 |
+ }; |
|
| 16 |
+ my $model = eval{$super->can('model')}
|
|
| 17 |
+ ? $super->model->clone |
|
| 18 |
+ : $class->Object::Simple::new; |
|
| 19 |
+ |
|
| 20 |
+ $class->model($model); |
|
| 21 |
+} |
|
| 22 |
+ |
|
| 23 |
+# New |
|
| 6 | 24 |
sub new {
|
| 7 | 25 |
my $self = shift->Object::Simple::new(@_); |
| 8 | 26 |
my $class = ref $self; |
| 9 |
- return bless {%{$class->model}, %{$self}}, $class;
|
|
| 27 |
+ return bless {%{$class->model->clone}, %{$self}}, $class;
|
|
| 10 | 28 |
} |
| 11 | 29 |
|
| 12 |
-sub create_model {shift->Object::Simple::new(@_);
|
|
| 13 |
- |
|
| 30 |
+# Initialize modle |
|
| 14 | 31 |
sub initialize_model {
|
| 15 | 32 |
my ($class, $callback) = @_; |
| 16 | 33 |
|
| 17 |
- my $model = $class->create_model; |
|
| 18 |
- |
|
| 19 |
- $callback->($model); |
|
| 20 |
- |
|
| 21 |
- $class->model($model); |
|
| 22 |
-} |
|
| 23 |
- |
|
| 24 |
-# Class attribute |
|
| 25 |
-sub connect_info : Attr { type => 'hash' }
|
|
| 26 |
-sub table_infos : Attr { type => 'hash' }
|
|
| 27 |
-sub dbh : Attr {}
|
|
| 28 |
-sub sql_abstract : Attr { auto_build => sub { shift->sql_abstract(SQL::Abstract->new) }}
|
|
| 29 |
- |
|
| 30 |
-sub column_info {
|
|
| 31 |
- my ($self, $table, $column_name, $column_info) = @_; |
|
| 32 |
- |
|
| 33 |
- if (@_ > 3) {
|
|
| 34 |
- $self->table_infos->{$table}{column}{$column_name} = $column_info;
|
|
| 35 |
- return $self; |
|
| 36 |
- } |
|
| 37 |
- return $self->table_infos->{$table}{column}{$column_name};
|
|
| 34 |
+ # Callback to initialize model |
|
| 35 |
+ $callback->($class->model); |
|
| 38 | 36 |
} |
| 39 | 37 |
|
| 40 |
-sub columns {
|
|
| 41 |
- my ($self, $table) = @_; |
|
| 42 |
- |
|
| 43 |
- return sort {
|
|
| 44 |
- $self->table_infos->{$table}{column}{$a}{pos}
|
|
| 45 |
- <=> |
|
| 46 |
- $self->table_infos->{$table}{column}{$b}{pos}
|
|
| 47 |
- } keys %{$self->table_info->{$table}{column}}
|
|
| 48 |
-} |
|
| 49 |
- |
|
| 50 |
-sub tables {
|
|
| 38 |
+# Clone |
|
| 39 |
+sub clone {
|
|
| 51 | 40 |
my $self = shift; |
| 52 |
- return keys %{$self->table_info};
|
|
| 53 |
-} |
|
| 54 |
- |
|
| 55 |
-sub create_table {
|
|
| 56 |
- my ($self, $table, @row_infos) = @_; |
|
| 41 |
+ my $new = $self->Object::Simple::new; |
|
| 42 |
+ $new->connect_infos(%{$self->connect_infos || {}});
|
|
| 43 |
+ $new->filters(%{$self->filters || {}});
|
|
| 57 | 44 |
|
| 58 |
- $self->table_infos->{$table} = {};
|
|
| 45 |
+ $new->global_bind_rules(@{$self->global_bind_rules || []});
|
|
| 46 |
+ $new->global_fetch_rules(@{$self->global_fetch_rules || []});
|
|
| 59 | 47 |
|
| 60 |
- for (my $i = 0; $i < @columns; i++) {
|
|
| 61 |
- my $column = $columns[$i]; |
|
| 62 |
- |
|
| 63 |
- my $column_name = shift @$column; |
|
| 64 |
- my $column_type = shift @$column; |
|
| 65 |
- my %column_options = @$column; |
|
| 66 |
- |
|
| 67 |
- my $column_info = {};
|
|
| 68 |
- |
|
| 69 |
- $column_info->{pos} = $i;
|
|
| 70 |
- $column_info->{type} = $column_type;
|
|
| 71 |
- $column_info->{options} = \%column_options;
|
|
| 72 |
- |
|
| 73 |
- $self->column_info($table, $column_name, $column_info); |
|
| 48 |
+ foreach my $method (qw/bind_rules fetch_rules/) {
|
|
| 49 |
+ my $new_rules = []; |
|
| 50 |
+ foreach my $rule (@{$self->method}) {
|
|
| 51 |
+ my $new_rule = {};
|
|
| 52 |
+ foreach my $key ($rule) {
|
|
| 53 |
+ if ($key eq 'filter') {
|
|
| 54 |
+ my $new_filters = []; |
|
| 55 |
+ foreach my $filter (@{$rule->{$key} || []}) {
|
|
| 56 |
+ push @$new_filters, $filter |
|
| 57 |
+ } |
|
| 58 |
+ $new_rule->{$key} = $new_filters;
|
|
| 59 |
+ } |
|
| 60 |
+ else {
|
|
| 61 |
+ $new_rule->{$key} = $rule->{$key};
|
|
| 62 |
+ } |
|
| 63 |
+ } |
|
| 64 |
+ push @$new_rules, $new_rule; |
|
| 65 |
+ } |
|
| 66 |
+ $self->$method($new_rules); |
|
| 74 | 67 |
} |
| 75 | 68 |
} |
| 76 | 69 |
|
| 77 |
-sub load_table_definitions {
|
|
| 78 |
- my $self = shift; |
|
| 79 |
- my $dsn = $self->connect_info->{dsn};
|
|
| 80 |
-} |
|
| 70 |
+# Attribute |
|
| 71 |
+sub connect_info : Attr { type => 'hash', auto_build => sub { shift->connect_info({}) } }
|
|
| 72 |
+sub global_bind_rules : Attr { type => 'array', auto_build => sub { shift->global_bind_rules([]) } }
|
|
| 73 |
+sub global_fetch_rules : Attr { type => 'array', auto_build => sub { shift->global_fetch_rules([]) } }
|
|
| 74 |
+sub bind_rules : Attr { type => 'hash', auto_build => sub { shift->bind_rules({}) }
|
|
| 75 |
+sub fetch_rules : Attr { type => 'hash', auto_build => sub { shift->fetch_rules({}) }
|
|
| 76 |
+ |
|
| 77 |
+sub dbh : Attr { auto_build => sub { shift->connect } }
|
|
| 78 |
+sub sql_abstract : Attr { auto_build => sub { shift->sql_abstract(SQL::Abstract->new) }}
|
|
| 81 | 79 |
|
| 82 | 80 |
sub connect {
|
| 83 | 81 |
my $self = shift; |