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