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
|
package DBIx::Class::Helper::Schema::Verifier::ColumnInfo;
$DBIx::Class::Helper::Schema::Verifier::ColumnInfo::VERSION = '2.037000';
# ABSTRACT: Verify that Results only use approved column_info keys
use strict;
use warnings;
use MRO::Compat;
use mro 'c3';
use base 'DBIx::Class::Helper::Schema::Verifier';
my @allowed_keys = (
# defaults from ::ResultSource
qw(
accessor
auto_nextval
data_type
default_value
extra
is_auto_increment
is_foreign_key
is_nullable
is_numeric
retrieve_on_insert
sequence
size
),
# ::InflateColumn::DateTime
qw(
floating_tz_ok
inflate_datetime
locale
timezone
),
# ::InflateColumn::File and ::InflateColumn::FS
qw(
file_column_path
fs_column_path
fs_new_on_update
is_file_column
is_fs_column
),
# ::Helpers
qw(
is_serializable
keep_storage_value
remove_column
) );
sub allowed_column_keys { @allowed_keys }
sub result_verifiers {
my $self = shift;
my %allowed = map { $_ => 1 } $self->allowed_column_keys;
(
sub {
my ($s, $result, $set) = @_;
my $column_info = $result->columns_info;
for my $col_name (keys %$column_info) {
for my $key (keys %{ $column_info->{$col_name} }) {
if (!$allowed{$key}) {
die sprintf join(' ', qw(Forbidden column config <%s> used in
column <%s> in result <%s>. You can explicitly allow it by
adding it to your schema's allowed_column_keys method.)),
$key, $col_name, $result;
}
}
}
},
$self->next::method,
)
}
1;
__END__
=pod
=head1 NAME
DBIx::Class::Helper::Schema::Verifier::ColumnInfo - Verify that Results only use approved column_info keys
=head1 SYNOPSIS
package MyApp::Schema;
__PACKAGE__->load_components('Helper::Schema::Verifier::ColumnInfo');
# optionally add some non-standard allowed keys
sub allowed_column_keys {
my $self = shift;
my @keys = $self->next::method;
push @keys, qw(is_serializable keep_storage_value remove_column);
return @keys;
}
=head1 DESCRIPTION
C<DBIx::Class::Helper::Schema::Verifier::ColumnInfo> verifies that none of your
columns use non-approved configuration keys. L<DBIx::Class> doesn't do any key
verification, so this Helper makes sure you don't get burned by a typo like
using C<autoincrement> instead of C<is_auto_increment>. If your schema uses a
non-approved column config key, it will refuse to load and instead offer a
hopefully helpful message pointing out the error.
=head1 METHODS
=head2 allowed_column_keys()
It's entirely possible that you would like to use some non-default config keys,
especially if you use some column-extension components. Override this method in
your schema and append your new keys to the list returned by the superclass
call. The overridden method must return a list of keys.
sub allowed_column_keys {
my $self = shift;
my @keys = $self->next::method;
# modify @keys as needed
return @keys;
}
=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
|
