Apply some changes
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Sector / DBI / Reference.pm
CommitLineData
a4d36ff6 1package DBM::Deep::Sector::DBI::Reference;
2
3use 5.006_000;
4
5use strict;
6use warnings FATAL => 'all';
7
8use base 'DBM::Deep::Sector::DBI';
9
10sub table { 'refs' }
11
12sub _init {
13 my $self = shift;
14
15 my $e = $self->engine;
16
17 unless ( $self->offset ) {
1f1f7e24 18 my $classname = Scalar::Util::blessed( delete $self->{data} );
a4d36ff6 19 $self->{offset} = $self->engine->storage->write_to(
20 refs => undef,
1f1f7e24 21 ref_type => $self->type,
22 classname => $classname,
a4d36ff6 23 );
24 }
25 else {
26 my ($rows) = $self->engine->storage->read_from(
27 refs => $self->offset,
28 qw( ref_type ),
29 );
30
31 $self->{type} = $rows->[0]{ref_type};
32 }
33
34 return;
35}
36
37sub get_data_for {
38 my $self = shift;
39 my ($args) = @_;
40
41 my ($rows) = $self->engine->storage->read_from(
42 datas => { ref_id => $self->offset, key => $args->{key} },
43 qw( id ),
44 );
45
46 return unless $rows->[0]{id};
47
48 $self->load(
49 $self->engine,
50 $rows->[0]{id},
51 'datas',
52 );
53}
54
55sub write_data {
56 my $self = shift;
57 my ($args) = @_;
58
350896ee 59 if ( ( $args->{value}->type || 'S' ) eq 'S' ) {
cf4a1344 60 $args->{value}{offset} = $self->engine->storage->write_to(
350896ee 61 datas => $args->{value}{offset},
62 ref_id => $self->offset,
63 data_type => 'S',
64 key => $args->{key},
65 value => $args->{value}{data},
350896ee 66 );
cf4a1344 67
68 $args->{value}->reload;
350896ee 69 }
70 else {
cf4a1344 71 # Write the Scalar of the Reference
350896ee 72 $self->engine->storage->write_to(
cf4a1344 73 datas => undef,
350896ee 74 ref_id => $self->offset,
75 data_type => 'R',
76 key => $args->{key},
77 value => $args->{value}{offset},
350896ee 78 );
79 }
a4d36ff6 80}
81
82sub delete_key {
83 my $self = shift;
84 my ($args) = @_;
85
86 my $old_value = $self->get_data_for({
87 key => $args->{key},
88 });
89
90 my $data;
91 if ( $old_value ) {
350896ee 92 $data = $old_value->data({ export => 1 });
a4d36ff6 93 $old_value->free;
94 }
95
96 return $data;
97}
98
350896ee 99sub get_classname {
100 my $self = shift;
1f1f7e24 101 my ($rows) = $self->engine->storage->read_from(
102 'refs', $self->offset,
103 qw( classname ),
104 );
105 return unless @$rows;
106 return $rows->[0]{classname};
350896ee 107}
108
4f034d8f 109# Look to hoist this method into a ::Reference trait
350896ee 110sub data {
111 my $self = shift;
112 my ($args) = @_;
113 $args ||= {};
114
4f034d8f 115 my $obj;
116 unless ( $obj = $self->engine->cache->{ $self->offset } ) {
117 $obj = DBM::Deep->new({
118 type => $self->type,
119 base_offset => $self->offset,
120 storage => $self->engine->storage,
121 engine => $self->engine,
122 });
123
124 if ( $self->engine->storage->{autobless} ) {
125 my $classname = $self->get_classname;
126 if ( defined $classname ) {
127 bless $obj, $classname;
128 }
350896ee 129 }
4f034d8f 130
131 $self->engine->cache->{$self->offset} = $obj;
350896ee 132 }
133
134 # We're not exporting, so just return.
135 unless ( $args->{export} ) {
136 return $obj;
137 }
138
139 # We shouldn't export if this is still referred to.
140 if ( $self->get_refcount > 1 ) {
141 return $obj;
142 }
143
144 return $obj->export;
145}
146
147sub free {
148 my $self = shift;
149
150 # We're not ready to be removed yet.
4f034d8f 151 return if $self->decrement_refcount > 0;
152
153 # Rebless the object into DBM::Deep::Null.
154 eval { %{ $self->engine->cache->{ $self->offset } } = (); };
155 eval { @{ $self->engine->cache->{ $self->offset } } = (); };
156 bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null';
157 delete $self->engine->cache->{ $self->offset };
350896ee 158
159 $self->engine->storage->delete_from(
160 'datas', { ref_id => $self->offset },
161 );
162
163 $self->engine->storage->delete_from(
164 'datas', { value => $self->offset, data_type => 'R' },
165 );
166
167 $self->SUPER::free( @_ );
168}
169
170sub increment_refcount {
641aa32d 171 my $self = shift;
172 my $refcount = $self->get_refcount;
173 $refcount++;
174 $self->write_refcount( $refcount );
175 return $refcount;
350896ee 176}
177
178sub decrement_refcount {
641aa32d 179 my $self = shift;
180 my $refcount = $self->get_refcount;
181 $refcount--;
182 $self->write_refcount( $refcount );
183 return $refcount;
350896ee 184}
185
186sub get_refcount {
641aa32d 187 my $self = shift;
188 my ($rows) = $self->engine->storage->read_from(
189 'refs', $self->offset,
190 qw( refcount ),
191 );
192 return $rows->[0]{refcount};
350896ee 193}
194
195sub write_refcount {
196 my $self = shift;
197 my ($num) = @_;
641aa32d 198 $self->engine->storage->{dbh}->do(
199 "UPDATE refs SET refcount = ? WHERE id = ?", undef,
200 $num, $self->offset,
201 );
350896ee 202}
203
a4d36ff6 2041;
205__END__