use base 'DBIx::Class::Core';
__PACKAGE__->add_columns({ id => { sequence => 'mysequence', auto_nextval => 1 } });
__PACKAGE__->set_primary_key('id');
- __PACKAGE__->sequence('mysequence');
# Somewhere in your Code
# add some data to a table with a hierarchical relationship
my $rs = $schema->resultset('Person')->search({},
{
'start_with' => { 'firstname' => 'foo', 'lastname' => 'bar' },
- 'connect_by' => { 'parentid' => { '-prior' => \'persionid' },
+ 'connect_by' => { 'parentid' => { '-prior' => { -ident => 'personid' } },
'order_siblings_by' => { -asc => 'name' },
};
);
# START WITH
# firstname = 'foo' and lastname = 'bar'
# CONNECT BY
- # parentid = prior persionid
+ # parentid = prior personid
# ORDER SIBLINGS BY
# firstname ASC
my @ids = ();
foreach my $col (@columns) {
my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
- my $id = $self->_sequence_fetch( 'currval', $seq );
+ my $id = $self->_sequence_fetch( 'CURRVAL', $seq );
push @ids, $id;
}
return @ids;
my ($self, $dbh, $source, $col) = @_;
my $sql_maker = $self->sql_maker;
+ my ($ql, $qr) = map { $_ ? (quotemeta $_) : '' } $sql_maker->_quote_chars;
my $source_name;
if ( ref $source->name eq 'SCALAR' ) {
$source_name = ${$source->name};
+
+ # the ALL_TRIGGERS match further on is case sensitive - thus uppercase
+ # stuff unless it is already quoted
+ $source_name = uc ($source_name) if $source_name !~ /\"/;
}
else {
$source_name = $source->name;
+ $source_name = uc($source_name) unless $ql;
}
- $source_name = uc($source_name) unless $sql_maker->quote_char;
# trigger_body is a LONG
local $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
# disable default bindtype
local $sql_maker->{bindtype} = 'normal';
+
# look up the correct sequence automatically
- my ( $schema, $table ) = $source_name =~ /(\w+)\.(\w+)/;
+ my ( $schema, $table ) = $source_name =~ /( (?:${ql})? \w+ (?:${qr})? ) \. ( (?:${ql})? \w+ (?:${qr})? )/x;
my ($sql, @bind) = $sql_maker->select (
'ALL_TRIGGERS',
- ['trigger_body', 'table_owner'],
+ [qw/TRIGGER_BODY TABLE_OWNER TRIGGER_NAME/],
{
- $schema ? (owner => $schema) : (),
- table_name => $table || $source_name,
- triggering_event => { -like => '%INSERT%' },
- status => 'ENABLED',
+ $schema ? (OWNER => $schema) : (),
+ TABLE_NAME => $table || $source_name,
+ TRIGGERING_EVENT => { -like => '%INSERT%' }, # this will also catch insert_or_update
+ TRIGGER_TYPE => { -like => '%BEFORE%' }, # we care only about 'before' triggers
+ STATUS => 'ENABLED',
},
);
- my $sth = $dbh->prepare($sql);
- $sth->execute (@bind);
- while (my ($insert_trigger, $schema) = $sth->fetchrow_array) {
- my ($seq_name) = $insert_trigger =~ m/("?[.\w"]+"?)\.nextval .+ into \s+ :new\.$col/xmsi;
+ # to find all the triggers that mention the column in question a simple
+ # regex grep since the trigger_body above is a LONG and hence not searchable
+ my @triggers = ( map
+ { my %inf; @inf{qw/body schema name/} = @$_; \%inf }
+ ( grep
+ { $_->[0] =~ /\:new\.${ql}${col}${qr} | \:new\.$col/xi }
+ @{ $dbh->selectall_arrayref( $sql, {}, @bind ) }
+ )
+ );
+
+ # extract all sequence names mentioned in each trigger
+ for (@triggers) {
+ $_->{sequences} = [ $_->{body} =~ / ( "? [\.\w\"\-]+ "? ) \. nextval /xig ];
+ }
+
+ my $chosen_trigger;
- next unless $seq_name;
+ # if only one trigger matched things are easy
+ if (@triggers == 1) {
- if ($seq_name !~ /\./) {
- $seq_name = join '.' => $schema, $seq_name;
+ if ( @{$triggers[0]{sequences}} == 1 ) {
+ $chosen_trigger = $triggers[0];
+ }
+ else {
+ $self->throw_exception( sprintf (
+ "Unable to introspect trigger '%s' for column %s.%s (references multiple sequences). "
+ . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+ $triggers[0]{name},
+ $source_name,
+ $col,
+ $col,
+ ) );
}
+ }
+ # got more than one matching trigger - see if we can narrow it down
+ elsif (@triggers > 1) {
+
+ my @candidates = grep
+ { $_->{body} =~ / into \s+ \:new\.$col /xi }
+ @triggers
+ ;
+ if (@candidates == 1 && @{$candidates[0]{sequences}} == 1) {
+ $chosen_trigger = $candidates[0];
+ }
+ else {
+ $self->throw_exception( sprintf (
+ "Unable to reliably select a BEFORE INSERT trigger for column %s.%s (possibilities: %s). "
+ . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+ $source_name,
+ $col,
+ ( join ', ', map { "'$_->{name}'" } @triggers ),
+ $col,
+ ) );
+ }
+ }
+
+ if ($chosen_trigger) {
+ my $seq_name = $chosen_trigger->{sequences}[0];
+
+ $seq_name = "$chosen_trigger->{schema}.$seq_name"
+ unless $seq_name =~ /\./;
+
+ return \$seq_name if $seq_name =~ /\"/; # may already be quoted in-trigger
return $seq_name;
}
- $self->throw_exception("Unable to find a sequence %INSERT% trigger on table '$source_name'.");
+
+ $self->throw_exception( sprintf (
+ "No suitable BEFORE INSERT triggers found for column %s.%s. "
+ . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
+ $source_name,
+ $col,
+ $col,
+ ));
}
sub _sequence_fetch {
my ( $self, $type, $seq ) = @_;
- my ($id) = $self->_get_dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
+
+ # use the maker to leverage quoting settings
+ my $sql_maker = $self->sql_maker;
+ my ($id) = $self->_get_dbh->selectrow_array ($sql_maker->select('DUAL', [ ref $seq ? \"$$seq.$type" : "$seq.$type" ] ) );
return $id;
}
my %bind_attributes;
foreach my $column ($source->columns) {
- my $data_type = $source->column_info($column)->{data_type} || '';
- next unless $data_type;
+ my $data_type = $source->column_info($column)->{data_type}
+ or next;
my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
projects / dbsrgits/DBIx-Class.git / blobdiff