File Coverage

blib/lib/Class/Persist/Deleted.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Class::Persist::Deleted - Deleted objects
4              
5             =head1 SYNOPSIS
6              
7             $deleted = Class::Persist::Deleted->new();
8             $deleted->object( $object );
9             $deleted->store();
10              
11             =head1 DESCRIPTION
12              
13             Store deleted objects in a serialized form, for debugging purpose
14              
15             =head1 INHERITANCE
16              
17             Class::Persist
18              
19             =head1 METHODS
20              
21             =cut
22              
23             package Class::Persist::Deleted;
24 1     1   2404 use strict;
  1         2  
  1         43  
25 1     1   7 use warnings;
  1         2  
  1         62  
26 1     1   3081 use Storable qw( nfreeze thaw );
  1         5208  
  1         82  
27 1     1   9 use base qw( Class::Persist );
  1         3  
  1         132  
28              
29             __PACKAGE__->db_table('deleted');
30             __PACKAGE__->db_fields( qw/class dump/ );
31             __PACKAGE__->binary_fields(qw( dump ));
32             __PACKAGE__->mk_accessors( qw(object class dump) );
33              
34              
35              
36             sub load {
37             my $class = shift;
38             my $self = $class->SUPER::load(@_) or return;
39             $self->object( $self->deserialize() );
40             }
41              
42              
43             sub deflate {
44             my $self = shift;
45              
46             my $object = $self->object or Class::Persist::Error::InvalidParameters->throw(text => "No object set");
47             $self->oid( $object->oid ) or return $self->record("No object", 1);
48             $self->class( ref $object ) or return $self->record("No object", 1);
49             $self->dump( $self->serialize( $object ) );
50             }
51              
52              
53             =head2 serialize( $object )
54              
55             =cut
56              
57             sub serialize {
58             my $self = shift;
59             nfreeze( shift ) || Class::Persist::Error::InvalidParameters->throw(text => "Object cannot be serialized");
60             }
61              
62              
63             =head2 deserialize( $dump )
64              
65             =cut
66              
67             sub deserialize {
68             my $self = shift;
69             my $dump = shift || $self->dump || Class::Persist::Error::InvalidParameters->throw(text => "No dump to deserialize");
70             thaw( $dump );
71             }
72              
73              
74             sub validate {
75             my $self = shift;
76             $self->SUPER::validate(@_) && $self->object;
77             }
78              
79             ##
80             ## DB mapping utilities
81             ##
82              
83             sub db_fields_spec {
84             my $self = shift;
85             my $dbname = $self->dbh()->{Driver}{Name};
86             my $blob = $dbname eq 'Pg' ? 'bytea' : 'longblob';
87              
88             $self->SUPER::db_fields_spec, (
89             'class VARCHAR(255)',
90             "dump $blob NOT NULL",
91             )
92             };
93              
94              
95              
96             1;
97              
98             =head1 SEE ALSO
99              
100             Class::Persist
101              
102             =head1 AUTHOR
103              
104             Fotango
105              
106             =cut
107              
108             # Local Variables:
109             # mode:CPerl
110             # cperl-indent-level: 2
111             # indent-tabs-mode: nil
112             # End: