File Coverage

blib/lib/LittleORM/Model.pm
Criterion Covered Total %
statement 36 848 4.2
branch 0 326 0.0
condition 0 148 0.0
subroutine 12 73 16.4
pod 0 20 0.0
total 48 1415 3.3


line stmt bran cond sub pod time code
1 1     1   10629 use strict;
  1         3  
  1         37  
2              
3 1     1   484 use LittleORM::Db ();
  1         3  
  1         26  
4 1     1   531 use LittleORM::Db::Field ();
  1         4  
  1         37  
5 1     1   612 use LittleORM::Meta::LittleORMHasDbh ();
  1         5  
  1         59  
6              
7             package LittleORM::Model;
8              
9 1     1   14 use Moose -traits => 'LittleORMHasDbh';
  1         3  
  1         8  
10 1     1   4710 use Moose::Util::TypeConstraints;
  1         1  
  1         10  
11              
12             has '_rec' => ( is => 'rw', isa => 'HashRef', required => 1, metaclass => 'LittleORM::Meta::Attribute', description => { ignore => 1 } );
13              
14 1     1   1429 use Carp::Assert 'assert';
  1         2  
  1         10  
15 1     1   119 use Scalar::Util 'blessed';
  1         1  
  1         59  
16 1     1   100330 use Module::Load ();
  1         1943  
  1         39  
17 1     1   462 use LittleORM::Model::Field ();
  1         3  
  1         36  
18 1     1   493 use LittleORM::Model::Value ();
  1         5  
  1         45  
19 1     1   607 use LittleORM::Model::Dbh ();
  1         4  
  1         8952  
