|  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;  |