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