20              
21 0     0     sub _db_table{ assert( 0, '" _db_table " method must be redefined.' ) }
22              
23             # Let it be separate method, m'kay?
24             sub _clear
25             {
26 0     0     my $self = shift;
27              
28 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
29             {
30 0 0         next if &__descr_attr( $attr, 'do_not_clear_on_reload' ); # well, kinda crutch...
31             # - Kain
32              
33 0 0         if( $attr -> has_clearer() )
34             {
35              
36             # http://search.cpan.org/~doy/Moose-2.0603/lib/Class/MOP/Attribute.pm
37             # $attr->clearer
38             # The accessor, reader, writer, predicate, and clearer methods all
39             # return exactly what was passed to the constructor, so it can be
40             # either a string containing a method name, or a hash reference.
41              
42             # -- why does it have to be so complex?
43            
44 0           my $clearer = $attr -> clearer();
45              
46             # ok, as doc above says:
47 0 0         if( ref( $clearer ) )
48             {
49 0           my $code = ${ [ values %{ $clearer } ] }[ 0 ];
  0            
  0            
50 0           $code -> ( $self );
51              
52             } else
53             {
54 0           $self -> $clearer();
55             }
56            
57             } else
58             {
59 0           $attr -> clear_value( $self );
60             }
61             }
62              
63 0           return 1;
64             }
65              
66             sub __for_read
67             {
68 0     0     return ( _for_what => 'read' );
69             }
70              
71             sub __for_write
72             {
73 0     0     return ( _for_what => 'write' );
74             }
75              
76             sub equals
77             {
78 0     0 0   my ( $self, $other ) = @_;
79              
80 0           my $rv = 0;
81 0           my @pks = $self -> __find_primary_keys();
82            
83 0 0 0       if( $other and blessed( $other ) and $other -> isa( ref( $self ) ) and @pks )
    0 0        
      0        
      0        
      0        
84             {
85              
86 0           $rv = 1;
87            
88             TPfHSgZ9BCDTx58w:
89 0           foreach my $key ( @pks )
90             {
91 0           assert( my $method_name = $key -> name() );
92 0 0         unless( $self -> $method_name() eq $other -> $method_name() ) # no check if $other actually can do $key()
93             {
94 0           $rv = 0;
95             }
96             }
97            
98             } elsif( $other and ( not ref( $other ) ) and ( scalar @pks == 1 ) )
99             {
100 0           my $method_name = $pks[ 0 ] -> name();
101              
102 0 0         if( $self -> $method_name() eq $other )
103             {
104 0           $rv = 1;
105             }
106             }
107              
108 0           return $rv;
109             }
110              
111             sub reload
112             {
113 0     0 0   my $self = shift;
114              
115 0 0         if( my @pk = $self -> __find_primary_keys() )
116             {
117 0           my %get_args = ();
118              
119 0           foreach my $pk ( @pk )
120             {
121 0           my $pkname = $pk -> name();
122 0           $get_args{ $pkname } = $self -> $pkname();
123             }
124              
125 0           $self -> _clear();
126              
127 0           my $sql = $self -> __form_get_sql( %get_args,
128             _limit => 1 );
129              
130 0           my $rec = &LittleORM::Db::getrow( $sql, $self -> __get_dbh( &__for_read() ) );
131 0           $self -> _rec( $rec );
132              
133             } else
134             {
135 0           assert( 0, 'reload in only supported for models with PK' );
136             }
137             }
138              
139             sub clone
140             {
141 0     0 0   my $self = shift;
142              
143 0           my $class = ref( $self );
144              
145 0           return $class -> new( _rec => $self -> _rec() );
146             }
147              
148             sub get
149             {
150 0     0 0   my $self = shift;
151              
152 0           my @args = @_;
153 0           my %args = @args;
154              
155 0           my $sql = $self -> __form_get_sql( @args, _limit => 1 );
156              
157 0 0         if( $args{ '_debug' } )
158             {
159 0           return $sql;
160             }
161              
162 0           my $rec = &LittleORM::Db::getrow( $sql, $self -> __get_dbh( @args,
163             &__for_read() ) );
164              
165 0           my $rv = undef;
166              
167 0 0         if( $rec )
168             {
169 0           $rv = $self -> create_one_return_value_item( $rec, @args );
170             }
171              
172 0           return $rv;
173             }
174              
175             sub borrow_field
176             {
177 0     0 0   my $self = shift;
178 0           my $attrname = shift;
179 0           my %more = @_;
180              
181 0 0         if( $attrname )
182             {
183 0 0         unless( exists $more{ 'db_field_type' } )
184             {
185 0           my $attr = $self -> meta() -> find_attribute_by_name( $attrname );
186 0 0         if( my $t = &__descr_attr( $attr, 'db_field_type' ) )
187             {
188 0           $more{ 'db_field_type' } = $t;
189             }
190             }
191             }
192              
193 0   0       my $rv = LittleORM::Model::Field -> new( model => ( ref( $self ) or $self ),
194             %more );
195 0 0         if( $attrname )
196             {
197 0           assert( my $attr = $self -> meta() -> find_attribute_by_name( $attrname ) );
198 0           $rv -> base_attr( $attrname );
199             }
200              
201 0           return $rv;
202             }
203              
204             sub create_one_return_value_item
205             {
206 0     0 0   my $self = shift;
207 0           my $rec = shift;
208 0           my %args = @_;
209              
210 0           my $rv = undef;
211              
212 0 0         if( $rec )
213             {
214 0 0 0       if( $args{ '_fieldset' } or $args{ '_groupby' } )
215             {
216 0           $rv = LittleORM::DataSet -> new();
217              
218 0 0         if( my $fs = $args{ '_fieldset' } )
219             {
220 0           foreach my $f ( @{ $fs } )
  0            
221             {
222 0 0         unless( LittleORM::Model::Field -> this_is_field( $f ) )
223             {
224 0           $f = $self -> borrow_field( $f,
225             select_as => &__get_db_field_name( $self -> meta() -> find_attribute_by_name( $f ) ) );
226             }
227              
228 0           my $dbfield = $f -> select_as();
229 0           my $value = $f -> post_process() -> ( $rec -> { $dbfield } );
230              
231 0           $rv -> add_to_set( { model => $f -> model(),
232             base_attr => $f -> base_attr(),
233             orm_coerce => $f -> orm_coerce(),
234             dbfield => $dbfield,
235             value => $value } );
236             }
237             }
238              
239 0 0         if( my $grpby = $args{ '_groupby' } )
240             {
241 0           foreach my $f ( @{ $grpby } )
  0            
242             {
243 0   0       my ( $dbfield,
244             $post_process,
245             $base_attr,
246             $orm_coerce,
247             $model ) = ( undef,
248             undef,
249             undef,
250             1,
251             ( ref( $self ) or $self ) );
252              
253 0 0         if( LittleORM::Model::Field -> this_is_field( $f ) )
254             {
255 0           $dbfield = $f -> select_as();
256 0           $base_attr = $f -> base_attr();
257 0           $post_process = $f -> post_process();
258 0           $model = $f -> model();
259 0           $orm_coerce = $f -> orm_coerce();
260              
261             } else
262             {
263 0           $dbfield = &__get_db_field_name( $self -> meta() -> find_attribute_by_name( $f ) );
264             }
265              
266 0 0         my $value = ( $post_process ? $post_process -> ( $rec -> { $dbfield } ) : $rec -> { $dbfield } );
267 0           $rv -> add_to_set( { model => $model,
268             base_attr => $base_attr,
269             dbfield => $dbfield,
270             orm_coerce => $orm_coerce,
271             value => $value } );
272             }
273             }
274             } else
275             {
276 0           $rv = $self -> new( _rec => $rec );
277             }
278             }
279 0           return $rv;
280             }
281              
282             sub values_list
283             {
284 0     0 0   my ( $self, $fields, $args ) = @_;
285              
286             # example: @values = Class -> values_list( [ 'id', 'name' ], [ something => { '>', 100 } ] );
287             # will return ( [ id, name ], [ id1, name1 ], ... )
288              
289 0           my @rv = ();
290              
291 0           foreach my $o ( $self -> get_many( @{ $args } ) )
  0            
292             {
293 0           my @l = map { $o -> $_() } @{ $fields };
  0            
  0            
294              
295 0           push @rv, \@l;
296             }
297              
298 0           return @rv;
299             }
300              
301             sub get_or_create
302             {
303 0     0 0   my $self = shift;
304              
305 0           my $r = $self -> get( @_ );
306              
307 0 0         unless( $r )
308             {
309 0           $r = $self -> create( @_ );
310             }
311              
312 0           return $r;
313             }
314              
315             sub get_many
316             {
317 0     0 0   my $self = shift;
318 0           my @args = @_;
319 0           my %args = @args;
320 0           my @outcome = ();
321              
322 0           my $sql = $self -> __form_get_sql( @args );
323              
324 0 0         if( $args{ '_debug' } )
325             {
326 0           return $sql;
327             }
328              
329 0           my $sth = &LittleORM::Db::prep( $sql, $self -> __get_dbh( @args,
330             &__for_read() ) );
331 0           $sth -> execute();
332              
333 0           while( my $data = $sth -> fetchrow_hashref() )
334             {
335 0           my $o = $self -> create_one_return_value_item( $data, @args );
336 0           push @outcome, $o;
337             }
338              
339 0           $sth -> finish();
340              
341 0           return @outcome;
342             }
343              
344             sub _sql_func_on_attr
345             {
346 0     0     my $self = shift;
347 0           my $func = shift;
348 0           my $attr = shift;
349              
350 0           my @args = @_;
351 0           my %args = @args;
352              
353 0           my $outcome = 0;
354              
355 0           my $sql = $self -> __form_sql_func_sql( _func => $func,
356             _attr => $attr,
357             @args );
358 0 0         if( $args{ '_debug' } )
359             {
360 0           return $sql;
361             }
362              
363 0           my $sth = &LittleORM::Db::prep( $sql, $self -> __get_dbh( @args,
364             &__for_read() ) );
365 0           $sth -> execute();
366 0           my $rows = $sth -> rows();
367            
368 0 0         if( $args{ '_groupby' } )
    0          
369             {
370 0           $outcome = [];
371              
372 0           while( my $data = $sth -> fetchrow_hashref() )
373             {
374 0           my $set = LittleORM::DataSet -> new();
375 0           while( my ( $k, $v ) = each %{ $data } )
  0            
376             {
377 0   0       my $field = { model => ( ref( $self ) or $self ),
378             dbfield => $k,
379             orm_coerce => 1,
380             value => $v };
381              
382 0           $set -> add_to_set( $field );
383             }
384 0           push @{ $outcome }, $set;
  0            
385             }
386              
387             } elsif( $rows == 1 )
388             {
389 0           $outcome = $sth -> fetchrow_hashref() -> { $func };
390              
391             } else
392             {
393 0           assert( 0,
394             sprintf( "Got '%s' for '%s'",
395             $rows,
396             $sql ) );
397             }
398              
399 0           $sth -> finish();
400              
401 0           return $outcome;
402             }
403              
404             sub max
405             {
406 0     0 0   my $self = shift;
407              
408 0           assert( my $attrname = $_[ 0 ] );
409              
410 0           my $rv = $self -> _sql_func_on_attr( 'max', @_ );
411              
412 0           my $attr = undef;
413              
414 0 0         if( LittleORM::Model::Field -> this_is_field( $attrname ) )
415             {
416 0           assert( $attr = $self -> meta() -> find_attribute_by_name( $attrname -> base_attr() ) );
417             } else
418             {
419 0           assert( $attr = $self -> meta() -> find_attribute_by_name( $attrname ) );
420             }
421              
422 0 0         if( my $coerce_from = &__descr_attr( $attr, 'coerce_from' ) )
423             {
424 0           $rv = $coerce_from -> ( $rv );
425             }
426              
427 0           return $rv;
428             }
429              
430              
431             sub min
432             {
433 0     0 0   my $self = shift;
434              
435 0           assert( my $attrname = $_[ 0 ] );
436              
437 0           my $rv = $self -> _sql_func_on_attr( 'min', @_ );
438              
439 0           my $attr = undef;
440              
441 0 0         if( LittleORM::Model::Field -> this_is_field( $attrname ) )
442             {
443 0           assert( $attr = $self -> meta() -> find_attribute_by_name( $attrname -> base_attr() ) );
444             } else
445             {
446 0           assert( $attr = $self -> meta() -> find_attribute_by_name( $attrname ) );
447             }
448              
449 0 0         if( my $coerce_from = &__descr_attr( $attr, 'coerce_from' ) )
450             {
451 0           $rv = $coerce_from -> ( $rv );
452             }
453              
454 0           return $rv;
455             }
456              
457              
458             # sub min
459             # {
460             # my $self = shift;
461              
462             # assert( my $attrname = $_[ 0 ] );
463              
464             # my $rv = $self -> _sql_func_on_attr( 'min', @_ );
465              
466             # assert( my $attr = $self -> meta() -> find_attribute_by_name( $attrname ) );
467              
468             # if( my $coerce_from = &__descr_attr( $attr, 'coerce_from' ) )
469             # {
470             # $rv = $coerce_from -> ( $rv );
471             # }
472              
473             # return $rv;
474             # }
475              
476             sub __default_db_field_name_for_func
477             {
478 0     0     my ( $self, %args ) = @_;
479              
480 0           my $rv = '';
481 0           assert( my $func = $args{ '_func' } );
482              
483 0 0         if( $func eq 'count' )
484             {
485 0           $rv = '*';
486 0 0         if( my $d = $args{ '_distinct' } )
487             {
488 0           my @distinct_on = $self -> __get_distinct_on_attrs( $d );
489              
490 0 0         if( @distinct_on )
491             {
492 0           assert( scalar @distinct_on == 1, "count of distinct is not yet supported for multiple PK models" );
493 0           my @fields = map { sprintf( "%s.%s",
494 0   0       ( $args{ '_table_alias' } or $self -> _db_table() ),
495             &__get_db_field_name( $_ ) ) } @distinct_on;
496 0           $rv = 'DISTINCT ' . join( ", ", @fields );
497             } else
498             {
499 0   0       warn( sprintf( "Don't know on what to DISTINCT (no PK and fields not passed) for %s",
500             ( ref( $self ) or $self ) ) );
501             }
502             }
503             }
504              
505 0           return $rv;
506             }
507              
508             sub __get_distinct_on_attrs
509             {
510 0     0     my ( $self, $d ) = @_;
511              
512 0           my @distinct_on = ();
513              
514 0 0         if( ref( $d ) eq 'ARRAY' )
515             {
516 0           foreach my $aname ( @{ $d } )
  0            
517             {
518 0   0       my $model_name = ( ref( $self ) or $self );
519 0 0         if( LittleORM::Model::Field -> this_is_field( $aname ) )
520             {
521 0           assert( $aname -> model() eq $model_name,
522             sprintf( "field %s from %s can not be used in model %s",
523             $aname -> base_attr(),
524             $aname -> model(),
525             $model_name ) );
526 0           $aname = $aname -> base_attr();
527             }
528              
529 0           assert( my $attr = $self -> meta() -> get_attribute( $aname ),
530             sprintf( 'invalid attr "%s" passed for model "%s"',
531             $aname,
532             $model_name ) );
533 0           push @distinct_on, $attr;
534             }
535            
536            
537             } else
538             {
539 0           @distinct_on = $self -> __find_primary_keys();
540             }
541            
542 0           return @distinct_on;
543            
544             }
545              
546             sub __form_sql_func_sql
547             {
548 0     0     my $self = shift;
549              
550 0           my @args = @_;
551 0           my %args = @args;
552              
553 0           my @where_args = $self -> __form_where( @args,
554             &__for_read() );
555              
556 0           my @tables_to_select_from = ( $self -> _db_table() );
557              
558 0 0         if( my $t = $args{ '_tables_to_select_from' } )
559             {
560 0           @tables_to_select_from = @{ $t };
  0            
561             }
562 0           assert( my $func = $args{ '_func' } );
563 0           my $dbf = $self -> __default_db_field_name_for_func( %args );
564              
565 0 0         if( my $attrname = $args{ '_attr' } )
566             {
567 0 0         if( LittleORM::Model::Field -> this_is_field( $attrname ) )
568             {
569 0           $dbf = $attrname -> form_field_name_for_db_select( $attrname -> determine_ta_for_field_from_another_model( $args{ '_tables_used' } ) );
570             } else
571             {
572 0           assert( my $attr = $self -> meta() -> find_attribute_by_name( $attrname ) );
573 0           $dbf = &__get_db_field_name( $attr );
574             }
575             }
576              
577             my $sql = sprintf( "SELECT %s%s(%s) FROM %s WHERE %s",
578             $self -> __form_sql_func_sql_more_fields( @args ),
579             $func,
580             $dbf,
581             join( ',', @tables_to_select_from ),
582 0   0       join( ' ' . ( $args{ '_logic' } or 'AND' ) . ' ', @where_args ) );
583              
584 0           $sql .= $self -> __form_additional_sql( @args );
585              
586 0           return $sql;
587             }
588              
589             sub __form_sql_func_sql_more_fields
590             {
591 0     0     my $self = shift;
592            
593 0           my @args = @_;
594 0           my %args = @args;
595 0           my $rv = '';
596            
597 0 0         if( my $t = $args{ '_groupby' } )
598             {
599 0           my @sqls = ();
600              
601 0   0       my $ta = ( $args{ '_table_alias' }
602             or
603             $self -> _db_table() );
604              
605 0           foreach my $grp ( @{ $t } )
  0            
606             {
607 0           my $f = undef;
608              
609 0 0         if( LittleORM::Model::Field -> this_is_field( $grp ) )
610             {
611 0           my $use_ta = $ta;
612              
613 0 0 0       if( $grp -> model() and ( $grp -> model() ne $self ) )
614             {
615 0           $use_ta = $grp -> determine_ta_for_field_from_another_model( $args{ '_tables_used' } );
616              
617             }
618 0           $f = $grp -> form_field_name_for_db_select_with_as( $use_ta );#form_field_name_for_db_select( $use_ta );
619              
620             } else
621             {
622 0           $f = sprintf( "%s.%s",
623             $ta,
624             &__get_db_field_name( $self -> meta() -> find_attribute_by_name( $grp ) ) );
625             }
626 0           push @sqls, $f;
627             }
628              
629 0           $rv .= join( ',', @sqls );
630 0           $rv .= ',';
631             }
632              
633 0           return $rv;
634             }
635              
636             sub count
637             {
638 0     0 0   my $self = shift;
639 0           return $self -> _sql_func_on_attr( 'count', '', @_ );
640              
641             }
642              
643             sub create
644             {
645 0     0 0   my $self = shift;
646 0           my @args = @_;
647              
648 0           my %args = $self -> __correct_insert_args( @args );
649 0           my $sql = $self -> __form_insert_sql( %args );
650              
651 0 0         if( $args{ '_debug' } )
652             {
653 0           return $sql;
654             }
655              
656 0           my $allok = undef;
657              
658             # if( my @pk = $self -> __find_primary_keys() )
659              
660 0           my $dbh = $self -> __get_dbh( @args,
661             &__for_write() );
662              
663             {
664 0           my $sth = &LittleORM::Db::prep( $sql, $dbh );
  0            
665 0           my $rc = $sth -> execute();
666              
667 0 0         if( $rc == 1 )
668             {
669             # $allok = 1;
670 0           my $data = $sth -> fetchrow_hashref();
671 0           $allok = $self -> create_one_return_value_item( $data, @args );
672              
673             # foreach my $pk ( @pk )
674             # {
675             # unless( $args{ $pk -> name() } )
676             # {
677             # my $field = &__get_db_field_name( $pk );
678             # $args{ $pk -> name() } = $data -> { $field };
679             # }
680             # }
681             }
682              
683 0           $sth -> finish();
684              
685             }
686              
687 0 0         if( $allok )
688             {
689 0           return $allok; #$self -> get( $self -> __leave_only_pk( %args ) );
690             }
691              
692 0           assert( 0, sprintf( "%s: %s", $sql, &LittleORM::Db::errstr( $dbh ) ) );
693             }
694              
695              
696              
697              
698              
699             sub _process_create_many_args
700             {
701 0     0     my $self = shift;
702              
703 0           my @args = @_;
704              
705              
706              
707 0           my $new_records_data = ();
708 0           my $extra_args_data = {};
709              
710 0           my $index_of_first_args_el_which_is_not_ref = ${ [ grep { not ref( $args[ $_ ] ) } ( 0 .. $#args ) ] }[ 0 ];
  0            
  0            
711              
712 0 0         if( $index_of_first_args_el_which_is_not_ref )
713             {
714              
715 0           @{ $new_records_data } = @args[ 0 .. $index_of_first_args_el_which_is_not_ref - 1 ];
  0            
716 0           %{ $extra_args_data } = @args[ $index_of_first_args_el_which_is_not_ref .. $#args ];
  0            
717             } else
718             {
719 0           $new_records_data = \@args;
720             }
721              
722 0           return ( $new_records_data,
723             $extra_args_data );
724              
725             }
726              
727             sub create_many
728             {
729 0     0 0   my $self = shift;
730              
731 0           my ( $new_records_data,
732             $extra_args_data ) = $self -> _process_create_many_args( @_ );
733              
734             {
735 0           assert( my $cnt = scalar @{ $new_records_data } );
  0            
  0            
736              
737 0           for( my $i = 0; $i < $cnt; $i ++ )
738             {
739 0           my %args = $self -> __correct_insert_args( @{ $new_records_data -> [ $i ] } );
  0            
740 0           $new_records_data -> [ $i ] = \%args;
741             }
742             }
743              
744 0           my $fields = undef;
745 0           my @values_sets = ();
746 0           my $dbh = $self -> __get_dbh( %{ $extra_args_data },
  0            
747             &__for_write() );
748              
749 0           foreach my $nrd ( @{ $new_records_data } )
  0            
750             {
751 0           my ( $f, $v ) = $self -> __form_fields_and_values_for_insert_sql( %{ $nrd } );
  0            
752 0   0       assert( $f and $v );
753 0 0         unless( defined $fields )
754             {
755 0           $fields = $f;
756             }
757 0           push @values_sets, join( ',', @{ $v } );
  0            
758             }
759              
760             my $sql = sprintf( "INSERT INTO %s (%s) VALUES %s RETURNING *",
761             $self -> _db_table(),
762 0           join( ',', @{ $fields } ),
763 0           join( ',', map { '(' . $_ . ')' } @values_sets ) );
  0            
764            
765              
766 0 0         if( $extra_args_data -> { '_debug' } )
767             {
768 0           return $sql;
769             }
770              
771 0           my @rv = ();
772              
773             {
774 0           my $sth = &LittleORM::Db::prep( $sql, $dbh ); #$self -> __get_dbh( %{ $extra_args_data } ) );
  0            
775 0           my $rc = $sth -> execute();
776              
777 0 0         if( $rc == scalar @{ $new_records_data } )
  0            
778             {
779 0           while( my $data = $sth -> fetchrow_hashref() )
780             {
781 0           my $o = $self -> create_one_return_value_item( $data, %{ $extra_args_data } );
  0            
782 0           push @rv, $o;
783             }
784              
785             } else
786             {
787 0           assert( 0, 'insert error' );
788             }
789            
790 0           $sth -> finish();
791             }
792              
793 0           return @rv;
794             }
795              
796             sub __leave_only_pk
797             {
798 0     0     my $self = shift;
799              
800 0           my %args = @_;
801 0           my %rv = ();
802              
803 0           foreach my $attr ( $self -> __find_primary_keys() )
804             {
805 0           my $aname = $attr -> name();
806 0 0         if( exists $args{ $aname } )
807             {
808 0           $rv{ $aname } = $args{ $aname };
809             }
810             }
811            
812 0 0         unless( %rv )
813             {
814 0           %rv = %args;
815             }
816              
817 0           return %rv;
818             }
819              
820             sub __find_attr_by_its_db_field_name
821             {
822 0     0     my ( $self, $db_field_name ) = @_;
823              
824 0           my $rv = undef;
825              
826             pgmxcobWi7lULIJW:
827 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
828             {
829 0 0         if( &__get_db_field_name( $attr ) eq $db_field_name )
830             {
831 0           $rv = $attr;
832 0           last pgmxcobWi7lULIJW;
833             }
834             }
835              
836 0           return $rv;
837             }
838              
839             sub update
840             {
841 0     0 0   my $self = shift;
842              
843 0           my %args = ();
844              
845 0 0         if( scalar @_ == 1 )
846             {
847 0           $args{ '_debug' } = $_[ 0 ];
848             } else
849             {
850 0           %args = @_;
851             }
852            
853 0           my @upadte_pairs = $self -> __get_update_pairs_for_update_request( %args );
854              
855 0           my $where = $self -> __form_update_request_where_part( %args );
856 0           my $sql = sprintf( 'UPDATE %s SET %s WHERE %s',
857             $self -> _db_table(),
858             join( ',', @upadte_pairs ),
859             $where );
860              
861 0           my $rc = undef;
862 0           my $dbh = $self -> __get_dbh( &__for_write() );
863              
864 0 0         if( $args{ '_debug' } )
865             {
866 0           return $sql;
867             } else
868             {
869 0           $rc = &LittleORM::Db::doit( $sql, $dbh );
870            
871 0 0         if( ref( $self ) )
872             {
873 0 0         if( $rc != 1 )
874             {
875 0           assert( 0, sprintf( "%s: %s", $sql, &LittleORM::Db::errstr( $dbh ) ) );
876             }
877             }
878             }
879 0           return $rc;
880             }
881              
882              
883             sub __get_update_pairs_for_update_request
884             {
885 0     0     my $self = shift;
886 0           my %args = @_;
887              
888 0           my @upadte_pairs = ();
889              
890              
891 0 0         if( ref( $self ) )
892             {
893 0           @upadte_pairs = $self -> __get_update_pairs_for_update_request_called_from_instance( %args );
894             } else
895             {
896 0           @upadte_pairs = $self -> __get_update_pairs_for_update_request_called_from_class( %args );
897             }
898              
899 0           return @upadte_pairs;
900              
901             }
902              
903             sub __get_update_pairs_for_update_request_called_from_instance
904             {
905 0     0     my $self = shift;
906 0           my %args = @_;
907              
908 0           my @upadte_pairs = ();
909              
910             ETxc0WxZs0boLUm1:
911 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
912             {
913 0 0         if( $self -> __should_ignore_on_write( $attr ) )
914             {
915 0           next ETxc0WxZs0boLUm1;
916             }
917            
918 0           my $aname = $attr -> name();
919            
920 0 0         if( exists $args{ $aname } )
921             {
922 0           $self -> $aname( $args{ $aname } );
923             }
924            
925 0           my $value = &__prep_value_for_db( $attr, $self -> $aname() );
926            
927 0           push @upadte_pairs, sprintf( '%s=%s',
928             &__get_db_field_name( $attr ),
929             &LittleORM::Db::dbq( $value, $self -> __get_dbh( &__for_write() ) ) );
930            
931             }
932            
933 0           return @upadte_pairs;
934              
935             }
936              
937             sub __get_update_pairs_for_update_request_called_from_class
938             {
939 0     0     my $self = shift;
940 0           my %args = @_;
941              
942 0           my @upadte_pairs = ();
943              
944 0           while( my ( $k, $v ) = each %args )
945             {
946 0 0         unless( $k =~ /^_/ ) # only system props and no real class attrs should start with underscore
947             {
948 0           assert( my $attr = $self -> meta() -> find_attribute_by_name( $k ) );
949              
950 0 0         if( $self -> __should_ignore_on_write( $attr ) )
951             {
952 0           assert( 0, 'attr which should be ignored passed into update:' . $k );
953             } else
954             {
955 0           my $value = &__prep_value_for_db( $attr, $v );
956 0           my $typecast = '';
957              
958 0 0         if( LittleORM::Model::Field -> this_is_field( $value ) )
959             {
960 0 0 0       if( ( my $t1 = &__descr_attr( $attr, 'db_field_type' ) )
961             and
962             ( my $t2 = $value -> db_field_type() ) )
963             {
964 0 0         unless( $t1 eq $t2 )
965             {
966 0           $typecast = '::' . $t1;
967             }
968             }
969 0           $value = $value -> form_field_name_for_db_select();
970              
971             } else
972             {
973 0           $value = &LittleORM::Db::dbq( $value, $self -> __get_dbh( &__for_write() ) );
974             }
975              
976 0           push @upadte_pairs, sprintf( '%s=%s%s',
977             &__get_db_field_name( $attr ),
978             $value,
979             $typecast );
980             }
981              
982             }
983             }
984            
985 0           return @upadte_pairs;
986             }
987              
988             sub __form_update_request_where_part
989             {
990 0     0     my $self = shift;
991 0           my %args = @_;
992              
993 0           my @where = ();
994              
995 0 0         if( my $w = $args{ '_where' } )
996             {
997 0           assert( not ref( $self ) ); # only class call, not instance call
998 0 0         if( ref( $w ) eq 'ARRAY' )
999             {
1000 0           @where = $self -> __form_where( @{ $w },
  0            
1001             &__for_write() );
1002             } else
1003             {
1004 0           push @where, $w;
1005             }
1006              
1007             } else
1008             {
1009 0           assert( my @pkattr = $self -> __find_primary_keys(), 'cant update without primary key' );
1010              
1011 0           my %where_args = ();
1012              
1013 0           foreach my $pkattr ( @pkattr )
1014             {
1015 0           my $pkname = $pkattr -> name();
1016 0           $where_args{ $pkname } = $self -> $pkname();
1017             }
1018 0           @where = $self -> __form_where( %where_args,
1019             &__for_write() );
1020             }
1021              
1022 0           assert( my $where = join( ' AND ', @where ) );
1023              
1024 0           return $where;
1025             }
1026              
1027             sub copy
1028             {
1029 0     0 0   my $self = shift;
1030              
1031 0           my %args = @_;
1032              
1033 0           assert( my $class = ref( $self ), 'this is object method' );
1034              
1035 0           my %copied_args = %args;
1036              
1037             kdCcjt3iG8jOfthJ:
1038 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
1039             {
1040 0 0         if( $self -> __should_ignore_on_write( $attr ) )
1041             {
1042 0           next kdCcjt3iG8jOfthJ;
1043             }
1044 0           my $aname = $attr -> name();
1045              
1046 0 0         unless( exists $copied_args{ $aname } )
1047             {
1048 0           $copied_args{ $aname } = $self -> $aname();
1049             }
1050             }
1051              
1052 0           return $class -> create( %copied_args );
1053             }
1054              
1055             sub delete
1056             {
1057 0     0 0   my $self = shift;
1058              
1059 0           my @args = @_;
1060 0           my %args = @args;
1061              
1062 0           my $sql = $self -> __form_delete_sql( @args );
1063              
1064 0 0         if( $args{ '_debug' } )
1065             {
1066 0           return $sql;
1067             }
1068              
1069 0           my $rc = &LittleORM::Db::doit( $sql, $self -> __get_dbh( @args,
1070             &__for_write() ) );
1071              
1072 0           return $rc;
1073             }
1074              
1075             sub meta_change_attr
1076             {
1077 0     0 0   my $self = shift;
1078              
1079 0           my $arg = shift;
1080              
1081 0           my %attrs = @_;
1082              
1083 0           my $arg_obj = $self -> meta() -> find_attribute_by_name( $arg );
1084              
1085 0           my $cloned_arg_obj = $arg_obj -> clone();
1086              
1087 0   0 0     my $d = ( $cloned_arg_obj -> description() or sub {} -> () );
1088              
1089 0           my %new_description = %{ $d };
  0            
1090              
1091 0           while( my ( $k, $v ) = each %attrs )
1092             {
1093 0 0         if( $v )
1094             {
1095 0           $new_description{ $k } = $v;
1096             } else
1097             {
1098 0           delete $new_description{ $k };
1099             }
1100             }
1101              
1102 0           $cloned_arg_obj -> description( \%new_description );
1103              
1104 0           $self -> meta() -> add_attribute( $cloned_arg_obj );
1105             }
1106              
1107             sub BUILD
1108             {
1109 0     0 0   my $self = shift;
1110              
1111 0           my $orm_initialized_attr_desc_option = '__orm_initialized_attr_' . ref( $self );
1112 0           my $orm_initialized_attr_desc_option_hf = '__orm_initialized_attr_has_field_';
1113              
1114              
1115             FXOINoqUOvIG1kAG:
1116 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
1117             {
1118 0           my $aname = $attr -> name();
1119              
1120 0 0 0       if( $self -> __should_ignore( $attr )
      0        
1121             or
1122             &__descr_attr( $attr, $orm_initialized_attr_desc_option )
1123             or
1124             &__descr_attr( $attr, $orm_initialized_attr_desc_option_hf ) )
1125             {
1126             # internal attrs start with underscore, skip them
1127 0           next FXOINoqUOvIG1kAG;
1128             }
1129              
1130             {
1131              
1132 0   0       my $newdescr = ( &__descr_or_undef( $attr ) or {} );
  0            
1133 0           $newdescr -> { $orm_initialized_attr_desc_option } = 1;
1134              
1135 0           my $predicate = $attr -> predicate();
1136 0           my $trigger = $attr -> trigger();
1137 0           my $clearer = $attr -> clearer(); # change made by Kain
1138             # I really need this sometimes in case of processing thousands of objects
1139             # and manual cleanup so I'm avoiding cache-related memleaks
1140             # so if you want to give me whole server RAM - wipe it out :)
1141              
1142 0 0         my $handles = ( $attr -> has_handles() ? $attr -> handles() : undef ); # also made by kain
1143              
1144 0           my $orig_method = $self -> meta() -> get_method( $aname );
1145              
1146 0           $attr -> default( undef );
1147             $self -> meta() -> add_attribute( $aname, ( is => 'rw',
1148             isa => $attr -> { 'isa' },
1149             coerce => $attr -> { 'coerce' },
1150              
1151              
1152             ( defined $predicate ? ( predicate => $predicate ) : () ),
1153             ( defined $trigger ? ( trigger => $trigger ) : () ),
1154             ( defined $clearer ? ( clearer => $clearer ) : () ),
1155             ( defined $handles ? ( handles => $handles ) : () ),
1156              
1157             lazy => 1,
1158             metaclass => 'LittleORM::Meta::Attribute',
1159             description => $newdescr,
1160 0 0   0     default => sub { $_[ 0 ] -> __lazy_build_value( $attr ) } ) );
  0 0          
    0          
    0          
1161              
1162 0 0 0       if( $orig_method and $orig_method -> isa( 'Class::MOP::Method::Wrapped' ) )
1163             {
1164 0           my $new_method = $self -> meta() -> get_method( $aname );
1165 0           my $new_meta_method = Class::MOP::Method::Wrapped -> wrap( $new_method );
1166            
1167 0           map { $new_meta_method -> add_around_modifier( $_ ) } $orig_method -> around_modifiers();
  0            
1168 0           map { $new_meta_method -> add_before_modifier( $_ ) } $orig_method -> before_modifiers();
  0            
1169 0           map { $new_meta_method -> add_after_modifier( $_ ) } $orig_method -> after_modifiers();
  0            
1170            
1171 0           $self -> meta() -> add_method( $aname, $new_meta_method );
1172             }
1173             }
1174             }
1175             }
1176              
1177             sub __lazy_build_value
1178             {
1179 0     0     my $self = shift;
1180 0           my $attr = shift;
1181              
1182 0           my $rec_field_name = &__get_db_field_name( $attr );
1183              
1184             my $t = $self -> __lazy_build_value_actual( $attr,
1185 0           $self -> _rec() -> { $rec_field_name } );
1186              
1187 0           return $t;
1188             }
1189              
1190              
1191             sub __lazy_build_value_actual
1192             {
1193 0     0     my ( $self, $attr, $t ) = @_;
1194              
1195 0           my $coerce_from = &__descr_attr( $attr, 'coerce_from' );
1196              
1197 0 0         if( defined $coerce_from )
    0          
1198             {
1199 0           $t = $coerce_from -> ( $t );
1200            
1201             } elsif( my $foreign_key = &__descr_attr( $attr, 'foreign_key' ) )
1202             {
1203 0 0         if( $foreign_key eq 'yes' )
1204             {
1205             # sugar
1206 0           assert( $attr -> has_type_constraint() );
1207 0           $foreign_key = $attr -> type_constraint() -> name();
1208             }
1209              
1210 0           &__load_module( $foreign_key );
1211              
1212 0           my $foreign_key_attr_name = &__descr_attr( $attr, 'foreign_key_attr_name' );
1213              
1214 0 0         unless( $foreign_key_attr_name )
1215             {
1216 0           my $his_pk = $foreign_key -> __find_primary_key();
1217 0           $foreign_key_attr_name = $his_pk -> name();
1218             }
1219            
1220 0   0       $t = $foreign_key -> get( $foreign_key_attr_name => $t,
1221             _dbh => ( $foreign_key -> __get_dbh( &__for_read() )
1222             or
1223             $self -> __get_dbh( &__for_read() ) ) );
1224             }
1225            
1226 0           return $t;
1227              
1228             }
1229              
1230              
1231             sub __load_module
1232             {
1233 0     0     my $mn = shift;
1234              
1235 0           Module::Load::load( $mn );
1236              
1237             }
1238              
1239             sub __correct_insert_args
1240             {
1241 0     0     my $self = shift;
1242 0           my %args = @_;
1243              
1244 0           my $dbh = $self -> __get_dbh( %args,
1245             &__for_write() );
1246              
1247             wus2eQ_YY2I_r3rb:
1248 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
1249             {
1250              
1251 0 0 0       if( &__descr_attr( $attr, 'ignore' )
1252             or
1253             &__descr_attr( $attr, 'ignore_write' ) )
1254             {
1255 0           next wus2eQ_YY2I_r3rb;
1256             }
1257              
1258 0           my $aname = $attr -> name();
1259 0 0         unless( exists $args{ $aname } )
1260             {
1261 0 0         if( my $seqname = &__descr_attr( $attr, 'sequence' ) )
1262             {
1263 0           my $nv = &LittleORM::Db::nextval( $seqname, $dbh );
1264              
1265 0           $args{ $aname } = $nv;
1266             } else
1267             {
1268 0           $args{ $aname } = &__default_insert_field_cached();
1269             }
1270             }
1271             }
1272              
1273 0           return %args;
1274             }
1275              
1276             {
1277             my $rv = undef;
1278              
1279             sub __default_insert_field_cached
1280             {
1281 0 0   0     unless( $rv )
1282             {
1283 0           $rv = LittleORM::Model::Field -> new( db_func => 'DEFAULT',
1284             db_func_tpl => '%s' );
1285             }
1286 0           return $rv;
1287             }
1288             }
1289              
1290              
1291             sub __form_fields_and_values_for_insert_sql
1292             {
1293 0     0     my $self = shift;
1294 0           my %args = @_;
1295              
1296 0           my @fields = ();
1297 0           my @values = ();
1298              
1299 0           my $dbh = $self -> __get_dbh( %args,
1300             &__for_write() );
1301              
1302             XmXRGqnrCTqWH52Z:
1303 0           foreach my $arg ( sort keys %args ) # sort here is crucial for create_many() , see test 040
1304             {
1305 0           my $val = $args{ $arg };
1306 0 0         if( $arg =~ /^_/ )
1307             {
1308 0           next XmXRGqnrCTqWH52Z;
1309             }
1310              
1311 0           assert( my $attr = $self -> meta() -> find_attribute_by_name( $arg ),
1312             sprintf( 'invalid attr name passed: %s', $arg ) );
1313              
1314 0 0 0       if( &__descr_attr( $attr, 'ignore' )
1315             or
1316             &__descr_attr( $attr, 'ignore_write' ) )
1317             {
1318 0           next XmXRGqnrCTqWH52Z;
1319             }
1320              
1321             ( undef,
1322 0           $val,
1323             undef,
1324             undef,
1325             undef ) = $self -> determine_op_and_col_and_correct_val( $arg,
1326             $val,
1327             $self -> _db_table(),
1328             { %args,
1329             __we_do_insert_now => 'yes' },
1330             $dbh );
1331              
1332 0           my $field_name = &__get_db_field_name( $attr );
1333            
1334 0           push @fields, $field_name;
1335 0           push @values, $val;
1336             }
1337              
1338 0           return ( \@fields, \@values );
1339             }
1340              
1341              
1342              
1343             sub __form_insert_sql
1344             {
1345 0     0     my $self = shift;
1346              
1347 0           my %args = @_;
1348 0           my ( $fields, $values ) = $self -> __form_fields_and_values_for_insert_sql( %args );
1349            
1350 0           my $dbh = $self -> __get_dbh( %args,
1351             &__for_write() );
1352             my $sql = sprintf( "INSERT INTO %s (%s) VALUES (%s) RETURNING *",
1353             $self -> _db_table(),
1354 0           join( ',', @{ $fields } ),
1355 0           join( ',', @{ $values } ) );
  0            
1356              
1357 0           return $sql;
1358             }
1359              
1360             sub __prep_value_for_db
1361             {
1362 0     0     my ( $attr, $value ) = @_;
1363              
1364 0           my $isa = $attr -> { 'isa' };
1365 0           my $perform_coercion = 1;
1366              
1367 0 0         if( LittleORM::Model::Value -> this_is_value( $value ) )
1368             {
1369 0 0         unless( $value -> orm_coerce() )
1370             {
1371 0           $perform_coercion = 0;
1372             }
1373 0           $value = $value -> value(); # %)
1374             }
1375              
1376 0 0         if( $perform_coercion )
1377             {
1378 0           my $ftc = find_type_constraint( $isa );
1379              
1380 0 0 0       if( $ftc and $ftc -> has_coercion() )
1381             {
1382 0           $value = $ftc -> coerce( $value );
1383             }
1384             }
1385              
1386 0           my $rv = $value;
1387              
1388 0 0         unless( LittleORM::Model::Field -> this_is_field( $value ) )
1389             {
1390 0 0 0       if( $perform_coercion
1391             and
1392             ( my $coerce_to = &__descr_attr( $attr, 'coerce_to' ) ) )
1393             {
1394 0           $rv = $coerce_to -> ( $value );
1395             }
1396            
1397 0 0 0       if( blessed( $value ) and &__descr_attr( $attr, 'foreign_key' ) )
1398             {
1399 0           my $foreign_key_attr_name = &__descr_attr( $attr, 'foreign_key_attr_name' );
1400            
1401 0 0         unless( $foreign_key_attr_name )
1402             {
1403 0           my $his_pk = $value -> __find_primary_key();
1404 0           $foreign_key_attr_name = $his_pk -> name();
1405             }
1406 0           $rv = $value -> $foreign_key_attr_name();
1407             }
1408             }
1409            
1410 0           return $rv;
1411             }
1412              
1413             sub __form_delete_sql
1414             {
1415 0     0     my $self = shift;
1416              
1417 0           my @args = @_;
1418 0           my %args = @args;
1419              
1420 0 0         if( ref( $self ) )
1421             {
1422 0 0         if( my @pk = $self -> __find_primary_keys() )
1423             {
1424 0           foreach my $pk ( @pk )
1425             {
1426              
1427 0           my $pkname = $pk -> name();
1428 0           $args{ $pkname } = $self -> $pkname();
1429             }
1430             } else
1431             {
1432 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
1433             {
1434 0           my $aname = $attr -> name();
1435 0           $args{ $aname } = $self -> $aname();
1436             }
1437             }
1438             }
1439              
1440 0           my @where_args = $self -> __form_where( %args,
1441             &__for_write() );
1442              
1443 0           my $sql = sprintf( "DELETE FROM %s WHERE %s", $self -> _db_table(), join( ' AND ', @where_args ) );
1444              
1445 0           return $sql;
1446             }
1447              
1448             sub __should_ignore_on_write
1449             {
1450 0     0     my ( $self, $attr ) = @_;
1451 0           my $rv = $self -> __should_ignore( $attr );
1452              
1453 0 0         unless( $rv )
1454             {
1455 0 0 0       if( &__descr_attr( $attr, 'primary_key' )
1456             or
1457             &__descr_attr( $attr, 'ignore_write' ) )
1458             {
1459 0           $rv = 1;
1460             }
1461             }
1462              
1463 0           return $rv;
1464             }
1465              
1466             sub __should_ignore
1467             {
1468 0     0     my ( $self, $attr ) = @_;
1469 0           my $rv = 0;
1470              
1471 0 0         unless( $rv )
1472             {
1473 0           my $aname = $attr -> name();
1474 0 0         if( $aname =~ /^_/ )
1475             {
1476 0           $rv = 1;
1477             }
1478             }
1479              
1480 0 0         unless( $rv )
1481             {
1482              
1483 0 0         if( &__descr_attr( $attr, 'ignore' ) )
1484             {
1485 0           $rv = 1;
1486             }
1487             }
1488              
1489 0           return $rv;
1490             }
1491              
1492             sub __collect_field_names
1493             {
1494 0     0     my $self = shift;
1495 0           my %args = @_;
1496              
1497 0           my @rv = ();
1498              
1499 0           my $groupby = undef;
1500 0 0         if( my $t = $args{ '_groupby' } )
1501             {
1502 0           my %t = map { $_ => 1 } grep { not LittleORM::Model::Field -> this_is_field( $_ ) } @{ $t };
  0            
  0            
  0            
1503 0           $groupby = \%t;
1504             }
1505              
1506 0           my $field_set = $args{ '_fieldset' };
1507              
1508 0   0       my $ta = ( $args{ '_table_alias' }
1509             or
1510             $self -> _db_table() );
1511              
1512             QGVfwMGQEd15mtsn:
1513 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
1514             {
1515 0 0         if( $self -> __should_ignore( $attr ) )
1516             {
1517 0           next QGVfwMGQEd15mtsn;
1518             }
1519              
1520 0           my $aname = $attr -> name();
1521              
1522 0           my $db_fn = $ta .
1523             '.' .
1524             &__get_db_field_name( $attr );
1525              
1526 0 0         if( $groupby )
1527             {
1528 0 0         if( exists $groupby -> { $aname } )
1529             {
1530 0           push @rv, $db_fn;
1531             }
1532              
1533             } else
1534             {
1535 0 0         unless( $field_set )
1536             {
1537 0           push @rv, $db_fn;
1538             }
1539             }
1540             }
1541              
1542 0 0         if( $field_set )
1543             {
1544 0           foreach my $f ( @{ $field_set } )
  0            
1545             {
1546 0 0         unless( LittleORM::Model::Field -> this_is_field( $f ) )
1547             {
1548 0           $f = $self -> borrow_field( $f,
1549             select_as => &__get_db_field_name( $self -> meta() -> find_attribute_by_name( $f ) ) );
1550             }
1551              
1552 0           my $select = $f -> form_field_name_for_db_select_with_as( $ta );
1553              
1554 0 0         if( $f -> model() )
1555             {
1556             # unless( $f -> model() eq $self )
1557             # {
1558 0           my $ta = $f -> determine_ta_for_field_from_another_model( $args{ '_tables_used' } );
1559 0           $select = $f -> form_field_name_for_db_select_with_as( $ta );
1560             # }
1561             }
1562 0           push @rv, $select;# . ' AS ' . $f -> select_as();
1563             }
1564             }
1565              
1566 0           return @rv;
1567             }
1568              
1569             sub __form_get_sql
1570             {
1571 0     0     my $self = shift;
1572              
1573 0           my @args = @_;
1574 0           my %args = @args;
1575              
1576 0           my @where_args = $self -> __form_where( @args,
1577             &__for_read() );
1578              
1579 0           my @fields_names = $self -> __collect_field_names( @args );
1580              
1581 0           my @tables_to_select_from = ( $self -> _db_table() );
1582              
1583 0 0         if( my $t = $args{ '_tables_to_select_from' } )
1584             {
1585 0           @tables_to_select_from = @{ $t };
  0            
1586             }
1587              
1588 0           my $distinct_select = '';
1589              
1590 0 0         if( my $d = $args{ '_distinct' } )
1591             {
1592 0           $distinct_select = 'DISTINCT';
1593              
1594 0 0         if( my @distinct_on = $self -> __get_distinct_on_attrs( $d ) )
1595             {
1596 0           my @fields = map { sprintf( "%s.%s",
1597 0   0       ( $args{ '_table_alias' } or $self -> _db_table() ),
1598             &__get_db_field_name( $_ ) ) } @distinct_on;
1599              
1600 0           $distinct_select .= sprintf( " ON ( %s ) ", join( ',', @fields ) );
1601             } else
1602             {
1603              
1604 0   0       warn( sprintf( "Don't know on what to DISTINCT (no PK and fields not passed) for %s",
1605             ( ref( $self ) or $self ) ) );
1606              
1607             }
1608             }
1609              
1610             my $sql = sprintf( "SELECT %s %s FROM %s WHERE %s",
1611             $distinct_select,
1612             join( ',', @fields_names ),
1613             join( ',', @tables_to_select_from ),
1614 0   0       join( ' ' . ( $args{ '_logic' } or 'AND' ) . ' ', @where_args ) );
1615              
1616 0           $sql .= $self -> __form_additional_sql( @args );
1617              
1618 0           return $sql;
1619             }
1620              
1621             sub __form_additional_sql
1622             {
1623 0     0     my $self = shift;
1624              
1625 0           my @args = @_;
1626 0           my %args = @args;
1627              
1628 0           my $sql = '';
1629              
1630 0           $sql .= $self -> __form_additional_sql_groupby( @args );
1631              
1632 0 0         if( my $t = $args{ '_sortby' } )
1633             {
1634 0 0         if( ref( $t ) eq 'HASH' )
    0          
1635             {
1636             # then its like
1637             # { field1 => 'DESC',
1638             # field2 => 'ASC' ... }
1639              
1640 0           my @pairs = ();
1641              
1642 0           while( my ( $k, $sort_order ) = each %{ $t } )
  0            
1643             {
1644 0           my $dbf = $k;
1645              
1646 0 0         if( my $t = $self -> meta() -> find_attribute_by_name( $k ) )
1647             {
1648 0   0       $dbf = ( $args{ '_table_alias' }
1649             or
1650             $self -> _db_table() ) .
1651             '.' .
1652             &__get_db_field_name( $t );
1653              
1654             }
1655              
1656 0           push @pairs, sprintf( '%s %s',
1657             $dbf,
1658             $sort_order );
1659             }
1660 0           $sql .= ' ORDER BY ' . join( ',', @pairs );
1661             } elsif( ref( $t ) eq 'ARRAY' )
1662             {
1663 0           my @pairs = ();
1664              
1665 0           my @arr = @{ $t };
  0            
1666              
1667 0           while( @arr )
1668             {
1669 0           my $k = shift @arr;
1670 0           my $sort_order = shift @arr;
1671              
1672 0           my $dbf = $k;
1673 0 0         if( my $t = $self -> meta() -> find_attribute_by_name( $k ) )
    0          
1674             {
1675 0   0       $dbf = ( $args{ '_table_alias' }
1676             or
1677             $self -> _db_table() ) .
1678             '.' .
1679             &__get_db_field_name( $t );
1680             } elsif( LittleORM::Model::Field -> this_is_field( $k ) )
1681             {
1682             $dbf = $k -> form_field_name_for_db_select( $k -> table_alias()
1683             or
1684             $k -> determine_ta_for_field_from_another_model( $args{ '_tables_to_select_from' } ),
1685             or
1686 0   0       $args{ '_table_alias' }
1687             or
1688             $self -> _db_table() );
1689             }
1690              
1691 0   0       push @pairs, sprintf( '%s %s',
1692             ( $dbf or $k ),
1693             $sort_order );
1694             }
1695 0           $sql .= ' ORDER BY ' . join( ',', @pairs );
1696              
1697             } else
1698             {
1699             # then its attr name and unspecified order
1700 0           my $dbf = $t;
1701              
1702 0 0         if( my $t1 = $self -> meta() -> find_attribute_by_name( $t ) )
    0          
1703             {
1704 0   0       $dbf = ( $args{ '_table_alias' }
1705             or
1706             $self -> _db_table() ) . '.' . &__get_db_field_name( $t1 );
1707             } elsif( LittleORM::Model::Field -> this_is_field( $t ) )
1708             {
1709             $dbf = $t -> form_field_name_for_db_select( $t -> table_alias()
1710             or
1711 0   0       $args{ '_table_alias' }
1712             or
1713             $self -> _db_table() );
1714             }
1715              
1716 0           $sql .= ' ORDER BY ' . $dbf;
1717             }
1718             }
1719              
1720 0 0 0       if( my $t = int( $args{ '_limit' } or 0 ) )
1721             {
1722 0           $sql .= sprintf( ' LIMIT %d ', $t );
1723             }
1724              
1725 0 0 0       if( my $t = int( $args{ '_offset' } or 0 ) )
1726             {
1727 0           $sql .= sprintf( ' OFFSET %d ', $t );
1728             }
1729              
1730 0           return $sql;
1731             }
1732              
1733             sub __form_additional_sql_groupby
1734             {
1735 0     0     my $self = shift;
1736 0           my %args = @_;
1737 0           my $rv = '';
1738 0 0         if( my $t = $args{ '_groupby' } )
1739             {
1740 0           $rv = ' GROUP BY ';
1741              
1742              
1743 0           my @sqls = ();
1744              
1745 0   0       my $ta = ( $args{ '_table_alias' }
1746             or
1747             $self -> _db_table() );
1748              
1749 0           foreach my $grp ( @{ $t } )
  0            
1750             {
1751 0           my $f = undef;
1752              
1753 0 0         if( LittleORM::Model::Field -> this_is_field( $grp ) )
1754             {
1755             # $self -> assert_field_from_this_model( $grp );
1756              
1757 0           my $use_ta = $ta;
1758              
1759 0 0 0       if( $grp -> model() and ( $grp -> model() ne $self ) )
1760             {
1761 0           $use_ta = $grp -> determine_ta_for_field_from_another_model( $args{ '_tables_used' } );
1762             }
1763              
1764 0           $f = $grp -> form_field_name_for_db_select( $use_ta );
1765              
1766             } else
1767             {
1768 0           $f = sprintf( "%s.%s",
1769             $ta,
1770             &__get_db_field_name( $self -> meta() -> find_attribute_by_name( $grp ) ) );
1771             }
1772 0           push @sqls, $f;
1773             }
1774              
1775 0           $rv .= join( ',', @sqls );
1776             }
1777              
1778 0           return $rv;
1779             }
1780              
1781             sub __process_clause_sys_arg_in_form_where
1782             {
1783 0     0     my ( $self, $val, $args ) = @_;
1784              
1785 0 0         if( ref( $val ) eq 'ARRAY' )
1786             {
1787 0           my %more_args = ();
1788            
1789 0 0         if( my $ta = $args -> { '_table_alias' } )
1790             {
1791 0           $more_args{ 'table_alias' } = $ta;
1792             }
1793            
1794 0           $val = $self -> clause( @{ $val },
  0            
1795             %more_args );
1796            
1797 0           assert( ref( $val ) eq 'LittleORM::Clause' );
1798             } else
1799             {
1800 0           assert( ref( $val ) eq 'LittleORM::Clause' );
1801 0 0         if( my $ta = $args -> { '_table_alias' } )
1802             {
1803 0 0         unless( $val -> table_alias() )
1804             {
1805 0 0 0       if( ( ref( $self ) or $self ) eq $val -> model() )
1806             {
1807 0           my $copy = bless( { %{ $val } }, ref $val );
  0            
1808 0           $val = $copy;
1809 0           $val -> table_alias( $ta );
1810             }
1811             # my $copy = bless( { %{ $val } }, ref $val );
1812             # $val = $copy;
1813             # $val -> table_alias( $ta );
1814             }
1815             }
1816             }
1817 0           return $val;
1818             }
1819              
1820             sub __form_where
1821             {
1822 0     0     my $self = shift;
1823              
1824 0           my @args = @_;
1825 0           my %args = @args;
1826              
1827 0           my @where_args = ();
1828 0           my $dbh = $self -> __get_dbh( @args );
1829              
1830              
1831             fhFwaEknUtY5xwNr:
1832 0           while( my $attr = shift @args )
1833             {
1834 0           my $val = shift @args;
1835              
1836 0 0         if( $attr eq '_where' )
    0          
1837             {
1838 0           push @where_args, $val;
1839              
1840             } elsif( $attr eq '_clause' )
1841             {
1842 0           $val = $self -> __process_clause_sys_arg_in_form_where( $val,
1843             \%args );
1844 0           push @where_args, $val -> sql();
1845             }
1846              
1847 0 0         if( $attr =~ /^_/ ) # skip system agrs, they start with underscore
1848             {
1849 0           next fhFwaEknUtY5xwNr;
1850             }
1851              
1852 0           my ( $op, $col ) = ( undef, undef );
1853 0           my ( $val1_type, $val2_type ) = ( undef, undef );
1854 0   0       my $ta = ( $args{ '_table_alias' } or $self -> _db_table() );
1855              
1856 0           ( $op,
1857             $val,
1858             $col,
1859             $val1_type,
1860             $val2_type ) = $self -> determine_op_and_col_and_correct_val( $attr, $val, $ta, \%args, $dbh ); # this
1861             # is
1862             # not
1863             # a
1864             # structured
1865             # method,
1866             # this
1867             # is
1868             # just
1869             # code
1870             # moved
1871             # away
1872             # from
1873             # growing
1874             # too
1875             # big
1876             # function,
1877             # hilarious
1878             # comment
1879             # formatting
1880             # btw,
1881             # thx
1882             # emacs
1883 0 0         if( $op )
1884             {
1885 0           my $f = $col;
1886              
1887 0 0 0       unless( ( exists $args{ '_include_table_alias_into_sql' } )
1888             and
1889             ( $args{ '_include_table_alias_into_sql' } == 0 ) )
1890             {
1891 0           $f = $ta . '.' . $f;
1892             }
1893            
1894 0 0         if( LittleORM::Model::Field -> this_is_field( $attr ) )
1895             {
1896 0   0       $f = $attr -> form_field_name_for_db_select( $attr -> table_alias() or $ta );
1897             }
1898              
1899 0           my $cast = '';
1900              
1901 0 0 0       if( $val1_type and $val2_type and ( $val1_type ne $val2_type ) )
      0        
1902             {
1903 0           $cast = '::' . $val1_type;
1904             }
1905              
1906 0           push @where_args, sprintf( '%s %s %s%s',
1907             $f,
1908             $op,
1909             $val,
1910             $cast );
1911             }
1912             }
1913              
1914 0 0         unless( @where_args )
1915             {
1916 0           @where_args = ( '3=3' );
1917             }
1918             # print Data::Dumper::Dumper( \@where_args );
1919             # print Carp::longmess() . "\n\n\n";
1920 0           return @where_args;
1921             }
1922              
1923             sub determine_op_and_col_and_correct_val
1924             {
1925 0     0 0   my ( $self, $attr, $val, $ta, $args, $dbh ) = @_;
1926              
1927 0           my $op = '=';
1928 0           my $col = 'UNUSED';
1929 0           my ( $dbf_type1, $dbf_type2 ) = ( undef, undef );
1930 0           my $class_attr = undef;
1931            
1932 0 0         unless( LittleORM::Model::Field -> this_is_field( $attr ) )
1933             {
1934 0           assert( $class_attr = $self -> meta() -> find_attribute_by_name( $attr ),
1935             sprintf( 'invalid attribute: "%s"', $attr ) );
1936            
1937 0 0         if( &__descr_attr( $class_attr, 'ignore' ) )
1938             {
1939 0           $op = undef;
1940             } else
1941             {
1942 0           $attr = $self -> borrow_field( $class_attr -> name() );
1943 0           $col = &__get_db_field_name( $class_attr );
1944             }
1945             }
1946              
1947 0 0 0       if( $op and LittleORM::Model::Field -> this_is_field( $attr ) )
1948             {
1949 0 0         unless( $class_attr )
1950             {
1951 0 0         if( $attr -> base_attr() )
1952             {
1953 0           assert( $class_attr = $attr -> model() -> meta() -> find_attribute_by_name( $attr -> base_attr() ) );
1954             }
1955             }
1956              
1957 0           $dbf_type1 = $attr -> db_field_type();
1958              
1959 0 0         if( ref( $val ) eq 'HASH' )
    0          
    0          
1960             {
1961 0 0         if( $args -> { '__we_do_insert_now' } )
1962             {
1963 0           $val = $self -> __prep_value_for_db_w_field( &__prep_value_for_db( $class_attr, $val ),
1964             $ta,
1965             $args,
1966             $dbh );
1967             } else
1968             {
1969 0           my %t = %{ $val };
  0            
1970 0           my $rval = undef;
1971 0           ( $op, $rval ) = each %t;
1972            
1973 0 0         if( ref( $rval ) eq 'ARRAY' )
1974             {
1975 0           $val = sprintf( '(%s)', join( ',', map { $self -> __prep_value_for_db_w_field( &__prep_value_for_db( $class_attr, $_ ),
1976             $ta,
1977             $args,
1978 0           $dbh ) } @{ $rval } ) );
  0            
1979            
1980             } else
1981             {
1982 0           $val = $self -> __prep_value_for_db_w_field( &__prep_value_for_db( $class_attr, $rval ),
1983             $ta,
1984             $args,
1985             $dbh );
1986            
1987             }
1988             }
1989            
1990             } elsif( ref( $val ) eq 'ARRAY' )
1991             {
1992 0 0         if( $args -> { '__we_do_insert_now' } )
1993             {
1994              
1995 0           $val = &LittleORM::Db::dbq( $self -> __prep_value_for_db_w_field( &__prep_value_for_db( $class_attr, $val ),
1996             $ta,
1997             $args ),
1998             $dbh );
1999              
2000              
2001             # my @values = map { $self -> __prep_value_for_db_w_field( &__prep_value_for_db( $class_attr, $_ ),
2002             # $ta,
2003             # $args ) } @{ $val };
2004             # $val = &LittleORM::Db::dbq( \@values, $dbh );
2005              
2006             } else
2007             {
2008              
2009 0 0         if( my @values = map { $self -> __prep_value_for_db_w_field( &__prep_value_for_db( $class_attr, $_ ),
  0            
2010             $ta,
2011             $args,
2012 0           $dbh ) } @{ $val } )
2013             {
2014 0           $val = sprintf( "(%s)", join( ',', @values ) );
2015 0           $op = 'IN';
2016             } else
2017             {
2018 0           $val = "ANY('{}')";
2019             }
2020             }
2021            
2022             } elsif( LittleORM::Model::Field -> this_is_field( $val ) )
2023             {
2024 0           $dbf_type2 = $val -> db_field_type();
2025 0   0       my $use_ta = ( $val -> table_alias() or $ta );
2026 0 0         if( $val -> model() )
2027             {
2028 0 0         unless( $val -> model() eq $self )
2029             {
2030 0           $use_ta = $val -> determine_ta_for_field_from_another_model( $args -> { '_tables_used' } );
2031             }
2032              
2033             }
2034 0           $val = $val -> form_field_name_for_db_select( $use_ta );
2035             } else
2036             {
2037 0 0         if( LittleORM::Model::Value -> this_is_value( $val ) )
2038             {
2039 0           $dbf_type2 = $val -> db_field_type();
2040             }
2041 0           $val = $self -> __prep_value_for_db_w_field( &__prep_value_for_db( $class_attr, $val ),
2042             $ta,
2043             $args,
2044             $dbh );
2045             }
2046             }
2047              
2048 0           return ( $op, $val, $col, $dbf_type1, $dbf_type2 );
2049             }
2050              
2051             sub __prep_value_for_db_w_field
2052             {
2053 0     0     my ( $self, $v, $ta, $args, $dbh ) = @_;
2054              
2055 0           my $val = $v;
2056              
2057 0 0         if( LittleORM::Model::Field -> this_is_field( $v ) )
    0          
2058             {
2059 0           my $use_ta = $ta;
2060 0 0         if( $v -> model() )
2061             {
2062 0 0         unless( $v -> model() eq $self )
2063             {
2064 0           $use_ta = $v -> determine_ta_for_field_from_another_model( $args -> { '_tables_used' } );
2065             }
2066              
2067             }
2068              
2069 0           $val = $v -> form_field_name_for_db_select( $use_ta );
2070              
2071             } elsif( $dbh )
2072             {
2073 0           $val = &LittleORM::Db::dbq( $v,
2074             $dbh );
2075             }
2076            
2077              
2078 0           return $val;
2079             }
2080              
2081             sub __find_primary_key
2082             {
2083 0     0     my $self = shift;
2084              
2085 0           my @pk = $self -> __find_primary_keys();
2086              
2087 0           return $pk[ 0 ];
2088             }
2089              
2090              
2091             sub __find_primary_keys
2092             {
2093 0     0     my $self = shift;
2094              
2095 0           my @rv = ();
2096              
2097 0           foreach my $attr ( $self -> meta() -> get_all_attributes() )
2098             {
2099 0 0         if( my $pk = &__descr_attr( $attr, 'primary_key' ) )
2100             {
2101 0           push @rv, $attr;
2102             }
2103             }
2104 0           return @rv;
2105             }
2106              
2107             sub __descr_or_undef
2108             {
2109 0     0     my $attr = shift;
2110              
2111 0           my $rv = undef;
2112              
2113 0 0         if( $attr -> can( 'description' ) )
2114             {
2115 0           $rv = $attr -> description();
2116             }
2117            
2118 0           return $rv;
2119             }
2120              
2121             sub __get_db_field_name
2122             {
2123 0     0     my $attr = shift;
2124              
2125 0           assert( $attr );
2126              
2127 0           my $rv = $attr -> name();
2128              
2129 0 0         if( my $t = &__descr_attr( $attr, 'db_field' ) )
2130             {
2131 0           $rv = $t;
2132             }
2133            
2134 0           return $rv;
2135             }
2136              
2137             sub __descr_attr
2138             {
2139 0     0     my $attr = shift;
2140 0           my $attr_attr_name = shift;
2141              
2142 0           my $rv = undef;
2143              
2144 0 0         if( my $d = &__descr_or_undef( $attr ) )
2145             {
2146 0 0         if( my $t = $d -> { $attr_attr_name } )
2147             {
2148 0           $rv = $t;
2149             }
2150             }
2151              
2152 0           return $rv;
2153             }
2154              
2155             42;