File Coverage

blib/lib/DBIx/Class/Helper/Row/StorageValues.pm
Criterion Covered Total %
statement 37 37 100.0
branch 2 2 100.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 6 7 85.7
total 57 60 95.0


line stmt bran cond sub pod time code
1             package DBIx::Class::Helper::Row::StorageValues;
2             $DBIx::Class::Helper::Row::StorageValues::VERSION = '2.036000';
3             # ABSTRACT: Keep track of stored vs in-memory row values
4              
5 56     56   25786 use strict;
  56         133  
  56         1520  
6 56     56   273 use warnings;
  56         103  
  56         1371  
7              
8 56     56   274 use parent 'DBIx::Class::Row';
  56         119  
  56         370  
9              
10             __PACKAGE__->mk_group_accessors(inherited => '_storage_value_columns');
11             __PACKAGE__->mk_group_accessors(inherited => '_storage_values');
12              
13 513     513   26522 sub _has_storage_value { $_[0]->column_info($_[1])->{keep_storage_value} }
14              
15             sub storage_value_columns {
16 248     248 1 416 my $self = shift;
17 248 100       5050 if (!$self->_storage_value_columns) {
18 241         39136 $self->_storage_value_columns([
19             grep $self->_has_storage_value($_),
20             $self->result_source->columns
21             ]);
22             }
23 248         21953 return $self->_storage_value_columns;
24             }
25              
26             sub store_storage_values {
27 248     248 0 450 my $self = shift;
28             $self->_storage_values({
29             map {
30 72   33     2101 my $acc = ($self->column_info($_)->{accessor} || $_);
31 72         5130 $_ => $self->$acc
32 248         419 } @{$self->storage_value_columns}
  248         623  
33             });
34 248         13103 $self->_storage_values;
35             }
36              
37 18     18 1 5602 sub get_storage_value { $_[0]->_storage_values->{$_[1]} }
38              
39             sub new {
40 1     1 1 565 my $class = shift;
41 1         9 my $ret = $class->next::method(@_);
42 1         128 $ret->_storage_values({});
43 1         15 $ret;
44             }
45              
46             sub inflate_result {
47 240     240 1 179811 my $class = shift;
48 240         968 my $ret = $class->next::method(@_);
49 240         11745 $ret->store_storage_values;
50 240         6218 $ret;
51             }
52              
53             sub insert {
54 1     1 1 529 my $self = shift;
55 1         6 my $ret = $self->next::method(@_);
56 1         2041 $ret->store_storage_values;
57 1         12 $ret;
58             }
59              
60             sub update {
61 7     7 1 18 my $self = shift;
62 7         148 my $ret = $self->next::method(@_);
63 7         11817 $ret->store_storage_values;
64 7         84 $ret;
65             }
66              
67             1;
68              
69             __END__
70              
71             =pod
72              
73             =head1 NAME
74              
75             DBIx::Class::Helper::Row::StorageValues - Keep track of stored vs in-memory row values
76              
77             =head1 SYNOPSIS
78              
79             package MyApp::Schema::Result::BlogPost;
80              
81             use parent 'DBIx::Class::Core';
82              
83             __PACKAGE__->load_components(qw(Helper::Row::StorageValues));
84              
85             __PACKAGE__->table('BlogPost');
86             __PACKAGE__->add_columns(
87             id => {
88             data_type => 'integer',
89             is_auto_increment => 1,
90             },
91             title => {
92             data_type => 'varchar',
93             length => 32,
94             keep_storage_value => 1,
95             },
96             body => {
97             data_type => 'text',
98             },
99             );
100              
101             1;
102              
103             # elsewhere:
104              
105             my $post = $blog_rs->create({
106             title => 'Components for fun and profit',
107             body => '...',
108             });
109              
110             $post->title('Components for fun');
111              
112             warn sprintf 'Changing title from %s to %s',
113             $post->storage_value('title'), $post->title;
114              
115             $post->update;
116              
117             =head1 DESCRIPTION
118              
119             This component keeps track of the value for a given column in the database. If
120             you change the column's value and do not call C<update>, the C<storage_value>
121             will be different; once C<update> is called the C<storage_value> will be set
122             to the value of the accessor. Note that the fact that it uses the accessor is
123             an important distinction. If you are using L<DBIx::Class::FilterColumn> or
124             L<DBIx::Class::InflateColumn> it will get the non-storage or inflated values,
125             respectively.
126              
127             =head1 METHODS
128              
129             =head2 _has_storage_value
130              
131             $self->_has_storage_value('colname')
132              
133             returns true if we should store the storage value from the database. Override
134             this if you'd like to enable storage on all integers or something like that:
135              
136             sub _has_storage_value {
137             my ( $self, $column ) = @_;
138              
139             my $info = $self->column_info($column);
140              
141             return defined $info->{data_type} && $info->{data_type} eq 'integer';
142             }
143              
144             =head2 storage_value_columns
145              
146             $self->storage_value_columns
147              
148             returns a list of columns to store
149              
150             =head2 get_storage_value
151              
152             $self->get_storage_value('colname')
153              
154             returns the value for that column which is in storage
155              
156             =head1 AUTHOR
157              
158             Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
159              
160             =head1 COPYRIGHT AND LICENSE
161              
162             This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt.
163              
164             This is free software; you can redistribute it and/or modify it under
165             the same terms as the Perl 5 programming language system itself.
166              
167             =cut