File Coverage

blib/lib/ORM/Broken.pm
Criterion Covered Total %
statement 3 11 27.2
branch 0 6 0.0
condition n/a
subroutine 1 3 33.3
pod n/a
total 4 20 20.0


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::Broken;
30              
31 5     5   25 use Carp;
  5         10  
  5         1213  
32              
33             $VERSION = 0.8;
34              
35             sub AUTOLOAD
36             {
37 0     0     my $self = shift;
38 0           my $method = $AUTOLOAD;
39              
40 0 0         if( ref $self )
41             {
42 0 0         if( $self->{deleted} )
43             {
44 0           croak
45             "Object of class '$self->{class}' with id #$self->{id}"
46             . " has been deleted and should not be used.";
47             }
48             else
49             {
50 0 0         croak
51             "Object of class '$self->{class}' with id #$self->{id}"
52             . " is broken after lazy load and should not be used."
53             . ( $self->{error}
54             ? ("Error occured during lazy load:\n".$self->{error}->text)
55             : "Object not found during lazy load."
56             );
57             }
58             }
59             else
60             {
61 0           croak "Warning! Use of broken object!";
62             }
63             }
64              
65             sub DESTROY
66 0     0     {
67             }
68              
69             1;