Commit | Line | Data |
ac50f57b |
1 | package DBIx::Class::Storage::DBI::DBM; |
2 | |
3 | use base 'DBIx::Class::Storage::DBI::SQL::Statement'; |
4 | use mro 'c3'; |
5 | use namespace::clean; |
6 | |
7 | sub insert { |
8 | my ($self, $source, $to_insert) = @_; |
9 | |
10 | my $col_infos = $source->columns_info; |
11 | |
12 | foreach my $col (keys %$col_infos) { |
13 | # this will naturally fall into undef/NULL if default_value doesn't exist |
14 | $to_insert->{$col} = $col_infos->{$col}{default_value} |
15 | unless (exists $to_insert->{$col}); |
16 | } |
17 | |
18 | $self->next::method($source, $to_insert); |
19 | } |
20 | |
21 | sub insert_bulk { |
22 | my ($self, $source, $cols, $data) = @_; |
23 | |
24 | my $col_infos = $source->columns_info; |
25 | |
26 | foreach my $col (keys %$col_infos) { |
27 | unless (grep { $_ eq $col } @$cols) { |
28 | push @$cols, $col; |
29 | for my $r (0 .. $#$data) { |
30 | # this will naturally fall into undef/NULL if default_value doesn't exist |
31 | $data->[$r][$#$cols] = $col_infos->{$col}{default_value}; |
32 | } |
33 | } |
34 | } |
35 | |
36 | $self->next::method($source, $cols, $data); |
37 | } |
38 | |
39 | 1; |
40 | |
41 | =head1 NAME |
42 | |
43 | DBIx::Class::Storage::DBI::SNMP - Support for DBM & MLDBM files via DBD::DBM |
44 | |
45 | =head1 SYNOPSIS |
46 | |
47 | This subclass supports DBM & MLDBM files via L<DBD::DBM>. |
48 | |
49 | =head1 DESCRIPTION |
50 | |
51 | This subclass is essentially just a stub that uses the super class |
52 | L<DBIx::Class::Storage::DBI::SQL::Statement>. |
53 | |
54 | =head1 IMPLEMENTATION NOTES |
55 | |
56 | =head2 Missing fields on INSERTs |
57 | |
58 | L<DBD::DBM> will balk at missing columns on INSERTs. This storage engine will |
59 | add them in with either the default_value attribute or NULL. |
60 | |
61 | =head1 AUTHOR |
62 | |
63 | See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>. |
64 | |
65 | =head1 LICENSE |
66 | |
67 | You may distribute this code under the same terms as Perl itself. |
68 | |
69 | =cut |