File Coverage

blib/lib/ORM/TjoinNull.pm
Criterion Covered Total %
statement 13 14 92.8
branch 1 2 50.0
condition n/a
subroutine 3 4 75.0
pod 0 4 0.0
total 17 24 70.8


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::TjoinNull;
30              
31             $VERSION = 0.81;
32              
33             sub new
34             {
35 14     14 0 23 my $class = shift;
36 14         39 my %arg = @_;
37 14         33 my $self = {};
38              
39 14 50       38 $self->{null_class} = $arg{null_class} if( $arg{null_class} );
40              
41 14         65 return bless $self, $class;
42             }
43              
44 1     1 0 3 sub copy { $_[0]; }
45              
46             sub merge
47             {
48 7     7 0 14 my $self = shift;
49 7         14 my $tjoin = shift;
50 7         70 my $copy = $tjoin->copy;
51              
52 7         16 %{$self} = %{$copy};
  7         35  
  7         30  
53 7         54 bless $self, ref $copy;
54             }
55              
56 0     0 0   sub null_class { shift->{null_class}; }