Lines 13-18
sub new {
Link Here
|
13 |
$self->schema->storage->sql_maker->quote_char('`'); |
13 |
$self->schema->storage->sql_maker->quote_char('`'); |
14 |
|
14 |
|
15 |
$self->{gen_type} = _gen_type(); |
15 |
$self->{gen_type} = _gen_type(); |
|
|
16 |
$self->{verbose} = 1; # default behavior; see also quiet flag in build |
16 |
return $self; |
17 |
return $self; |
17 |
} |
18 |
} |
18 |
|
19 |
|
Lines 57-62
sub build {
Link Here
|
57 |
my $source = $params->{source} || return; |
58 |
my $source = $params->{source} || return; |
58 |
my $value = $params->{value}; |
59 |
my $value = $params->{value}; |
59 |
|
60 |
|
|
|
61 |
# suppress some warns during this build? |
62 |
$self->{verbose} = !$params->{quiet}; |
63 |
|
60 |
my $col_values = $self->_buildColumnValues({ |
64 |
my $col_values = $self->_buildColumnValues({ |
61 |
source => $source, |
65 |
source => $source, |
62 |
value => $value, |
66 |
value => $value, |
Lines 198-204
sub _buildColumnValues {
Link Here
|
198 |
return $col_values if $build_value > 0; |
202 |
return $col_values if $build_value > 0; |
199 |
|
203 |
|
200 |
# if you get here, we have a problem |
204 |
# if you get here, we have a problem |
201 |
warn "Violation of unique constraint in $source"; |
205 |
warn "Violation of unique constraint in $source" if $self->{verbose}; |
202 |
return; |
206 |
return; |
203 |
} |
207 |
} |
204 |
|
208 |
|
Lines 263-269
sub _buildColumnValue {
Link Here
|
263 |
my $retvalue = []; |
267 |
my $retvalue = []; |
264 |
if( $col_info->{is_auto_increment} ) { |
268 |
if( $col_info->{is_auto_increment} ) { |
265 |
if( exists $value->{$col_name} ) { |
269 |
if( exists $value->{$col_name} ) { |
266 |
warn "Value not allowed for auto_incr $col_name in $source"; |
270 |
warn "Value not allowed for auto_incr $col_name in $source" |
|
|
271 |
if $self->{verbose}; |
267 |
return; |
272 |
return; |
268 |
} |
273 |
} |
269 |
# otherwise: no need to assign a value |
274 |
# otherwise: no need to assign a value |
Lines 271-277
sub _buildColumnValue {
Link Here
|
271 |
if( exists $value->{$col_name} ) { |
276 |
if( exists $value->{$col_name} ) { |
272 |
if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) { |
277 |
if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) { |
273 |
# This explicit undef is not allowed |
278 |
# This explicit undef is not allowed |
274 |
warn "Null value for $col_name in $source not allowed"; |
279 |
warn "Null value for $col_name in $source not allowed" |
|
|
280 |
if $self->{verbose}; |
275 |
return; |
281 |
return; |
276 |
} |
282 |
} |
277 |
if( ref( $value->{$col_name} ) ne 'HASH' ) { |
283 |
if( ref( $value->{$col_name} ) ne 'HASH' ) { |
Lines 281-292
sub _buildColumnValue {
Link Here
|
281 |
} |
287 |
} |
282 |
} elsif( ref( $value->{$col_name} ) eq 'HASH' ) { |
288 |
} elsif( ref( $value->{$col_name} ) eq 'HASH' ) { |
283 |
# this is not allowed for a column that is not a FK |
289 |
# this is not allowed for a column that is not a FK |
284 |
warn "Hash not allowed for $col_name in $source"; |
290 |
warn "Hash not allowed for $col_name in $source" if $self->{verbose}; |
285 |
return; |
291 |
return; |
286 |
} elsif( exists $value->{$col_name} ) { |
292 |
} elsif( exists $value->{$col_name} ) { |
287 |
if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) { |
293 |
if( !defined $value->{$col_name} && !$col_info->{is_nullable} ) { |
288 |
# This explicit undef is not allowed |
294 |
# This explicit undef is not allowed |
289 |
warn "Null value for $col_name in $source not allowed"; |
295 |
warn "Null value for $col_name in $source not allowed" |
|
|
296 |
if $self->{verbose}; |
290 |
return; |
297 |
return; |
291 |
} |
298 |
} |
292 |
push @$retvalue, $value->{$col_name}; |
299 |
push @$retvalue, $value->{$col_name}; |
Lines 296-302
sub _buildColumnValue {
Link Here
|
296 |
if( my $hdlr = $self->{gen_type}->{$data_type} ) { |
303 |
if( my $hdlr = $self->{gen_type}->{$data_type} ) { |
297 |
push @$retvalue, &$hdlr( $self, { info => $col_info } ); |
304 |
push @$retvalue, &$hdlr( $self, { info => $col_info } ); |
298 |
} else { |
305 |
} else { |
299 |
warn "Unknown type $data_type for $col_name in $source"; |
306 |
warn "Unknown type $data_type for $col_name in $source" |
|
|
307 |
if $self->{verbose}; |
300 |
return; |
308 |
return; |
301 |
} |
309 |
} |
302 |
} |
310 |
} |
Lines 484-489
Note that you should wrap these actions in a transaction yourself.
Link Here
|
484 |
Realize that passing primary key values to build may result in undef |
492 |
Realize that passing primary key values to build may result in undef |
485 |
if a record with that primary key already exists. |
493 |
if a record with that primary key already exists. |
486 |
|
494 |
|
|
|
495 |
The build method also supports a boolean quiet parameter to suppress |
496 |
some warnings. It only pertains to the current build call. |
497 |
|
487 |
=head1 AUTHOR |
498 |
=head1 AUTHOR |
488 |
|
499 |
|
489 |
Yohann Dufour <yohann.dufour@biblibre.com> |
500 |
Yohann Dufour <yohann.dufour@biblibre.com> |
490 |
- |
|
|