1package DBIx::Class::Helper::Schema::Verifier::ColumnInfo;
2$DBIx::Class::Helper::Schema::Verifier::ColumnInfo::VERSION = '2.036000';
3# ABSTRACT: Verify that Results only use approved column_info keys
4
5use strict;
6use warnings;
7
8use MRO::Compat;
9use mro 'c3';
10
11use base 'DBIx::Class::Helper::Schema::Verifier';
12
13my @allowed_keys = (
14# defaults from ::ResultSource
15qw(
16   accessor
17   auto_nextval
18   data_type
19   default_value
20   extra
21   is_auto_increment
22   is_foreign_key
23   is_nullable
24   is_numeric
25   retrieve_on_insert
26   sequence
27   size
28),
29# ::InflateColumn::DateTime
30qw(
31   floating_tz_ok
32   inflate_datetime
33   locale
34   timezone
35),
36# ::InflateColumn::File and ::InflateColumn::FS
37qw(
38   file_column_path
39   fs_column_path
40   fs_new_on_update
41   is_file_column
42   is_fs_column
43),
44# ::Helpers
45qw(
46   is_serializable
47   keep_storage_value
48   remove_column
49) );
50
51sub allowed_column_keys { @allowed_keys }
52
53sub result_verifiers {
54   my $self = shift;
55   my %allowed = map { $_ => 1 } $self->allowed_column_keys;
56
57   (
58      sub {
59         my ($s, $result, $set) = @_;
60         my $column_info =  $result->columns_info;
61         for my $col_name (keys %$column_info) {
62            for my $key (keys %{ $column_info->{$col_name} }) {
63               if (!$allowed{$key}) {
64                  die sprintf join(' ', qw(Forbidden column config <%s> used in
65                     column <%s> in result <%s>. You can explicitly allow it by
66                     adding it to your schema's allowed_column_keys method.)),
67                     $key, $col_name, $result;
68               }
69            }
70         }
71      },
72      $self->next::method,
73   )
74}
75
761;
77
78__END__
79
80=pod
81
82=head1 NAME
83
84DBIx::Class::Helper::Schema::Verifier::ColumnInfo - Verify that Results only use approved column_info keys
85
86=head1 SYNOPSIS
87
88 package MyApp::Schema;
89
90 __PACKAGE__->load_components('Helper::Schema::Verifier::ColumnInfo');
91
92 # optionally add some non-standard allowed keys
93 sub allowed_column_keys {
94   my $self = shift;
95   my @keys = $self->next::method;
96   push @keys, qw(is_serializable keep_storage_value remove_column);
97   return @keys;
98 }
99
100=head1 DESCRIPTION
101
102C<DBIx::Class::Helper::Schema::Verifier::ColumnInfo> verifies that none of your
103columns use non-approved configuration keys. L<DBIx::Class> doesn't do any key
104verification, so this Helper makes sure you don't get burned by a typo like
105using C<autoincrement> instead of C<is_auto_increment>. If your schema uses a
106non-approved column config key, it will refuse to load and instead offer a
107hopefully helpful message pointing out the error.
108
109=head1 METHODS
110
111=head2 allowed_column_keys()
112
113It's entirely possible that you would like to use some non-default config keys,
114especially if you use some column-extension components. Override this method in
115your schema and append your new keys to the list returned by the superclass
116call.  The overridden method must return a list of keys.
117
118 sub allowed_column_keys {
119   my $self = shift;
120   my @keys = $self->next::method;
121   # modify @keys as needed
122   return @keys;
123 }
124
125=head1 AUTHOR
126
127Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
128
129=head1 COPYRIGHT AND LICENSE
130
131This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt.
132
133This is free software; you can redistribute it and/or modify it under
134the same terms as the Perl 5 programming language system itself.
135
136=cut
137