Commit | Line | Data |
75d07914 |
1 | package # hide from PAUSE |
c0e7b4e5 |
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 | |
592cd0b1 |
15 | # Caching is on by default, but a classic CDBI hack to turn it off is to |
16 | # set this variable false. |
17 | $Class::DBI::Weaken_Is_Available = 1 |
18 | unless defined $Class::DBI::Weaken_Is_Available; |
19 | __PACKAGE__->mk_classdata('__nocache' => 0); |
20 | |
21 | sub nocache { |
22 | my $class = shift; |
d4daee7b |
23 | |
592cd0b1 |
24 | return $class->__nocache(@_) if @_; |
d4daee7b |
25 | |
592cd0b1 |
26 | return 1 if $Class::DBI::Weaken_Is_Available == 0; |
27 | return $class->__nocache; |
28 | } |
29 | |
c1d23573 |
30 | # Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code, |
31 | # all blame due to me for whatever bugs I introduced porting it. |
32 | |
c1d23573 |
33 | sub purge_dead_from_object_index { |
1f6715ab |
34 | my $live = shift->live_object_index; |
c1d23573 |
35 | delete @$live{ grep !defined $live->{$_}, keys %$live }; |
36 | } |
37 | |
38 | sub remove_from_object_index { |
1f6715ab |
39 | my $self = shift; |
40 | delete $self->live_object_index->{$self->ID}; |
c1d23573 |
41 | } |
42 | |
43 | sub clear_object_index { |
1f6715ab |
44 | my $live = shift->live_object_index; |
c1d23573 |
45 | delete @$live{ keys %$live }; |
46 | } |
47 | |
592cd0b1 |
48 | |
c1d23573 |
49 | # And now the fragments to tie it in to DBIx::Class::Table |
50 | |
51 | sub insert { |
52 | my ($self, @rest) = @_; |
147dd158 |
53 | $self->next::method(@rest); |
2007929b |
54 | |
592cd0b1 |
55 | return $self if $self->nocache; |
56 | |
2007929b |
57 | # Because the insert will die() if it can't insert into the db (or should) |
58 | # we can be sure the object *was* inserted if we got this far. In which |
59 | # case, given primary keys are unique and ID only returns a |
60 | # value if the object has all its primary keys, we can be sure there |
61 | # isn't a real one in the object index already because such a record |
62 | # cannot have existed without the insert failing. |
1f6715ab |
63 | if (my $key = $self->ID) { |
c1d23573 |
64 | my $live = $self->live_object_index; |
65 | weaken($live->{$key} = $self); |
66 | $self->purge_dead_from_object_index |
67 | if ++$self->live_object_init_count->{count} |
68 | % $self->purge_object_index_every == 0; |
69 | } |
2007929b |
70 | |
c1d23573 |
71 | return $self; |
72 | } |
73 | |
b52e9bf8 |
74 | sub inflate_result { |
c1d23573 |
75 | my ($class, @rest) = @_; |
147dd158 |
76 | my $new = $class->next::method(@rest); |
d4daee7b |
77 | |
592cd0b1 |
78 | return $new if $new->nocache; |
d4daee7b |
79 | |
1f6715ab |
80 | if (my $key = $new->ID) { |
c1d23573 |
81 | #warn "Key $key"; |
82 | my $live = $class->live_object_index; |
83 | return $live->{$key} if $live->{$key}; |
84 | weaken($live->{$key} = $new); |
85 | $class->purge_dead_from_object_index |
86 | if ++$class->live_object_init_count->{count} |
87 | % $class->purge_object_index_every == 0; |
88 | } |
89 | return $new; |
90 | } |
91 | |
c1d23573 |
92 | 1; |