File Coverage

blib/lib/ORM/Const.pm
Criterion Covered Total %
statement 11 16 68.7
branch 1 2 50.0
condition n/a
subroutine 3 6 50.0
pod 0 3 0.0
total 15 27 55.5


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::Const;
30              
31 5     5   28 use base 'ORM::Expr';
  5         7  
  5         2814  
32              
33             $VERSION = 0.8;
34              
35             sub new
36             {
37 6     6 0 9 my $class = shift;
38 6         11 my $value = shift;
39 6         7 my $nclass = shift;
40 6         27 my $self = { value=>$value, tjoin=>ORM::Tjoin->new( null_class=>$nclass ) };
41              
42 6         60 return bless $self, $class;
43             }
44              
45             sub new_int
46             {
47 0     0 0 0 my $class = shift;
48 0         0 my $self = { value=>(int shift), int=>1 };
49              
50 0         0 return bless $self, $class;
51             }
52              
53             sub _sql_str
54             {
55 6     6   9 my $self = shift;
56 6         14 my %arg = @_;
57              
58 6 50       95 $self->{int} ? $self->{value} : $arg{tjoin}->class->ORM::qc( $self->{value} );
59             }
60              
61 0     0 0   sub value { $_[0]->{value}; }
62 0     0     sub _tjoin { $_[0]->{tjoin}; }
63              
64             1;