File Coverage

blib/lib/ActiveRecord/Simple.pm
Criterion Covered Total %
statement 337 459 73.4
branch 125 234 53.4
condition 34 85 40.0
subroutine 53 68 77.9
pod 27 31 87.1
total 576 877 65.6


line stmt bran cond sub pod time code
1             package ActiveRecord::Simple;
2              
3 12     12   369223 use 5.010;
  12         106  
4 12     12   48 use strict;
  12         19  
  12         222  
5 12     12   42 use warnings;
  12         17  
  12         451  
6              
7             our $VERSION = '1.11';
8              
9 12     12   5453 use utf8;
  12         133  
  12         48  
10 12     12   287 use Carp;
  12         19  
  12         569  
11 12     12   56 use Scalar::Util qw/blessed/;
  12         17  
  12         668  
12              
13 12     12   3722 use ActiveRecord::Simple::QueryManager;
  12         115  
  12         354  
14 12     12   67 use ActiveRecord::Simple::Utils qw/all_blessed class_to_table_name load_module/;
  12         17  
  12         513  
15 12     12   3892 use ActiveRecord::Simple::Connect;
  12         26  
  12         40010  
16              
17             our $connector;
18             my $qm = ActiveRecord::Simple::QueryManager->new();
19              
20              
21             sub new {
22 141     141 1 256 my $class = shift;
23 141 100       274 my $params = (scalar @_ > 1) ? {@_} : $_[0];
24              
25             # relations
26 141 100       523 $class->_init_relations if $class->can('_get_relations');
27              
28 141   100     396 return bless $params || {}, $class;
29             }
30              
31             sub auto_load {
32 10     10 1 534 my ($class) = @_;
33              
34 10         32 my $table_name = class_to_table_name($class);
35              
36             # 0. check the name
37 10         44 my $table_info_sth = $class->dbh->table_info('', '%', $table_name, 'TABLE');
38 10 50       4349 $table_info_sth->fetchrow_hashref or croak "Can't find table '$table_name' in the database";
39              
40             # 1. columns list
41 10         53 my $column_info_sth = $class->dbh->column_info(undef, undef, $table_name, undef);
42 10         13739 my $cols = $column_info_sth->fetchall_arrayref({});
43              
44 10         1360 my @columns = ();
45 10         46 push @columns, $_->{COLUMN_NAME} for @$cols;
46              
47             # 2. Primary key
48 10         33 my $primary_key_sth = $class->dbh->primary_key_info(undef, undef, $table_name);
49 10         7305 my $primary_key_data = $primary_key_sth->fetchrow_hashref;
50 10 50       151 my $primary_key = ($primary_key_data) ? $primary_key_data->{COLUMN_NAME} : undef;
51              
52 10 50       75 $class->table_name($table_name) if $table_name;
53 10 50       86 $class->primary_key($primary_key) if $primary_key;
54 10 50       67 $class->columns(@columns) if @columns;
55             }
56              
57             sub connect {
58 6     6 1 39136 my ($class, $dsn, $username, $password, $options) = @_;
59              
60 6         12 eval { require DBIx::Connector };
  6         727  
61              
62             $options->{HandleError} = sub {
63 0     0   0 my ($error_message, $DBI_st) = @_;
64              
65 0 0       0 $error_message or return;
66 0         0 croak $error_message;
67              
68 6 50       60 } if ! exists $options->{HandleError};
69              
70 6 50       19 if ($@) {
71 6         41 $connector = ActiveRecord::Simple::Connect->new($dsn, $username, $password, $options);
72 6         19 $connector->db_connect;
73             }
74             else {
75 0         0 $connector = DBIx::Connector->new($dsn, $username, $password, $options);
76             }
77              
78 6         34 return 1;
79             }
80              
81             sub belongs_to {
82 5     5 1 49 my ($class, $rel_name, $rel_class, $params) = @_;
83              
84 5         20 my $new_relation = {
85             class => $rel_class,
86             type => 'one',
87             };
88              
89             my $primary_key = $params->{pk} ||
90             $params->{primary_key} ||
91 5   33     44 _guess(primary_key => $class);
92              
93             my $foreign_key = $params->{fk} ||
94             $params->{foreign_key} ||
95 5   33     31 _guess(foreign_key => $rel_class);
96              
97             $new_relation->{params} = {
98 5         21 pk => $primary_key,
99             fk => $foreign_key,
100             };
101              
102 5         24 $class->_append_relation($rel_name => $new_relation);
103             #$class->_mk_relations_accessors;
104             }
105              
106             sub has_many {
107 17     17 1 142 my ($class, $rel_name, $rel_class, $params) = @_;
108              
109 17         47 my $new_relation = {
110             class => $rel_class,
111             type => 'many',
112             };
113              
114 17   100     61 $params ||= {};
115             my $primary_key = $params->{pk} ||
116             $params->{primary_key} ||
117 17   33     86 _guess(primary_key => $class);
118              
119             my $foreign_key = $params->{fk} ||
120             $params->{foreign_key} ||
121 17   33     69 _guess(foreign_key => $class);
122              
123             $new_relation->{params} = {
124 17         55 pk => $primary_key,
125             fk => $foreign_key,
126             };
127              
128 17 100       58 $new_relation->{via_table} = $params->{via} if $params->{via};
129              
130 17         67 $class->_append_relation($rel_name => $new_relation);
131             #$class->_mk_relations_accessors;
132             }
133              
134             sub has_one {
135 0     0 1 0 my ($class, $rel_name, $rel_class, $params) = @_;
136              
137 0         0 my $new_relation = {
138             class => $rel_class,
139             type => 'only',
140             };
141              
142 0   0     0 $params ||= {};
143             #my ($primary_key, $foreign_key);
144             my $primary_key = $params->{pk} ||
145             $params->{primary_key} ||
146 0   0     0 _guess(primary_key => $class);
147              
148             my $foreign_key = $params->{fk} ||
149             $params->{foreign_key} ||
150 0   0     0 _guess(foreign_key => $class);
151              
152             $new_relation->{params} = {
153 0         0 pk => $primary_key,
154             fk => $foreign_key,
155             };
156              
157 0         0 $class->_append_relation($rel_name => $new_relation);
158             #$class->_mk_relations_accessors;
159             }
160              
161             sub generic {
162 0     0 1 0 my ($class, $rel_name, $rel_class, $key) = @_;
163              
164 0         0 my $new_relation = {
165             class => $rel_class,
166             type => 'generic',
167             key => $key
168             };
169              
170 0         0 return $class->_append_relation($rel_name => $new_relation);
171 0         0 $class->_mk_relations_accessors;
172             }
173              
174             sub columns {
175 22     22 1 149 my ($class, @columns_list) = @_;
176              
177 22 50 33     134 croak "Error: array-ref no longer supported for 'columns' method, sorry"
178             if scalar @columns_list == 1 && ref $columns_list[0] eq 'ARRAY';
179              
180 22         72 $class->_mk_attribute_getter('_get_columns', \@columns_list);
181 22 100 66     269 $class->_mk_rw_accessors(\@columns_list) unless $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
182             }
183              
184             sub make_columns_accessors {
185 1     1 1 65 my ($class, $flag) = @_;
186              
187 1   50     4 $flag //= 1; # default value
188              
189 1         4 $class->_mk_attribute_getter('_make_columns_accessors', $flag);
190             }
191              
192             sub mixins {
193 1     1 1 12 my ($class, %mixins) = @_;
194              
195 1         4 $class->_mk_attribute_getter('_get_mixins', \%mixins);
196 1         8 $class->_mk_ro_accessors([keys %mixins]);
197             }
198              
199             sub primary_key {
200 22     22 1 123 my ($class, $primary_key) = @_;
201              
202 22         139 $class->_mk_attribute_getter('_get_primary_key', $primary_key);
203             }
204              
205             sub secondary_key {
206 0     0 1 0 my ($class, $key) = @_;
207              
208 0         0 $class->_mk_attribute_getter('_get_secondary_key', $key);
209             }
210              
211             sub table_name {
212 22     22 1 8299 my ($class, $table_name) = @_;
213              
214 22         94 $class->_mk_attribute_getter('_get_table_name', $table_name);
215             }
216              
217             sub relations {
218 22     22 1 40 my ($class, $relations) = @_;
219              
220 22         45 $class->_mk_attribute_getter('_get_relations', $relations);
221             }
222              
223             sub dbh {
224 360     360 1 12603 my ($self, $dbh) = @_;
225              
226 360 100       585 if ($dbh) {
227 2 50       6 if ($connector) {
228 0         0 $connector->dbh($dbh);
229             }
230             else {
231 2         18 $connector = ActiveRecord::Simple::Connect->new();
232 2         7 $connector->dbh($dbh);
233             }
234             }
235              
236 360         747 return $connector->dbh;
237             }
238              
239             sub objects {
240 74     74 1 6047 $qm->{caller} = shift;
241 74         247 return $qm;
242             }
243              
244             sub save {
245 11     11 1 57 my ($self) = @_;
246              
247             #return unless $self->dbh;
248 11 50       52 croak "Undefined database handler" unless $self->dbh;
249              
250             croak 'Object is read-only'
251 11 50 33     57 if exists $self->{read_only} && $self->{read_only} == 1;
252              
253 11         19 my $save_param = {};
254 11         239 my $fields = $self->_get_columns;
255              
256 11 50       203 my $pkey = ($self->can('_get_primary_key')) ? $self->_get_primary_key : undef;
257              
258             FIELD:
259 11         24 for my $field (@$fields) {
260 39 100 66     132 next FIELD if defined $pkey && $field eq $pkey && !$self->{$pkey};
      100        
261 36 50 33     66 next FIELD if ref $field && ref $field eq 'HASH';
262 36         60 $save_param->{$field} = $self->{$field};
263             }
264              
265             ### Get additional fields from related objects:
266 11         34 for my $field (keys %$self) {
267 44 100       83 next unless ref $self->{$field};
268 2 50       7 next unless $self->can('_get_relations');
269 2 100       4 next unless grep { $_ eq $field } keys %{ $self->_get_relations };
  2         7  
  2         31  
270              
271 1 50       16 my $relation = $self->_get_relations->{$field} or next;
272 1 50 33     11 next unless $relation->{type} && $relation->{type} eq 'one';
273              
274 1         3 my $fk = $relation->{params}{fk};
275 1         2 my $pk = $relation->{params}{pk};
276              
277 1         17 $save_param->{$fk} = $self->{$field}->$pk;
278             }
279              
280 11         18 my $result;
281 11 100       22 if ($self->{isin_database}) {
282 5         27 $result = $self->_update($save_param);
283             }
284             else {
285 6         25 $result = $self->_insert($save_param);
286             }
287 11 50       564 $self->{need_to_save} = 0 if $result;
288 11 50       21 delete $self->{SQL} if $result;
289              
290 11 50       61 return (defined $result) ? $self : undef;
291             }
292              
293             sub update {
294 0     0 1 0 my ($self, $params) = @_;
295              
296 0         0 my $fields = $self->_get_columns();
297             FIELD:
298 0         0 for my $field (@$fields) {
299 0 0       0 next FIELD if ! exists $params->{$field};
300 0 0       0 next FIELD if ! $params->{$field};
301              
302 0         0 $self->{$field} = $params->{$field};
303             }
304              
305 0         0 return $self;
306             }
307              
308             # param:
309             # cascade => 1
310             sub delete {
311 1     1 1 806 my ($self, $param) = @_;
312              
313 1 50       3 return unless $self->dbh;
314              
315             #my $table_name = $self->_table_name;
316 1         7 my $table_name = _what_is_the_table_name($self);
317 1         16 my $pkey = $self->_get_primary_key;
318              
319 1 50       3 return unless $self->{$pkey};
320              
321 1         4 my $sql = qq{
322             DELETE FROM "$table_name" WHERE $pkey = ?
323             };
324 1 0 33     3 $sql .= ' CASCADE ' if $param && $param->{cascade};
325              
326 1         2 my $res = undef;
327 1         3 $sql = ActiveRecord::Simple::Utils::quote_sql_stmt($sql, $self->dbh->{Driver}{Name});
328              
329 1 50       3 if ( $self->dbh->do($sql, undef, $self->{$pkey}) ) {
330 1         7 $self->{isin_database} = undef;
331 1         2 delete $self->{$pkey};
332              
333 1         3 $res = 1;
334             }
335              
336 1         3 return $res;
337             }
338              
339             sub is_defined {
340 0     0 1 0 my ($self) = @_;
341              
342 0         0 return grep { defined $self->{$_} } @{ $self->_get_columns };
  0         0  
  0         0  
343             }
344              
345             # param:
346             # only_defined_fields => 1
347             ### TODO: refactor this
348             sub to_hash {
349 3     3 1 20 my ($self, $param) = @_;
350              
351 3         67 my $field_names = $self->_get_columns;
352 3 100       14 push @$field_names, keys %{ $self->_get_mixins } if $self->can('_get_mixins');
  2         33  
353 3         6 my $attrs = {};
354              
355 3         7 for my $field (@$field_names) {
356 15 50       23 next if ref $field;
357 15 100 66     31 if ( $param && $param->{only_defined_fields} ) {
358 7 100       15 $attrs->{$field} = $self->{$field} if defined $self->{$field};
359             }
360             else {
361 8         28 $attrs->{$field} = $self->{$field};
362             }
363             }
364              
365 3         16 return $attrs;
366             }
367              
368             sub increment {
369 0     0 1 0 my ($self, @fields) = @_;
370              
371             FIELD:
372 0         0 for my $field (@fields) {
373 0 0       0 next FIELD if not exists $self->{$field};
374 0         0 $self->{$field} += 1;
375             }
376              
377 0         0 return $self;
378             }
379              
380             sub decrement {
381 0     0 1 0 my ($self, @fields) = @_;
382              
383             FIELD:
384 0         0 for my $field (@fields) {
385 0 0       0 next FIELD if not exists $self->{$field};
386 0         0 $self->{$field} -= 1;
387             }
388              
389 0         0 return $self;
390             }
391              
392             #### Find ####
393              
394             sub find {
395 0     0 1 0 $qm->{caller} = shift;
396             carp
397             q/[DEPRECATED] This method is DEPRECATED since version 1.10. '/ .
398 0         0 q/Please, use "find" via "objects" method: / . $qm->{caller} . q/->objects->find/;
399 0         0 $qm->find(@_);
400             }
401              
402             sub all {
403 0     0 1 0 $qm->{caller} = shift;
404             carp
405             q/[DEPRECATED] This method is DEPRECATED since version 1.10. '/ .
406 0         0 q/Please, use "all" via "objects" method: / . $qm->{caller} . q/->objects->all/;
407 0         0 $qm->all();
408             }
409              
410             sub get {
411 0     0 1 0 $qm->{caller} = shift;
412             carp
413             q/[DEPRECATED] This method is DEPRECATED since version 1.10. '/ .
414 0         0 q/Please, use "get" via "objects" method: / . $qm->{caller} . q/->objects->get/;
415 0         0 $qm->get(@_);
416             }
417              
418             sub exists {
419 0     0 1 0 my $first_arg = shift;
420              
421 0         0 my ($class, @search_criteria);
422 0 0       0 if (ref $first_arg) {
423             # FIXME: Ugly solution, need some beautifulness =)
424             # object method
425 0         0 $class = ref $first_arg;
426              
427 0 0       0 if ($class eq 'ActiveRecord::Simple::Find') {
428 0         0 return $first_arg->exists;
429             }
430             else {
431 0         0 return ActiveRecord::Simple::Find->new($class, $first_arg->to_hash({ only_defined_fields => 1 }))->exists;
432             }
433             }
434             else {
435 0         0 carp '[DEPRECATED] This way of using method "exists" is deprecated. Please, see documentation to know how does it work now.';
436 0         0 $class = $first_arg;
437 0         0 @search_criteria = @_;
438 0 0       0 return (defined $class->find(@search_criteria)->fetch) ? 1 : 0;
439             }
440             }
441              
442 14     14   45 sub _find_many_to_many { ActiveRecord::Simple::Find->_find_many_to_many(shift, @_) }
443              
444       0     sub DESTROY {}
445              
446              
447             ### Private
448              
449             sub _get_primary_key_value {
450 0     0   0 my ($self) = @_;
451              
452 0 0       0 croak "Sory, you can call method '_get_primary_key_value' on unblessed scalar."
453             unless blessed $self;
454              
455 0         0 my $pk = $self->_get_primary_key;
456 0         0 return $self->$pk;
457             }
458              
459              
460             sub _get_relation_type {
461 15     15   26 my ($class, $relation) = @_;
462              
463 15         22 my $type = $relation->{type};
464 15         26 $type .= '_to_';
465              
466 15         26 my $related_class = _get_related_class($relation);
467              
468             #eval { load $related_class }; ### TODO: check module is loaded
469             #load $related_class;
470              
471             #load $related_class unless is_loaded $related_class;
472             #mark_as_loaded $related_class;
473 15         44 load_module $related_class;
474              
475 15         255 my $rel_type = undef;
476 15         22 while (my ($rel_key, $rel_opts) = each %{ $related_class->_get_relations }) {
  37         631  
477 22 100       54 next if $class ne _get_related_class($rel_opts);
478 15         32 $rel_type = $rel_opts->{type};
479             }
480              
481 15 50       30 croak 'Oops! Looks like related class ' . $related_class . ' has no relations with ' . $class unless $rel_type;
482              
483 15         24 $type .= $rel_type;
484              
485 15         32 return $type;
486             }
487              
488             sub _get_related_subclass {
489 16     16   25 my ($relation) = @_;
490              
491 16 50       77 return undef if !ref $relation->{class};
492              
493 0         0 my $subclass;
494 0 0       0 if (ref $relation->{class} eq 'HASH') {
    0          
495 0         0 $subclass = (keys %{ $relation->{class} })[0];
  0         0  
496             }
497             elsif (ref $relation->{class} eq 'ARRAY') {
498 0         0 $subclass = $relation->{class}[0];
499             }
500              
501 0         0 return $subclass;
502             }
503              
504             sub _get_related_class {
505 52     52   64 my ($relation) = @_;
506              
507 52 50       150 return $relation->{class} if !ref $relation->{class};
508              
509 0         0 my $related_class;
510 0 0       0 if (ref $relation->{class} eq 'HASH') {
    0          
511 0         0 $related_class = ( %{ $relation->{class} } )[1]
  0         0  
512             }
513             elsif (ref $relation->{class} eq 'ARRAY') {
514 0         0 $related_class = $relation->{class}[1];
515             }
516              
517 0         0 return $related_class;
518             }
519              
520             sub _insert {
521 6     6   14 my ($self, $param) = @_;
522              
523 6 50 33     13 return unless $self->dbh && $param;
524              
525             #my $table_name = $self->_table_name;
526 6         19 my $table_name = _what_is_the_table_name($self);
527 6         35 my @field_names = grep { defined $param->{$_} } sort keys %$param;
  15         35  
528 6 0       131 my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
    50          
529             ($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
530              
531 6         24 my $field_names_str = join q/, /, map { q/"/ . $_ . q/"/ } @field_names;
  15         49  
532              
533 6         13 my (@bind, @values_list);
534 6         14 for (@field_names) {
535 15 50       29 if (ref $param->{$_} eq 'SCALAR') {
536 0         0 push @values_list, ${ $param->{$_} };
  0         0  
537             }
538             else {
539 15         28 push @values_list, '?';
540 15         27 push @bind, $param->{$_};
541             }
542             }
543 6         14 my $values = join q/, /, @values_list;
544 6         43 my $pkey_val;
545 6         21 my $sql_stm = qq{
546             INSERT INTO "$table_name" ($field_names_str)
547             VALUES ($values)
548             };
549              
550 6 50       18 if ( $self->dbh->{Driver}{Name} eq 'Pg' ) {
551 0 0       0 if ($primary_key) {
552 0 0       0 $sql_stm .= ' RETURINIG ' . $primary_key if $primary_key;
553 0         0 $sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name});
554 0         0 $pkey_val = $self->dbh->selectrow_array($sql_stm, undef, @bind);
555             }
556             else {
557             my $sth = $self->dbh->prepare(
558             ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
559 0         0 );
560              
561 0         0 $sth->execute(@bind);
562             }
563             }
564             else {
565              
566             my $sth = $self->dbh->prepare(
567             ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
568 6         28 );
569 6         449 $sth->execute(@bind);
570              
571 6 100 66     47 if ( $primary_key && defined $self->{$primary_key} ) {
572 3         23 $pkey_val = $self->{$primary_key};
573             }
574             else {
575             $pkey_val =
576             exists $sth->{mysql_insertid} # mysql only
577             ? $sth->{mysql_insertid}
578 3 50       24 : $self->dbh->last_insert_id(undef, undef, $table_name, undef);
579             }
580             }
581              
582 6 50 33     116 if (defined $primary_key && $self->can($primary_key) && $pkey_val) {
      33        
583             #$self->$primary_key($pkey_val);
584 6         15 $self->{$primary_key} = $pkey_val;
585             }
586 6         13 $self->{isin_database} = 1;
587              
588 6         19 return $pkey_val;
589             }
590              
591             sub _update {
592 5     5   12 my ($self, $param) = @_;
593              
594 5 50 33     13 return unless $self->dbh && $param;
595              
596             #my $table_name = $self->_table_name;
597 5         18 my $table_name = _what_is_the_table_name($self);
598 5         28 my @field_names = sort keys %$param;
599 5 0       96 my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
    50          
600             ($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
601              
602 5         11 my (@set_list, @bind);
603 5         10 for (@field_names) {
604 21 50       36 if (ref $param->{$_} eq 'SCALAR') {
605 0         0 push @set_list, $_ . ' = ' . ${ $param->{$_} };
  0         0  
606             }
607             else {
608 21         39 push @set_list, "$_ = ?";
609 21         31 push @bind, $param->{$_};
610             }
611             }
612 5         15 my $setstring = join q/, /, @set_list;
613 5         9 push @bind, $self->{$primary_key};
614              
615             my $sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt(
616             qq{
617             UPDATE "$table_name" SET $setstring
618             WHERE
619             $primary_key = ?
620             },
621             $self->dbh->{Driver}{Name}
622 5         55 );
623              
624 5         16 return $self->dbh->do($sql_stm, undef, @bind);
625             }
626              
627             sub _mk_rw_accessors {
628 21     21   50 my ($class, $fields) = @_;
629              
630 21 50       51 return unless $fields;
631 21 50 33     91 return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
632              
633 21         80 $class->_mk_accessors($fields, 'rw');
634             }
635              
636              
637             sub _mk_ro_accessors {
638 4     4   10 my ($class, $fields) = @_;
639              
640 4 50       12 return unless $fields;
641 4 50 33     20 return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
642              
643 4         11 $class->_mk_accessors($fields, 'ro');
644             }
645              
646             sub _mk_accessors {
647 25     25   55 my ($class, $fields, $type) = @_;
648              
649 25   50     52 $type ||= 'rw';
650 25         37 my $code_string = q//;
651             METHOD_NAME:
652 25         83 for my $method_name (@$fields) {
653 84 50       323 next METHOD_NAME if $class->can($method_name);
654 84         146 $code_string .= "sub $method_name {\n";
655 84 100       180 if ($type eq 'rw') {
    50          
656 78         137 $code_string .= "if (\@_ > 1) { \$_[0]->{$method_name} = \$_[1]; return \$_[0] }\n";
657             }
658             elsif ($type eq 'ro') {
659 6         8 $code_string .= "die 'Object is read-only, sorry' if \@_ > 1;\n";
660             }
661 84         136 $code_string .= "return \$_[0]->{$method_name};\n }\n";
662             }
663              
664 25 50   4 0 3855 eval "package $class;\n $code_string" if $code_string;
  4 100   18 0 15  
  1 100   20 0 1  
  1 100   12 0 3  
  2 100   9   8  
  18 100       81  
  1 50       2  
  1 50       4  
  17         94  
  20         767  
  2         5  
  2         7  
  18         79  
  12         57  
  1         2  
  1         3  
  11         38  
  9         36  
  3         11  
  0         0  
  1         4  
  2         8  
  2         7  
665              
666 25 50       698 say $@ if $@;
667              
668             }
669              
670             sub _guess {
671 44     44   74 my ($what_key, $class) = @_;
672              
673 44 100       114 return 'id' if $what_key eq 'primary_key';
674              
675             #eval { load $class }; ### TODO: check class has been loaded
676             #load $class unless is_loaded $class;
677             #mark_as_loaded $class;
678 22         65 load_module $class;
679              
680              
681 22         487 my $table_name = _what_is_the_table_name($class);
682            
683 22 50       63 $table_name =~ s/s$// if $what_key eq 'foreign_key';
684              
685 22 50       90 return ($what_key eq 'foreign_key') ? "$table_name\_id" : undef;
686             }
687              
688             sub _delete_keys {
689 0     0   0 my ($self, $rx) = @_;
690              
691 0 0       0 map { delete $self->{$_} if $_ =~ $rx } keys %$self;
  0         0  
692             }
693              
694             sub _append_relation {
695 22     22   44 my ($class, $rel_name, $rel_hashref) = @_;
696              
697 22 100       91 if ($class->can('_get_relations')) {
698 6         104 my $relations = $class->_get_relations();
699 6         15 $relations->{$rel_name} = $rel_hashref;
700 6         14 $class->relations($relations);
701             }
702             else {
703 16         63 $class->relations({ $rel_name => $rel_hashref });
704             }
705              
706 22         75 return $rel_hashref;
707             }
708              
709             sub _mk_attribute_getter {
710 90     90   161 my ($class, $method_name, $return) = @_;
711              
712 90 100       407 return if $class->can($method_name);
713              
714 84     3   2902 eval "package $class; \n sub $method_name { \$return }";
  0     2   0  
  5         44  
  3         32  
  2         11  
715             }
716              
717 0         0 sub _init_relations {
718 70     70   127 my ($class) = @_;
719              
720 148         1443 my $relations = $class->_get_relations;
721              
722 12     12   99 no strict 'refs';
  12         19  
  12         10892  
723             RELATION_NAME:
724 287         1073 for my $relation_name ( keys %{ $relations }) {
  173         406  
725 160         352 my $pkg_method_name = $class . '::' . $relation_name;
726 103 100       386 next RELATION_NAME if $class->can($pkg_method_name); ### FIXME: orrrr $relation_name???
727              
728 47         114 my $relation = $relations->{$relation_name};
729 15         36 my $full_relation_type = _get_relation_type($class, $relation);
730 15         35 my $related_class = _get_related_class($relation);
731              
732             ### TODO: check for error if returns undef
733 15         24 my $pk = $relation->{params}{pk};
734 15         22 my $fk = $relation->{params}{fk};
735              
736 15         32 my $instance_name = "relation_instance_$relation_name";
737              
738 15 100       24 if (grep { $full_relation_type eq $_ } qw/one_to_many one_to_one one_to_only/) {
  45 50       108  
    100          
    50          
    0          
739 4         24 *{$pkg_method_name} = sub {
740 8     96   21 my ($self, @args) = @_;
741 8 100       23 if (@args) {
742 1         2 my $object = shift @args;
743 1 50       5 croak "Using unblessed scalar as an object reference"
744             unless blessed $object;
745              
746 1 50 33     4 $object->save() if ! exists $object->{isin_database} && !$object->{isin_database} == 1;
747              
748             #$self->$fk($object->$pk);
749 1         2 $self->{$fk} = $object->{$pk};
750 1         3 $self->{$instance_name} = $object;
751              
752 1         3 return $self;
753             }
754             # else
755 7 100       19 if (!$self->{$instance_name}) {
756 4   33     13 $self->{$instance_name} = $related_class->objects->get($self->{$fk}) // $related_class;
757             }
758              
759 7         103 return $self->{$instance_name};
760             }
761 4         26 }
762             elsif ($full_relation_type eq 'only_to_one') {
763 0         0 *{$pkg_method_name} = sub {
764 0     227   0 my ($self, @args) = @_;
765              
766 0 0       0 if (!$self->{$instance_name}) {
767 0         0 $self->{$instance_name} = $related_class->find("$fk = ?", $self->{$pk})->fetch;
768             }
769              
770 0         0 return $self->{$instance_name};
771             }
772 0         0 }
773             elsif ($full_relation_type eq 'many_to_one') {
774 4         16 *{$pkg_method_name} = sub {
775 5     118   15 my ($self, @args) = @_;
776              
777 5 100       15 if (@args) {
778 1 50       4 unless (all_blessed(\@args)) {
779 0         0 return $related_class->find(@args)->left_join($self->_get_table_name);
780             }
781              
782             OBJECT:
783 1         4 for my $object (@args) {
784 1 50       4 next OBJECT if !blessed $object;
785              
786 1         27 my $pk = $self->_get_primary_key;
787             #$object->$fk($self->$pk)->save;
788 1         6 $object->{$fk} = $self->{$pk};
789 1         12 $object->save();
790             }
791              
792 1         5 return $self;
793             }
794             # else
795 4 50       18 return $related_class->new() if not $self->can('_get_primary_key');
796              
797 4 50       13 if (!$self->{$instance_name}) {
798 4         17 $self->{$instance_name} = $related_class->objects->find("$fk = ?", $self->{$pk});
799             }
800              
801 4         32 return $self->{$instance_name};
802             }
803 4         23 }
804             elsif ($full_relation_type eq 'many_to_many') {
805 7         29 *{$pkg_method_name} = sub {
806 16     95   572 my ($self, @args) = @_;
807              
808 16 100       40 if (@args) {
809              
810 8         16 my $related_subclass = _get_related_subclass($relation);
811              
812 8 100       22 unless (all_blessed(\@args)) {
813             return $related_class->_find_many_to_many({
814             root_class => $class,
815             via_table => $relation->{via_table},
816 6         38 m_class => $related_subclass,
817             self => $self,
818             where_statement => \@args,
819             });
820             }
821              
822              
823 2 50       7 if (defined $related_subclass) {
824 0         0 my ($fk1, $fk2);
825              
826 0         0 $fk1 = $fk;
827              
828             RELATED_CLASS_RELATION:
829 0         0 for my $related_class_relation (values %{ $related_class->_get_relations }) {
  0         0  
830             next RELATED_CLASS_RELATION
831 0 0 0     0 unless _get_related_subclass($related_class_relation)
832             && $related_subclass eq _get_related_subclass($related_class_relation);
833              
834 0         0 $fk2 = $related_class_relation->{params}{fk};
835             }
836              
837 0         0 my $pk1_name = $self->_get_primary_key;
838 0         0 my $pk1 = $self->{$pk1_name};
839              
840 0 0       0 defined $pk1 or croak 'You are trying to create relations between unsaved objects. Save your ' . $class . ' object first';
841              
842             OBJECT:
843 0         0 for my $object (@args) {
844 0 0       0 next OBJECT if !blessed $object;
845              
846 0         0 my $pk2_name = $object->_get_primary_key;
847 0         0 my $pk2 = $object->{$pk2_name};
848              
849 0         0 $related_subclass->new($fk1 => $pk1, $fk2 => $pk2)->save;
850             }
851             }
852             else {
853 2         3 my ($fk1, $fk2);
854 2         4 $fk1 = $fk;
855              
856 2         6 $fk2 = class_to_table_name($related_class) . '_id';
857              
858 2         35 my $pk1_name = $self->_get_primary_key;
859 2         4 my $pk1 = $self->{$pk1_name};
860              
861 2         5 my $via_table = $relation->{via_table};
862              
863             OBJECT:
864 2         4 for my $object (@args) {
865 2 50       10 next OBJECT if !blessed $object;
866              
867 2         33 my $pk2_name = $object->_get_primary_key;
868 2         4 my $pk2 = $object->{$pk2_name};
869              
870 2         8 my $sql = qq/INSERT INTO "$via_table" ("$fk1", "$fk2") VALUES (?, ?)/;
871 2         9 $self->dbh->do($sql, undef, $pk1, $pk2);
872             }
873             }
874              
875 2         225 return $self;
876             }
877             # else
878              
879 8 50       20 if (!$self->{$instance_name}) {
880             $self->{$instance_name} = $related_class->_find_many_to_many({
881             root_class => $class,
882             m_class => _get_related_subclass($relation),
883             via_table => $relation->{via_table},
884 8         19 self => $self,
885             });
886             }
887              
888 8         31 return $self->{$instance_name};
889             }
890 7         55 }
891             elsif ($full_relation_type eq 'generic_to_generic') {
892 0         0 *{$pkg_method_name} = sub {
893 0     22   0 my ($self, @args) = @_;
894              
895 0 0       0 if (!$self->{$instance_name}) {
896 0         0 my %find_attrs;
897 0         0 while (my ($k, $v) = each %{ $relation->{key} }) {
  0         0  
898 0         0 $find_attrs{$v} = $self->{$k};
899             }
900 0         0 $self->{$instance_name} = $related_class->find(\%find_attrs);
901             }
902              
903 0         0 return $self->{$instance_name};
904             }
905 0         0 }
906             }
907              
908 12     12   78 use strict 'refs';
  12         43  
  12         1692  
909             }
910              
911             sub _what_is_the_table_name {
912 34 100   66   80 my $class = ref $_[0] ? ref $_[0] : $_[0];
913              
914 34 50       78 croak 'Invalid data class' if $class =~ /^ActiveRecord::Simple/;
915              
916 34 100       807 my $table_name =
917             $class->can('_get_table_name') ?
918             $class->_get_table_name
919             : class_to_table_name($class);
920              
921 34         61 return $table_name;
922             }
923              
924             1;
925              
926             __END__;