View | Details | Raw Unified | Return to bug 16607
Collapse All | Expand All

(-)a/t/db_dependent/Accounts.t (-3 / +4 lines)
Lines 52-60 my $schema = Koha::Database->new->schema; Link Here
52
$schema->storage->txn_begin;
52
$schema->storage->txn_begin;
53
my $dbh = C4::Context->dbh;
53
my $dbh = C4::Context->dbh;
54
54
55
# this test needs a MPL branch; also create another one
55
# this test needs a MPL branch; suppress warn if it already exists
56
my $builder = t::lib::TestBuilder->new();
56
my $builder = t::lib::TestBuilder->new;
57
$builder->build({ source => 'Branch', value => { branchcode => 'MPL' }});
57
$builder->build({ source => 'Branch', value => { branchcode => 'MPL' }, quiet => 1 });
58
# also create another branch
58
my $library = $builder->build({ source => 'Branch' });
59
my $library = $builder->build({ source => 'Branch' });
59
60
60
$dbh->do(q|DELETE FROM accountlines|);
61
$dbh->do(q|DELETE FROM accountlines|);
(-)a/t/db_dependent/Items/AutomaticItemModificationByAge.t (-4 / +2 lines)
Lines 17-27 my $dbh = C4::Context->dbh; Link Here
17
$dbh->{AutoCommit} = 0;
17
$dbh->{AutoCommit} = 0;
18
$dbh->{RaiseError} = 1;
18
$dbh->{RaiseError} = 1;
19
19
20
# this test assumes a CPL branch
20
# this test assumes a CPL branch; suppress warn if it exists
21
my $builder = t::lib::TestBuilder->new;
21
my $builder = t::lib::TestBuilder->new;
22
if( !$builder->schema->resultset('Branch')->find('CPL') ) {
22
$builder->build( { source => 'Branch', value => { branchcode => 'CPL' }, quiet => 1 });
23
    $builder->build( { source => 'Branch', value => { branchcode => 'CPL' }});
24
}
25
23
26
$dbh->do(q|
24
$dbh->do(q|
27
    DELETE FROM marc_subfield_structure
25
    DELETE FROM marc_subfield_structure
(-)a/t/db_dependent/TestBuilder.t (-3 / +1 lines)
Lines 53-61 subtest 'Start with some trivial tests' => sub { Link Here
53
53
54
    # return undef if a record exists
54
    # return undef if a record exists
55
    my $param = { source => 'Branch', value => { branchcode => 'MPL' } };
55
    my $param = { source => 'Branch', value => { branchcode => 'MPL' } };
56
    local $SIG{__WARN__} = sub {};
56
    $builder->build({ %$param, quiet => 1 }); # at least it should exist now
57
    $builder->build( $param ); # at least it should exist now
58
    delete local $SIG{__WARN__};
59
    warning_like { $builder->build( $param ) }
57
    warning_like { $builder->build( $param ) }
60
        qr/Violation of unique constraint/,
58
        qr/Violation of unique constraint/,
61
        'Catch warn on adding existing record';
59
        'Catch warn on adding existing record';
(-)a/t/lib/TestBuilder.pm (-7 / +17 lines)
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
- 

Return to bug 16607