root/lang/perl/Data-Model/trunk/lib/Data/Model/Schema/Properties.pm @ 30388

Revision 30388, 10.4 kB (checked in by yappo, 5 years ago)

fixed bug to bind_param for $sth on delete/update/select query

Line 
1package Data::Model::Schema::Properties;
2use strict;
3use warnings;
4use base qw(Data::Model::Accessor);
5
6use Class::Trigger qw( pre_insert pre_save post_save post_load pre_update pre_inflate post_inflate pre_deflate post_deflate );
7use Encode ();
8
9use Data::Model::Schema;
10use Data::Model::Schema::Inflate;
11use Data::Model::Schema::SQL;
12
13__PACKAGE__->mk_accessors(qw/ driver schema_class model class column index unique key options has_inflate has_deflate alias_column aluas_column_revers_map /);
14
15
16our @RESERVED = qw(
17    update save new
18    add_trigger call_trigger remove_trigger
19);
20
21
22sub new {
23    my($class, %args) = @_;
24    bless { %args }, $class;
25}
26
27sub new_obj {
28    my $self = shift;
29    $self->{class}->new(@_);
30}
31
32sub add_keys {
33    my($self, $key, %args) = @_;
34    $self->{key} = ref($key) eq 'ARRAY' ? $key : [ $key ];
35}
36
37BEGIN {
38    for my $name (qw/ unique index /) {
39        no strict 'refs';
40        *{"add_$name"} = sub {
41            my($self, $index, $columns, %args) = @_;
42            my $key = $columns || $index;
43            die sprintf '%s::%s : %s name is require', $self->schema_class, $self->name, $name
44                if ref($index) || !defined $index;
45            $key = [ $key ] unless ref($key) eq 'ARRAY';
46            $self->{$name}->{$index} = $key;
47        };
48    }
49}
50
51sub add_column {
52    my $self = shift;
53    my($column, $type, $options) = @_;
54    return $self->add_column_sugar(@_) if $column =~ /^[^\.+]+\.[^\.+]+$/;
55    Carp::croak "Column can't be called '$column': reserved name"
56            if grep { lc $_ eq lc $column } @RESERVED;
57
58    push @{ $self->{columns} }, $column;
59    $self->{column}->{$column} = +{
60        type    => $type    || 'char',
61        options => $options || +{},
62    };
63}
64sub add_utf8_column {
65    my $self = shift;
66    my($name) = @_;
67
68    my($suger_model, $suger_name) = split '\.', $name;
69    $name = $suger_name if $suger_name;
70
71    $self->{utf8_columns}->{$name} = 1;
72    $self->add_column(@_);
73}
74
75sub add_alias_column {
76    my $self = shift;
77    my($base_name, $alias_name, $args) = @_;
78    $self->{aluas_column_revers_map}->{$base_name} ||= [];
79    push @{ $self->{aluas_column_revers_map}->{$base_name} }, $alias_name;
80    $self->{alias_column}->{$alias_name} = +{
81        %{ $args || {} },
82        base    => $base_name,
83    };
84}
85
86sub add_column_sugar {
87    my $self   = shift;
88    my $name   = shift;
89    my $sugar = Data::Model::Schema->get_column_sugar($self);
90    Carp::croak "Undefined column of '$name'"
91        unless exists $sugar->{$name} && $sugar->{$name};
92
93    my $conf = $sugar->{$name};
94    my %clone = (
95        type    => $conf->{type},
96        options => +{ %{ $conf->{options} } },
97    );
98    my $column;
99    if (@_ == 0 || ref($_[0])) {
100        my $model;
101        ($model, $column) = split /\./, $name;
102        unless ($self->{model} eq $model) {
103            $column = join '_', $model, $column;
104        }
105    } else {
106        $column = shift;
107    }
108    if (@_ && ref($_[0]) eq 'HASH') {
109        $clone{options} = +{ %{ $clone{options} }, %{ ( shift ) } }
110    }
111    if (my $alias_args = delete $clone{options}->{alias}) {
112        my $rename_map = delete $clone{options}->{alias_rename} || {};
113        while (my($alias_name, $args) = each %{ $alias_args }) {
114            $self->add_alias_column($column, $rename_map->{$alias_name} || $alias_name, $args);
115        }
116    }
117    $self->add_column($column, $clone{type}, $clone{options});
118}
119
120sub add_options {
121    my $self = shift;
122    if (ref($_[0]) eq 'HASH') {
123        $self->{options} = shift;
124    } elsif (!(@_ % 2)) {
125        while (my($key, $value) = splice @_, 0, 2) {
126            $self->{options}->{$key} = $value;
127        }
128    }
129}
130
131sub column_names {
132    my $self = shift;
133    @{ $self->{columns} };
134}
135
136sub column_type {
137    my($self, $column) = @_;
138    return 'char' unless $column && $self->{column}->{$column} && $self->{column}->{$column}->{type};
139    $self->{column}->{$column}->{type};
140}
141sub column_options {
142    my($self, $column) = @_;
143    $self->{column}->{$column}->{options} || +{};
144}
145
146sub setup_inflate {
147    my $self = shift;
148
149    $self->{inflate_columns} = [];
150    $self->{deflate_columns} = [];
151
152    while (my($column, $data) = each %{ $self->{column} }) {
153        my $opts = $data->{options};
154
155        my $inflate = $opts->{inflate};
156        if ($inflate && ref($inflate) ne 'CODE') {
157            $opts->{inflate} = Data::Model::Schema::Inflate->get_inflate($inflate);
158            $opts->{deflate} = $inflate;
159            $inflate = $opts->{inflate};
160        }
161        if (ref($inflate) eq 'CODE') {
162            push @{ $self->{inflate_columns} }, $column;
163            $self->{has_inflate} = 1;
164        } else {
165            delete $opts->{inflate};
166        }
167
168        my $deflate = $opts->{deflate};
169        if ($deflate && ref($deflate) ne 'CODE') {
170            $opts->{deflate} = Data::Model::Schema::Inflate->get_deflate($deflate);
171            $deflate = $opts->{deflate};
172        }
173        if (ref($deflate) eq 'CODE') {
174            push @{ $self->{deflate_columns} }, $column;
175            $self->{has_deflate} = 1;
176        } else {
177            delete $opts->{deflate};
178        }
179    }
180
181    if (scalar(%{ $self->{utf8_columns} })) {
182        $self->{has_inflate} = $self->{has_deflate} = 1;
183        my @columns = keys %{ $self->{column} };
184        $self->{inflate_columns} = \@columns;
185        $self->{deflate_columns} = \@columns;
186    }
187
188    # for alias
189    while (my($base, $list) = each %{ $self->{aluas_column_revers_map} }) {
190        for my $alias (@{ $list }) {
191            my $args    = $self->{alias_column}->{$alias};
192            my $inflate = $args->{inflate};
193
194            if ($inflate && ref($inflate) ne 'CODE') {
195                $args->{inflate} = Data::Model::Schema::Inflate->get_inflate($inflate);
196                $args->{deflate} = Data::Model::Schema::Inflate->get_deflate($inflate);
197            }
198
199            my $inflate_code = $args->{inflate};
200            my $is_utf8      = $args->{is_utf8};
201            my $charset      = $args->{charset} || 'utf8';
202
203            # make inflate2alias
204            my $code;
205
206            if ($is_utf8 && $inflate_code) {
207                $code = sub {
208                    $_[0]->{alias_values}->{$alias} = $inflate_code->( Encode::decode( $charset, $_[0]->{column_values}->{$base} ) );
209                };
210            } elsif ($is_utf8) {
211                $code = sub {
212                    $_[0]->{alias_values}->{$alias} = Encode::decode( $charset, $_[0]->{column_values}->{$base} );
213                };
214            } elsif ($inflate_code) {
215                $code = sub {
216                    $_[0]->{alias_values}->{$alias} = $inflate_code->( $_[0]->{column_values}->{$base} );
217                };
218            } else {
219                $code = sub {
220                    $_[0]->{alias_values}->{$alias} = $_[0]->{column_values}->{$base};
221                };
222            }
223            $args->{inflate2alias} = $code;
224        }
225    }
226}
227
228sub inflate {
229    if  ($_[0]->{has_inflate}) {
230        my($self, $columns) = @_;
231        my $orig_columns;
232        if (ref($columns) eq $self->{class}) {
233            $orig_columns = $columns;
234            $columns = $columns->{column_values};
235        } elsif (ref($columns) ne 'HASH') {
236            Carp::croak "required types 'HASH' or '$self->{class}' of inflate";
237        }
238        $self->call_trigger('pre_inflate', $columns, $orig_columns);
239
240        for my $column (@{ $self->{inflate_columns} }) {
241            next unless defined $columns->{$column};
242
243            my $opts = $self->{column}->{$column}->{options};
244            my $val = $columns->{$column};
245
246            if ($self->{utf8_columns}->{$column}) {
247                my $charset = $opts->{charset} || 'utf8';
248                $val = Encode::decode($charset, $val);
249            }
250
251            $val = $opts->{inflate}->($val) if ref($opts->{inflate}) eq 'CODE';
252
253            $orig_columns->{original_cols}->{$column} ||= $orig_columns->{column_values}->{$column}
254                if $orig_columns && $columns->{$column} ne $val;
255
256            $columns->{$column} = $val;
257        }
258        $self->call_trigger('post_inflate', $columns, $orig_columns);
259    }
260}
261
262sub deflate {
263    return unless $_[0]->{has_deflate};
264    my($self, $columns) = @_;
265    my $orig_columns;
266    if (ref($columns) eq $self->{class}) {
267        $orig_columns = $columns;
268        $columns = $columns->{column_values};
269    } elsif (ref($columns) ne 'HASH') {
270        Carp::croak "required types 'HASH' or '$self->{class}' of inflate";
271    }
272    $self->call_trigger('pre_deflate', $columns, $orig_columns);
273
274    for my $column (@{ $self->{deflate_columns} }) {
275        next unless defined $columns->{$column};
276
277        my $opts = $self->{column}->{$column}->{options};
278        my $val = $columns->{$column};
279        $val = $opts->{deflate}->($val) if ref($opts->{deflate}) eq 'CODE';
280
281        if ($self->{utf8_columns}->{$column}) {
282            my $charset = $opts->{charset} || 'utf8';
283            $val = Encode::encode($charset, $val);
284        }
285        $columns->{$column} = $val;
286    }
287    $self->call_trigger('post_deflate', $columns, $orig_columns);
288}
289
290sub set_default {
291    my($self, $columns) = @_;
292
293    while (my($name, $conf) = each %{ $self->{column} }) {
294        next if exists $columns->{$name};
295        next unless exists $conf->{options};
296        next unless exists $conf->{options}->{default};
297
298        my $default = $conf->{options}->{default};
299        if (ref($default) eq 'CODE') {
300            $columns->{$name} = $default->($self, $columns);
301        } else {
302            $columns->{$name} = $default;
303        }
304    }
305}
306
307sub get_key_array_by_hash {
308    my($self, $hash, $index) = @_;
309
310    my $key;
311    $key = $self->{unique}->{$index} || $self->{index}->{$index} if $index;
312    $key ||= $self->{key};
313    $key = [ $key ] unless ref($key) eq 'ARRAY';
314
315    my @keys;
316    for my $key (@{ $key }) {
317        last unless defined $hash->{$key};
318        push @keys, $hash->{$key};
319    }
320    \@keys;
321}
322
323sub get_columns_hash_by_key_array_and_hash {
324    my($self, $hash, $array, $index) = @_;
325    my $ret = {};
326
327    # by column
328    for my $column (keys %{ $self->{column} }) {
329        next unless exists $hash->{$column};
330        $ret->{$column} = $hash->{$column};
331    }
332
333    # by key
334    my $key;
335    $key = $self->{unique}->{$index} || $self->{index}->{$index} || die "Cannot find index '$index'" if $index;
336    $key ||= $self->{key};
337    $key = [ $key ] unless ref($key) eq 'ARRAY';
338
339    @{ $ret }{@{ $key }} = @{ $array };
340    $ret;
341}
342
343
344sub sql {
345    my $self = shift;
346    $self->{sql} ||= Data::Model::Schema::SQL->new($self);
347}
348
349
3501;
Note: See TracBrowser for help on using the browser.