File Coverage

blib/lib/DBR/Query/Insert.pm
Criterion Covered Total %
statement 68 72 94.4
branch 21 42 50.0
condition 2 5 40.0
subroutine 10 10 100.0
pod 0 3 0.0
total 101 132 76.5


line stmt bran cond sub pod time code
1             # The contents of this file are Copyright (c) 2010 Daniel Norman
2             # This program is free software; you can redistribute it and/or
3             # modify it under the terms of the GNU General Public License as
4             # published by the Free Software Foundation.
5              
6             ###########################################
7             package DBR::Query::Insert;
8              
9 18     18   116 use strict;
  18         46  
  18         783  
10 18     18   123 use base 'DBR::Query';
  18         38  
  18         1949  
11 18     18   112 use Carp;
  18         37  
  18         22111  
12              
13 497     497   1972 sub _params { qw (sets tables where limit quiet_error) }
14 497     497   2185 sub _reqparams { qw (sets tables) }
15              
16             sub sets{
17 497     497 0 1279 my $self = shift;
18 497 0 0     1771 exists( $_[0] ) or return wantarray?( @$self->{sets} ) : $self->{sets} || undef;
    50          
19 497         4033 my @sets = $self->_arrayify(@_);
20 497 50       1948 scalar(@sets) || croak('must provide at least one set');
21              
22 497         1266 for (@sets){
23 2030 50       8306 ref($_) eq 'DBR::Query::Part::Set' || croak('arguments must be Sets');
24             }
25            
26 497         1411 $self->{sets} = \@sets;
27            
28 497         1728 $self->_check_fields;
29              
30 497         1726 return 1;
31             }
32              
33             sub _check_fields{
34 994     994   2067 my $self = shift;
35              
36             # Make sure we have sets for all required fields
37             # It may be slightly more efficient to enforce this in ::Interface::Object->insert, but it seems more correct here.
38              
39 994 100 66     7082 return 0 unless $self->{sets} && $self->{tables};
40              
41 497         17849 my %fids = map { $_->field->field_id => 1 } grep { defined $_->field->field_id } @{ $self->{sets} };
  5         15  
  2030         7532  
  497         1313  
42            
43 497         2626 my $reqfields = $self->primary_table->req_fields();
44 497         1066 my @missing;
45 497         1694 foreach my $field ( grep { !$fids{ $_->field_id } } @$reqfields ){
  4         16  
46 1 50       7 if ( defined ( my $v = $field->default_val ) ){
47 0 0       0 my $value = $field->makevalue( $v ) or croak "failed to build value object for " . $field->name;
48 0 0       0 my $set = DBR::Query::Part::Set->new($field,$value) or confess 'failed to create set object';
49 0         0 push @{ $self->{sets} }, $set;
  0         0  
50             }else{
51 1         5 push @missing, $field;
52             }
53            
54             }
55 497 100       1472 if(@missing){
56 1         5 croak "Invalid insert. Missing fields (" .
57 1         4 join(', ', map { $_->name } @missing) . ")";
58             }
59 496         5667 $self->{_fields_checked} = 1;
60             }
61              
62             sub _validate_self{
63 497     497   1399 my $self = shift;
64              
65 497 50       740 @{$self->{tables}} == 1 or croak "Must have exactly one table";
  497         2600  
66 497 50       5582 $self->{sets} or croak "Must have at least one set";
67            
68 497 50       2298 $self->_check_fields unless $self->{_fields_checked};
69            
70 496         1850 return 1;
71             }
72              
73             sub sql{
74 496     496 0 854 my $self = shift;
75              
76 496 50       1470 my $conn = $self->instance->connect('conn') or return $self->_error('failed to connect');
77 496         965 my $sql;
78 496         781 my $tables = join(',', map {$_->sql} @{$self->{tables}} );
  496         1685  
  496         2098  
79              
80 496         882 my @fields;
81             my @values;
82 496         1035 for ( @{$self->{sets}} ) {
  496         1671  
83 2029         19416 push @fields, $_->field->sql( $conn );
84 2029         6389 push @values, $_->value->sql( $conn );
85             }
86              
87 496         3960 $sql = "INSERT INTO $tables (" . join (', ', @fields) . ') values (' . join (', ', @values) . ')';
88              
89 496 50       1676 $sql .= ' WHERE ' . $self->{where}->sql( $conn ) if $self->{where};
90 496 50       1745 $sql .= ' FOR UPDATE' if $self->{lock};
91 496 50       1337 $sql .= ' LIMIT ' . $self->{limit} if $self->{limit};
92              
93 496         2917 $self->_logDebug2( $sql );
94 496         3897 return $sql;
95             }
96              
97             sub run{
98 496     496 0 882 my $self = shift;
99 496         862 my %params = @_;
100              
101 496 50       3632 my $conn = $self->instance->connect('conn') or return $self->_error('failed to connect');
102              
103 496 100       2379 $conn->quiet_next_error if $self->quiet_error;
104 496 50       2060 $conn->prepSequence() or confess 'Failed to prepare sequence';
105              
106 496 50       1787 my $rows = $conn->do( $self->sql ) or return $self->_error("Insert failed");
107              
108             # Tiny optimization: if we are being executed in a void context, then we
109             # don't care about the sequence value. save the round trip and reduce latency.
110 496 50       2110 return 1 if $params{void};
111              
112 496         2702 my ($sequenceval) = $conn->getSequenceValue();
113              
114 496         16445 return $sequenceval;
115              
116             }
117              
118             1;