Commit | Line | Data |
c1d23573 |
1 | package DBIx::Class::CDBICompat::LiveObjectIndex; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Scalar::Util qw/weaken/; |
7 | |
8 | use base qw/Class::Data::Inheritable/; |
9 | |
10 | __PACKAGE__->mk_classdata('purge_object_index_every' => 1000); |
11 | __PACKAGE__->mk_classdata('live_object_index' => { }); |
12 | __PACKAGE__->mk_classdata('live_object_init_count' => { }); |
13 | |
14 | # Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code, |
15 | # all blame due to me for whatever bugs I introduced porting it. |
16 | |
17 | sub _live_object_key { |
18 | my ($me) = @_; |
19 | my $class = ref($me) || $me; |
20 | my @primary = keys %{$class->_primaries}; |
21 | |
22 | # no key unless all PK columns are defined |
23 | return "" unless @primary == grep defined $me->get_column($_), @primary; |
24 | |
25 | # create single unique key for this object |
26 | return join "\030", $class, map { $_ . "\032" . $me->get_column($_) } |
27 | sort @primary; |
28 | } |
29 | |
30 | sub purge_dead_from_object_index { |
31 | my $live = $_[0]->live_object_index; |
32 | delete @$live{ grep !defined $live->{$_}, keys %$live }; |
33 | } |
34 | |
35 | sub remove_from_object_index { |
36 | my $self = shift; |
37 | my $obj_key = $self->_live_object_key; |
38 | delete $self->live_object_index->{$obj_key}; |
39 | } |
40 | |
41 | sub clear_object_index { |
42 | my $live = $_[0]->live_object_index; |
43 | delete @$live{ keys %$live }; |
44 | } |
45 | |
46 | # And now the fragments to tie it in to DBIx::Class::Table |
47 | |
48 | sub insert { |
49 | my ($self, @rest) = @_; |
50 | $self->NEXT::ACTUAL::insert(@rest); |
51 | # Because the insert will die() if it can't insert into the db (or should) |
52 | # we can be sure the object *was* inserted if we got this far. In which |
53 | # case, given primary keys are unique and _live_object_key only returns a |
54 | # value if the object has all its primary keys, we can be sure there |
55 | # isn't a real one in the object index already because such a record |
56 | # cannot have existed without the insert failing. |
57 | if (my $key = $self->_live_object_key) { |
58 | my $live = $self->live_object_index; |
59 | weaken($live->{$key} = $self); |
60 | $self->purge_dead_from_object_index |
61 | if ++$self->live_object_init_count->{count} |
62 | % $self->purge_object_index_every == 0; |
63 | } |
64 | #use Data::Dumper; warn Dumper($self); |
65 | return $self; |
66 | } |
67 | |
68 | sub _row_to_object { |
69 | my ($class, @rest) = @_; |
70 | my $new = $class->NEXT::ACTUAL::_row_to_object(@rest); |
71 | if (my $key = $new->_live_object_key) { |
72 | #warn "Key $key"; |
73 | my $live = $class->live_object_index; |
74 | return $live->{$key} if $live->{$key}; |
75 | weaken($live->{$key} = $new); |
76 | $class->purge_dead_from_object_index |
77 | if ++$class->live_object_init_count->{count} |
78 | % $class->purge_object_index_every == 0; |
79 | } |
80 | return $new; |
81 | } |
82 | |
83 | sub discard_changes { |
84 | my ($self) = @_; |
85 | if (my $key = $self->_live_object_key) { |
86 | $self->remove_from_object_index; |
87 | my $ret = $self->NEXT::ACTUAL::discard_changes; |
8d5134b0 |
88 | $self->live_object_index->{$key} = $self if $self->in_storage; |
c1d23573 |
89 | return $ret; |
90 | } else { |
91 | return $self->NEXT::ACTUAL::discard_changes; |
92 | } |
93 | } |
94 | |
95 | 1; |