File Coverage

blib/lib/ORM/StatResultSet.pm
Criterion Covered Total %
statement 26 36 72.2
branch 6 12 50.0
condition 2 3 66.6
subroutine 3 6 50.0
pod 0 5 0.0
total 37 62 59.6


line stmt bran cond sub pod time code
1             #
2             # DESCRIPTION
3             # PerlORM - Object relational mapper (ORM) for Perl. PerlORM is Perl
4             # library that implements object-relational mapping. Its features are
5             # much similar to those of Java's Hibernate library, but interface is
6             # much different and easier to use.
7             #
8             # AUTHOR
9             # Alexey V. Akimov
10             #
11             # COPYRIGHT
12             # Copyright (C) 2005-2006 Alexey V. Akimov
13             #
14             # This library is free software; you can redistribute it and/or
15             # modify it under the terms of the GNU Lesser General Public
16             # License as published by the Free Software Foundation; either
17             # version 2.1 of the License, or (at your option) any later version.
18             #
19             # This library is distributed in the hope that it will be useful,
20             # but WITHOUT ANY WARRANTY; without even the implied warranty of
21             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22             # Lesser General Public License for more details.
23             #
24             # You should have received a copy of the GNU Lesser General Public
25             # License along with this library; if not, write to the Free Software
26             # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
27             #
28              
29             package ORM::StatResultSet;
30              
31 5     5   35 use ORM;
  5         8  
  5         3170  
32              
33             $VERSION = 0.8;
34              
35             ##
36             ## CONSTRUCTORS
37             ##
38              
39             ## use: $result_set = ORM::StatResultSet->new
40             ## (
41             ## class => string,
42             ## result => ORM::DbResultSet,
43             ## preload => HASH,
44             ## conv => HASH,
45             ## lazy_load => boolean,
46             ## );
47             ##
48             sub new
49             {
50 1     1 0 5 my $class = shift;
51 1         8 my %arg = @_;
52              
53 1         10 bless
54             {
55             class => $arg{class},
56             result => $arg{result},
57             preload => $arg{preload},
58             conv => $arg{conv},
59             lazy_load => $arg{lazy_load},
60             }, $class;
61             }
62              
63             ##
64             ## PROPERTIES
65             ##
66              
67 0     0 0 0 sub class { $_[0]->{class}; }
68              
69             sub next
70             {
71 2     2 0 5 my $self = shift;
72 2         4 my %arg = @_;
73 2         5 my $res;
74             my $error;
75              
76 2 50       9 if( exists $self->{preview} )
77             {
78 0         0 $res = $self->{preview};
79 0         0 delete $self->{preview};
80             }
81             else
82             {
83 2   66     16 my $pre_res = $self->{result} && $self->{result}->next_row;
84 2 100       17 return undef unless( defined $pre_res );
85              
86 1         5 $error = ORM::Error->new;
87              
88             # Convert raw values to objects
89 1         3 for my $name ( keys %{$self->{conv}} )
  1         5  
90             {
91 2 50       12 if( !$self->{conv}{$name} )
    50          
92             {
93 0         0 $res->{$name} = $pre_res->{$name};
94             }
95             elsif( $self->{preload}{$name} )
96             {
97 2         24 $res->{$name} = $self->{conv}{$name}->_cache->get( $pre_res->{$name}, 0 );
98              
99 2 50       9 unless( $res->{$name} )
100             {
101 2         4 my %prop;
102              
103 2         10 for my $prop_name ( $self->{conv}{$name}->_all_props )
104             {
105 13         58 $prop{$prop_name} = $pre_res->{"_${name} ${prop_name}"};
106             }
107 2         8 $prop{id} = $pre_res->{$name};
108              
109 2         19 $res->{$name} = $self->{conv}{$name}->_find_constructor
110             (
111             \%prop,
112             $self->{conv}{$name}->_db_tables_ref,
113             );
114              
115 2         10 $self->{conv}{$name}->_cache->add( $res->{$name} );
116             }
117             }
118             else
119             {
120 0         0 $res->{$name} = $self->{conv}{$name}->__ORM_new_db_value
121             (
122             value => $pre_res->{$name},
123             error => $error,
124             lazy_load => $self->{lazy_load},
125             );
126             }
127             }
128              
129 1         6 $error->upto( $arg{error} );
130             }
131              
132 1         19 return $res;
133             }
134              
135             sub preview
136             {
137 0     0 0   my $self = shift;
138              
139 0 0         $self->{preview} = $self->next( @_ ) unless( exists $self->{preview} );
140 0           return $self->{preview};
141             }
142              
143             sub amount
144             {
145 0     0 0   my $self = shift;
146              
147 0           $self->{result}->rows;
148             }