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 ) { |
18 | $self->{offset} = $self->engine->storage->write_to( |
19 | refs => undef, |
20 | ref_type => $self->type, |
21 | ); |
22 | } |
23 | else { |
24 | my ($rows) = $self->engine->storage->read_from( |
25 | refs => $self->offset, |
26 | qw( ref_type ), |
27 | ); |
28 | |
29 | $self->{type} = $rows->[0]{ref_type}; |
30 | } |
31 | |
32 | return; |
33 | } |
34 | |
35 | sub get_data_for { |
36 | my $self = shift; |
37 | my ($args) = @_; |
38 | |
39 | my ($rows) = $self->engine->storage->read_from( |
40 | datas => { ref_id => $self->offset, key => $args->{key} }, |
41 | qw( id ), |
42 | ); |
43 | |
44 | return unless $rows->[0]{id}; |
45 | |
46 | $self->load( |
47 | $self->engine, |
48 | $rows->[0]{id}, |
49 | 'datas', |
50 | ); |
51 | } |
52 | |
53 | sub write_data { |
54 | my $self = shift; |
55 | my ($args) = @_; |
56 | |
350896ee |
57 | if ( ( $args->{value}->type || 'S' ) eq 'S' ) { |
58 | $self->engine->storage->write_to( |
59 | datas => $args->{value}{offset}, |
60 | ref_id => $self->offset, |
61 | data_type => 'S', |
62 | key => $args->{key}, |
63 | value => $args->{value}{data}, |
64 | class => $args->{value}{class}, |
65 | ); |
66 | } |
67 | else { |
68 | $self->engine->storage->write_to( |
69 | datas => $args->{value}{offset}, |
70 | ref_id => $self->offset, |
71 | data_type => 'R', |
72 | key => $args->{key}, |
73 | value => $args->{value}{offset}, |
74 | class => $args->{value}{class}, |
75 | ); |
76 | } |
a4d36ff6 |
77 | |
78 | $args->{value}->reload; |
79 | } |
80 | |
81 | sub delete_key { |
82 | my $self = shift; |
83 | my ($args) = @_; |
84 | |
85 | my $old_value = $self->get_data_for({ |
86 | key => $args->{key}, |
87 | }); |
88 | |
89 | my $data; |
90 | if ( $old_value ) { |
350896ee |
91 | $data = $old_value->data({ export => 1 }); |
a4d36ff6 |
92 | $old_value->free; |
93 | } |
94 | |
95 | return $data; |
96 | } |
97 | |
350896ee |
98 | sub get_classname { |
99 | my $self = shift; |
100 | return; |
101 | } |
102 | |
103 | sub data { |
104 | my $self = shift; |
105 | my ($args) = @_; |
106 | $args ||= {}; |
107 | |
108 | my $obj = DBM::Deep->new({ |
109 | type => $self->type, |
110 | base_offset => $self->offset, |
111 | # staleness => $self->staleness, |
112 | storage => $self->engine->storage, |
113 | engine => $self->engine, |
114 | }); |
115 | |
116 | if ( $self->engine->storage->{autobless} ) { |
117 | my $classname = $self->get_classname; |
118 | if ( defined $classname ) { |
119 | bless $obj, $classname; |
120 | } |
121 | } |
122 | |
123 | # We're not exporting, so just return. |
124 | unless ( $args->{export} ) { |
125 | return $obj; |
126 | } |
127 | |
128 | # We shouldn't export if this is still referred to. |
129 | if ( $self->get_refcount > 1 ) { |
130 | return $obj; |
131 | } |
132 | |
133 | return $obj->export; |
134 | } |
135 | |
136 | sub free { |
137 | my $self = shift; |
138 | |
139 | # We're not ready to be removed yet. |
140 | if ( $self->decrement_refcount > 0 ) { |
141 | return; |
142 | } |
143 | |
144 | $self->engine->storage->delete_from( |
145 | 'datas', { ref_id => $self->offset }, |
146 | ); |
147 | |
148 | $self->engine->storage->delete_from( |
149 | 'datas', { value => $self->offset, data_type => 'R' }, |
150 | ); |
151 | |
152 | $self->SUPER::free( @_ ); |
153 | } |
154 | |
155 | sub increment_refcount { |
156 | return 1; |
157 | } |
158 | |
159 | sub decrement_refcount { |
160 | return 0; |
161 | } |
162 | |
163 | sub get_refcount { |
164 | return 1; |
165 | } |
166 | |
167 | sub write_refcount { |
168 | my $self = shift; |
169 | my ($num) = @_; |
170 | } |
171 | |
a4d36ff6 |
172 | 1; |
173 | __END__ |