1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
package DBIx::Class::Helper::Row::OnColumnMissing;
$DBIx::Class::Helper::Row::OnColumnMissing::VERSION = '2.037000';
# ABSTRACT: Configurably handle access of missing columns
use strict;
use warnings;
use parent 'DBIx::Class::Row';
sub on_column_missing { 'warn' }
sub on_column_missing_die { die "Column $_[1] has not been loaded" }
sub on_column_missing_warn { warn "Column $_[1] has not been loaded" }
sub on_column_missing_nothing {}
sub get_column {
my ($self, $column_name) = @_;
if ($self->has_column_loaded($column_name)) {
$self->next::method($column_name)
} else {
my $action = $self->on_column_missing;
unless (ref $action) {
$action = "on_column_missing_$action" unless ref $action;
$action = $self->can($action);
}
scalar $self->$action($column_name)
}
}
1;
__END__
=pod
=head1 NAME
DBIx::Class::Helper::Row::OnColumnMissing - Configurably handle access of missing columns
=head1 SYNOPSIS
package MyApp::Schema::Result::Account;
use parent 'DBIx::Class::Core';
__PACKAGE__->load_components(qw(Helper::Row::OnColumnMissing));
__PACKAGE__->table('Account');
__PACKAGE__->add_columns(
id => {
data_type => 'integer',
is_auto_increment => 1,
},
name => {
data_type => 'varchar',
size => 25,
},
book => { data_type => 'text' },
);
sub on_column_missing { 'die' }
1;
Or with L<DBIx::Class::Candy>:
package MyApp::Schema::Result::Account;
use DBIx::Class::Candy -components => ['Helper::Row::OnColumnMissing'];
table 'Account';
column id => {
data_type => 'integer',
is_auto_increment => 1,
};
column amount => {
data_type => 'float',
keep_storage_value => 1,
};
column book => { data_type => 'text' };
sub on_column_missing { 'die' }
1;
Elsewhere:
my $row = $rs->search(undef, { columns => [qw( id name )] })->one_row;
$row->book # dies
=head1 DESCRIPTION
This module is written to handle the odd condition where you have limited the
columns retrieved from the database but accidentally access one of the ones not
included. It is configurable by tweaking the C<on_column_missing> return value.
=head1 MODES
You specify the C<mode> by returning the C<mode> from the C<on_column_missing>
method. By default the C<mode> returned is C<warn>.
The predefined modes are:
=over 2
=item C<die>
Dies with C<Column $name has not been loaded>.
=item C<warn>
Warns with C<Column $name has not been loaded>.
=item C<nothing>
Does nothing
=back
You can predefine more modes by defining methods named C<on_column_$mode>, and
also override the default modes by overriding the corresponding methods. If you
need ad-hoc behavior you can return a code reference and that will be called as
a method on the object.
=head2 ADVANCED USAGE
If for some reason you find that you need to change your C<mode> at runtime, you
can always replace the C<on_column_missing> with an accessor. For example:
__PACKAGE__->mk_group_accessors(inherited => 'on_column_missing');
__PACKAGE__->on_column_missing('warn');
Elsewhere:
$row->on_column_missing('die');
If you are especially crazy you could even do something like this:
$row->on_column_missing(sub {
my ($self, $column) = @_;
$self
->result_source
->resultset
->search({ id => $self->id })
->get_column($column)
->single
});
Though if you do that I would make it a named mode (maybe C<retrieve>?)
=head1 THANKS
Thanks L<ZipRecruiter|https://www.ziprecruiter.com> for funding the development
of this module.
=head1 AUTHOR
Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
