Commit | Line | Data |
a4d36ff6 |
1 | package DBM::Deep::Sector::DBI::Reference; |
2 | |
3 | use 5.006_000; |
4 | |
5 | use strict; |
6 | use warnings FATAL => 'all'; |
7 | |
8 | use base 'DBM::Deep::Sector::DBI'; |
9 | |
10 | sub table { 'refs' } |
11 | |
12 | sub _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 | |
37 | sub 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 | |
55 | sub 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 | |
82 | sub 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 |
99 | sub 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 |
110 | sub data { |
111 | my $self = shift; |
112 | my ($args) = @_; |
113 | $args ||= {}; |
114 | |
e73f12ce |
115 | my $engine = $self->engine; |
66285e35 |
116 | if ( !exists $engine->cache->{ $self->offset } ) { |
e73f12ce |
117 | my $obj = DBM::Deep->new({ |
4f034d8f |
118 | type => $self->type, |
119 | base_offset => $self->offset, |
e73f12ce |
120 | storage => $engine->storage, |
121 | engine => $engine, |
4f034d8f |
122 | }); |
123 | |
66285e35 |
124 | $engine->cache->{$self->offset} = $obj; |
125 | } |
126 | my $obj = $engine->cache->{$self->offset}; |
e73f12ce |
127 | |
128 | # We're not exporting, so just return. |
129 | unless ( $args->{export} ) { |
130 | if ( $engine->storage->{autobless} ) { |
4f034d8f |
131 | my $classname = $self->get_classname; |
132 | if ( defined $classname ) { |
133 | bless $obj, $classname; |
134 | } |
350896ee |
135 | } |
4f034d8f |
136 | |
350896ee |
137 | return $obj; |
138 | } |
139 | |
140 | # We shouldn't export if this is still referred to. |
141 | if ( $self->get_refcount > 1 ) { |
142 | return $obj; |
143 | } |
144 | |
145 | return $obj->export; |
146 | } |
147 | |
148 | sub free { |
149 | my $self = shift; |
150 | |
151 | # We're not ready to be removed yet. |
4f034d8f |
152 | return if $self->decrement_refcount > 0; |
153 | |
154 | # Rebless the object into DBM::Deep::Null. |
155 | eval { %{ $self->engine->cache->{ $self->offset } } = (); }; |
156 | eval { @{ $self->engine->cache->{ $self->offset } } = (); }; |
157 | bless $self->engine->cache->{ $self->offset }, 'DBM::Deep::Null'; |
158 | delete $self->engine->cache->{ $self->offset }; |
350896ee |
159 | |
160 | $self->engine->storage->delete_from( |
161 | 'datas', { ref_id => $self->offset }, |
162 | ); |
163 | |
164 | $self->engine->storage->delete_from( |
165 | 'datas', { value => $self->offset, data_type => 'R' }, |
166 | ); |
167 | |
168 | $self->SUPER::free( @_ ); |
169 | } |
170 | |
171 | sub increment_refcount { |
641aa32d |
172 | my $self = shift; |
173 | my $refcount = $self->get_refcount; |
174 | $refcount++; |
175 | $self->write_refcount( $refcount ); |
176 | return $refcount; |
350896ee |
177 | } |
178 | |
179 | sub decrement_refcount { |
641aa32d |
180 | my $self = shift; |
181 | my $refcount = $self->get_refcount; |
182 | $refcount--; |
183 | $self->write_refcount( $refcount ); |
184 | return $refcount; |
350896ee |
185 | } |
186 | |
187 | sub get_refcount { |
641aa32d |
188 | my $self = shift; |
189 | my ($rows) = $self->engine->storage->read_from( |
190 | 'refs', $self->offset, |
191 | qw( refcount ), |
192 | ); |
193 | return $rows->[0]{refcount}; |
350896ee |
194 | } |
195 | |
196 | sub write_refcount { |
197 | my $self = shift; |
198 | my ($num) = @_; |
641aa32d |
199 | $self->engine->storage->{dbh}->do( |
200 | "UPDATE refs SET refcount = ? WHERE id = ?", undef, |
201 | $num, $self->offset, |
202 | ); |
350896ee |
203 | } |
204 | |
e73f12ce |
205 | sub clear { |
206 | my $self = shift; |
207 | |
208 | DBM::Deep->new({ |
209 | type => $self->type, |
210 | base_offset => $self->offset, |
211 | storage => $self->engine->storage, |
212 | engine => $self->engine, |
213 | })->_clear; |
214 | |
215 | return; |
216 | } |
217 | |
a4d36ff6 |
218 | 1; |
219 | __END__ |