lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm

   1 package DBIx::Class::Storage::DBI::Oracle::Generic;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/DBIx::Class::Storage::DBI/;
   6 use mro 'c3';
   7 use DBIx::Class::Carp;
   8 use Scope::Guard ();
   9 use Context::Preserve 'preserve_context';
  10 use DBIx::Class::_Util qw( modver_gt_or_eq modver_gt_or_eq_and_lt dbic_internal_try );
  11 use namespace::clean;
  12
  13 __PACKAGE__->sql_limit_dialect ('RowNum');
  14 __PACKAGE__->sql_quote_char ('"');
  15 __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::Oracle');
  16 __PACKAGE__->datetime_parser_type('DateTime::Format::Oracle');
  17
  18 sub __cache_queries_with_max_lob_parts { 2 }
  19
  20 =head1 NAME
  21
  22 DBIx::Class::Storage::DBI::Oracle::Generic - Oracle Support for DBIx::Class
  23
  24 =head1 SYNOPSIS
  25
  26   # In your result (table) classes
  27   use base 'DBIx::Class::Core';
  28   __PACKAGE__->add_columns({ id => { sequence => 'mysequence', auto_nextval => 1 } });
  29   __PACKAGE__->set_primary_key('id');
  30
  31   # Somewhere in your Code
  32   # add some data to a table with a hierarchical relationship
  33   $schema->resultset('Person')->create ({
  34         firstname => 'foo',
  35         lastname => 'bar',
  36         children => [
  37             {
  38                 firstname => 'child1',
  39                 lastname => 'bar',
  40                 children => [
  41                     {
  42                         firstname => 'grandchild',
  43                         lastname => 'bar',
  44                     }
  45                 ],
  46             },
  47             {
  48                 firstname => 'child2',
  49                 lastname => 'bar',
  50             },
  51         ],
  52     });
  53
  54   # select from the hierarchical relationship
  55   my $rs = $schema->resultset('Person')->search({},
  56     {
  57       'start_with' => { 'firstname' => 'foo', 'lastname' => 'bar' },
  58       'connect_by' => { 'parentid' => { '-prior' => { -ident => 'personid' } },
  59       'order_siblings_by' => { -asc => 'name' },
  60     };
  61   );
  62
  63   # this will select the whole tree starting from person "foo bar", creating
  64   # following query:
  65   # SELECT
  66   #     me.persionid me.firstname, me.lastname, me.parentid
  67   # FROM
  68   #     person me
  69   # START WITH
  70   #     firstname = 'foo' and lastname = 'bar'
  71   # CONNECT BY
  72   #     parentid = prior personid
  73   # ORDER SIBLINGS BY
  74   #     firstname ASC
  75
  76 =head1 DESCRIPTION
  77
  78 This class implements base Oracle support. The subclass
  79 L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> is for C<(+)> joins in Oracle
  80 versions before 9.0.
  81
  82 =head1 METHODS
  83
  84 =cut
  85
  86 sub _determine_supports_insert_returning {
  87   my $self = shift;
  88
  89 # TODO find out which version supports the RETURNING syntax
  90 # 8i has it and earlier docs are a 404 on oracle.com
  91
  92   return 1
  93     if $self->_server_info->{normalized_dbms_version} >= 8.001;
  94
  95   return 0;
  96 }
  97
  98 __PACKAGE__->_use_insert_returning_bound (1);
  99
 100 sub deployment_statements {
 101   my $self = shift;;
 102   my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_;
 103
 104   $sqltargs ||= {};
 105
 106   if (
 107     ! exists $sqltargs->{producer_args}{oracle_version}
 108       and
 109     my $dver = $self->_server_info->{dbms_version}
 110   ) {
 111     $sqltargs->{producer_args}{oracle_version} = $dver;
 112   }
 113
 114   $self->next::method($schema, $type, $version, $dir, $sqltargs, @rest);
 115 }
 116
 117 sub _dbh_last_insert_id {
 118   my ($self, $dbh, $source, @columns) = @_;
 119   my @ids = ();
 120   foreach my $col (@columns) {
 121     my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
 122     my $id = $self->_sequence_fetch( 'CURRVAL', $seq );
 123     push @ids, $id;
 124   }
 125   return @ids;
 126 }
 127
 128 sub _dbh_get_autoinc_seq {
 129   my ($self, $dbh, $source, $col) = @_;
 130
 131   my $sql_maker = $self->sql_maker;
 132   my ($ql, $qr) = map { $_ ? (quotemeta $_) : '' } $sql_maker->_quote_chars;
 133
 134   my $source_name;
 135   if ( ref $source->name eq 'SCALAR' ) {
 136     $source_name = ${$source->name};
 137
 138     # the ALL_TRIGGERS match further on is case sensitive - thus uppercase
 139     # stuff unless it is already quoted
 140     $source_name = uc ($source_name) if $source_name !~ /\"/;
 141   }
 142   else {
 143     $source_name = $source->name;
 144     $source_name = uc($source_name) unless $ql;
 145   }
 146
 147   # trigger_body is a LONG
 148   local $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
 149
 150   # disable default bindtype
 151   local $sql_maker->{bindtype} = 'normal';
 152
 153   # look up the correct sequence automatically
 154   my ( $schema, $table ) = $source_name =~ /( (?:${ql})? \w+ (?:${qr})? ) \. ( (?:${ql})? \w+ (?:${qr})? )/x;
 155
 156   # if no explicit schema was requested - use the default schema (which in the case of Oracle is the db user)
 157   $schema ||= \'= USER';
 158
 159   my ($sql, @bind) = $sql_maker->select (
 160     'ALL_TRIGGERS',
 161     [qw/TRIGGER_BODY TABLE_OWNER TRIGGER_NAME/],
 162     {
 163       OWNER => $schema,
 164       TABLE_NAME => $table || $source_name,
 165       TRIGGERING_EVENT => { -like => '%INSERT%' },  # this will also catch insert_or_update
 166       TRIGGER_TYPE => { -like => '%BEFORE%' },      # we care only about 'before' triggers
 167       STATUS => 'ENABLED',
 168      },
 169   );
 170
 171   # to find all the triggers that mention the column in question a simple
 172   # regex grep since the trigger_body above is a LONG and hence not searchable
 173   # via -like
 174   my @triggers = ( map
 175     { my %inf; @inf{qw/body schema name/} = @$_; \%inf }
 176     ( grep
 177       { $_->[0] =~ /\:new\.${ql}${col}${qr} | \:new\.$col/xi }
 178       @{ $dbh->selectall_arrayref( $sql, {}, @bind ) }
 179     )
 180   );
 181
 182   # extract all sequence names mentioned in each trigger, throw away
 183   # triggers without apparent sequences
 184   @triggers = map {
 185     my @seqs = $_->{body} =~ / ( [\.\w\"\-]+ ) \. nextval /xig;
 186     @seqs
 187       ? { %$_, sequences => \@seqs }
 188       : ()
 189     ;
 190   } @triggers;
 191
 192   my $chosen_trigger;
 193
 194   # if only one trigger matched things are easy
 195   if (@triggers == 1) {
 196
 197     if ( @{$triggers[0]{sequences}} == 1 ) {
 198       $chosen_trigger = $triggers[0];
 199     }
 200     else {
 201       $self->throw_exception( sprintf (
 202         "Unable to introspect trigger '%s' for column '%s.%s' (references multiple sequences). "
 203       . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
 204         $triggers[0]{name},
 205         $source_name,
 206         $col,
 207         $col,
 208       ) );
 209     }
 210   }
 211   # got more than one matching trigger - see if we can narrow it down
 212   elsif (@triggers > 1) {
 213
 214     my @candidates = grep
 215       { $_->{body} =~ / into \s+ \:new\.$col /xi }
 216       @triggers
 217     ;
 218
 219     if (@candidates == 1 && @{$candidates[0]{sequences}} == 1) {
 220       $chosen_trigger = $candidates[0];
 221     }
 222     else {
 223       $self->throw_exception( sprintf (
 224         "Unable to reliably select a BEFORE INSERT trigger for column '%s.%s' (possibilities: %s). "
 225       . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
 226         $source_name,
 227         $col,
 228         ( join ', ', map { "'$_->{name}'" } @triggers ),
 229         $col,
 230       ) );
 231     }
 232   }
 233
 234   if ($chosen_trigger) {
 235     my $seq_name = $chosen_trigger->{sequences}[0];
 236
 237     $seq_name = "$chosen_trigger->{schema}.$seq_name"
 238       unless $seq_name =~ /\./;
 239
 240     return \$seq_name if $seq_name =~ /\"/; # may already be quoted in-trigger
 241     return $seq_name;
 242   }
 243
 244   $self->throw_exception( sprintf (
 245     "No suitable BEFORE INSERT triggers found for column '%s.%s'. "
 246   . "You need to specify the correct 'sequence' explicitly in '%s's column_info.",
 247     $source_name,
 248     $col,
 249     $col,
 250   ));
 251 }
 252
 253 sub _sequence_fetch {
 254   my ( $self, $type, $seq ) = @_;
 255
 256   # use the maker to leverage quoting settings
 257   my $sth = $self->_dbh->prepare_cached(
 258     $self->sql_maker->select('DUAL', [ ref $seq ? \"$$seq.$type" : "$seq.$type" ] )
 259   );
 260   $sth->execute;
 261   my ($id) = $sth->fetchrow_array;
 262   $sth->finish;
 263   return $id;
 264 }
 265
 266 sub _ping {
 267   my $self = shift;
 268
 269   my $dbh = $self->_dbh or return 0;
 270
 271   local $dbh->{RaiseError} = 1;
 272   local $dbh->{PrintError} = 0;
 273
 274   ( dbic_internal_try {
 275     $dbh->do('select 1 from dual');
 276     1;
 277   })
 278     ? 1
 279     : 0
 280   ;
 281 }
 282
 283 sub _dbh_execute {
 284   #my ($self, $dbh, $sql, $bind, $bind_attrs) = @_;
 285   my ($self, $sql, $bind) = @_[0,2,3];
 286
 287   # Turn off sth caching for multi-part LOBs. See _prep_for_execute below
 288   local $self->{disable_sth_caching} = 1 if grep {
 289     ($_->[0]{_ora_lob_autosplit_part}||0)
 290       >
 291     (__cache_queries_with_max_lob_parts - 1)
 292   } @$bind;
 293
 294   my $next = $self->next::can;
 295
 296   # if we are already in a txn we can't retry anything
 297   return shift->$next(@_)
 298     if $self->transaction_depth;
 299
 300   # Cheat the blockrunner we are just about to create:
 301   # We *do* want to rerun things regardless of outer state
 302   local $self->{_in_do_block}
 303     if $self->{_in_do_block};
 304
 305   DBIx::Class::Storage::BlockRunner->new(
 306     storage => $self,
 307     wrap_txn => 0,
 308     retry_handler => sub {
 309       # ORA-01003: no statement parsed (someone changed the table somehow,
 310       # invalidating your cursor.)
 311       if (
 312         $_[0]->failed_attempt_count == 1
 313           and
 314         $_[0]->last_exception =~ /ORA-01003/
 315           and
 316         my $dbh = $_[0]->storage->_dbh
 317       ) {
 318         delete $dbh->{CachedKids}{$sql};
 319         return 1;
 320       }
 321       else {
 322         return 0;
 323       }
 324     },
 325   )->run( $next, @_ );
 326 }
 327
 328 sub _dbh_execute_for_fetch {
 329   #my ($self, $source, $sth, $proto_bind, $cols, $data) = @_;
 330
 331   # Older DBD::Oracle warns loudly on partial execute_for_fetch failures
 332   # before https://metacpan.org/source/PYTHIAN/DBD-Oracle-1.28/Changes#L7-9
 333   local $_[2]->{PrintWarn} = 0
 334     unless modver_gt_or_eq( 'DBD::Oracle', '1.28' );
 335
 336   shift->next::method(@_);
 337 }
 338
 339 =head2 get_autoinc_seq
 340
 341 Returns the sequence name for an autoincrement column
 342
 343 =cut
 344
 345 sub get_autoinc_seq {
 346   my ($self, $source, $col) = @_;
 347
 348   $self->dbh_do('_dbh_get_autoinc_seq', $source, $col);
 349 }
 350
 351 =head2 datetime_parser_type
 352
 353 This sets the proper DateTime::Format module for use with
 354 L<DBIx::Class::InflateColumn::DateTime>.
 355
 356 =head2 connect_call_datetime_setup
 357
 358 Used as:
 359
 360     on_connect_call => 'datetime_setup'
 361
 362 In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the session nls
 363 date, and timestamp values for use with L<DBIx::Class::InflateColumn::DateTime>
 364 and the necessary environment variables for L<DateTime::Format::Oracle>, which
 365 is used by it.
 366
 367 Maximum allowable precision is used, unless the environment variables have
 368 already been set.
 369
 370 These are the defaults used:
 371
 372   $ENV{NLS_DATE_FORMAT}         ||= 'YYYY-MM-DD HH24:MI:SS';
 373   $ENV{NLS_TIMESTAMP_FORMAT}    ||= 'YYYY-MM-DD HH24:MI:SS.FF';
 374   $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
 375
 376 To get more than second precision with L<DBIx::Class::InflateColumn::DateTime>
 377 for your timestamps, use something like this:
 378
 379   use Time::HiRes 'time';
 380   my $ts = DateTime->from_epoch(epoch => time);
 381
 382 =cut
 383
 384 sub connect_call_datetime_setup {
 385   my $self = shift;
 386
 387   my $date_format = $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS';
 388   my $timestamp_format = $ENV{NLS_TIMESTAMP_FORMAT} ||=
 389     'YYYY-MM-DD HH24:MI:SS.FF';
 390   my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||=
 391     'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
 392
 393   $self->_do_query(
 394     "alter session set nls_date_format = '$date_format'"
 395   );
 396   $self->_do_query(
 397     "alter session set nls_timestamp_format = '$timestamp_format'"
 398   );
 399   $self->_do_query(
 400     "alter session set nls_timestamp_tz_format='$timestamp_tz_format'"
 401   );
 402 }
 403
 404 ### Note originally by Ron "Quinn" Straight <quinnfazigu@gmail.org>
 405 ### http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits/DBIx-Class.git;a=commitdiff;h=5db2758de644d53e07cd3e05f0e9037bf40116fc
 406 #
 407 # Handle LOB types in Oracle.  Under a certain size (4k?), you can get away
 408 # with the driver assuming your input is the deprecated LONG type if you
 409 # encode it as a hex string.  That ain't gonna fly at larger values, where
 410 # you'll discover you have to do what this does.
 411 #
 412 # This method had to be overridden because we need to set ora_field to the
 413 # actual column, and that isn't passed to the call (provided by Storage) to
 414 # bind_attribute_by_data_type.
 415 #
 416 # According to L<DBD::Oracle>, the ora_field isn't always necessary, but
 417 # adding it doesn't hurt, and will save your bacon if you're modifying a
 418 # table with more than one LOB column.
 419 #
 420 sub _dbi_attrs_for_bind {
 421   my ($self, $ident, $bind) = @_;
 422
 423   my $attrs = $self->next::method($ident, $bind);
 424
 425   # Push the column name into all bind attrs, make sure to *NOT* write into
 426   # the existing $attrs->[$idx]{..} hashref, as it is cached by the call to
 427   # next::method above.
 428   # FIXME - this code will go away when the LobWriter refactor lands
 429   $attrs->[$_]
 430     and
 431   keys %{ $attrs->[$_] }
 432     and
 433   $bind->[$_][0]{dbic_colname}
 434     and
 435   $attrs->[$_] = { %{$attrs->[$_]}, ora_field => $bind->[$_][0]{dbic_colname} }
 436     for 0 .. $#$attrs;
 437
 438   $attrs;
 439 }
 440
 441 sub bind_attribute_by_data_type {
 442   my ($self, $dt) = @_;
 443
 444   if ($self->_is_lob_type($dt)) {
 445
 446     # no earlier - no later
 447     $self->throw_exception(
 448       "BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later "
 449     . "version (https://rt.cpan.org/Public/Bug/Display.html?id=46016)"
 450     ) if modver_gt_or_eq_and_lt( 'DBD::Oracle', '1.23', '1.24' );
 451
 452     return {
 453       ora_type => $self->_is_text_lob_type($dt)
 454         ? DBD::Oracle::ORA_CLOB()
 455         : DBD::Oracle::ORA_BLOB()
 456     };
 457   }
 458   else {
 459     return undef;
 460   }
 461 }
 462
 463 # Handle blob columns in WHERE.
 464 #
 465 # For equality comparisons:
 466 #
 467 # We split data intended for comparing to a LOB into 2000 character chunks and
 468 # compare them using dbms_lob.substr on the LOB column.
 469 #
 470 # We turn off DBD::Oracle LOB binds for these partial LOB comparisons by passing
 471 # dbd_attrs => undef, because these are regular varchar2 comparisons and
 472 # otherwise the query will fail.
 473 #
 474 # Since the most common comparison size is likely to be under 4000 characters
 475 # (TEXT comparisons previously deployed to other RDBMSes) we disable
 476 # prepare_cached for queries with more than two part comparisons to a LOB
 477 # column. This is done in _dbh_execute (above) which was previously overridden
 478 # to gracefully recover from an Oracle error. This is to be careful to not
 479 # exhaust your application's open cursor limit.
 480 #
 481 # See:
 482 # http://itcareershift.com/blog1/2011/02/21/oracle-max-number-of-open-cursors-complete-reference-for-the-new-oracle-dba/
 483 # on the open_cursor limit.
 484 #
 485 # For everything else:
 486 #
 487 # We assume that everything that is not a LOB comparison, will most likely be a
 488 # LIKE query or some sort of function invocation. This may prove to be a naive
 489 # assumption in the future, but for now it should cover the two most likely
 490 # things users would want to do with a BLOB or CLOB, an equality test or a LIKE
 491 # query (on a CLOB.)
 492 #
 493 # For these expressions, the bind must NOT have the attributes of a LOB bind for
 494 # DBD::Oracle, otherwise the query will fail. This is done by passing
 495 # dbd_attrs => undef.
 496
 497 sub _prep_for_execute {
 498   my $self = shift;
 499   my ($op) = @_;
 500
 501   return $self->next::method(@_)
 502     if $op eq 'insert';
 503
 504   my ($sql, $bind) = $self->next::method(@_);
 505
 506   my $lob_bind_indices = { map {
 507     (
 508       $bind->[$_][0]{sqlt_datatype}
 509         and
 510       $self->_is_lob_type($bind->[$_][0]{sqlt_datatype})
 511     ) ? ( $_ => 1 ) : ()
 512   } ( 0 .. $#$bind ) };
 513
 514   return ($sql, $bind) unless %$lob_bind_indices;
 515
 516   my ($final_sql, @final_binds);
 517   if ($op eq 'update') {
 518     $self->throw_exception('Update with complex WHERE clauses involving BLOB columns currently not supported')
 519       if $sql =~ /\bWHERE\b .+ \bWHERE\b/xs;
 520
 521     my $where_sql;
 522     ($final_sql, $where_sql) = $sql =~ /^ (.+?) ( \bWHERE\b .+) /xs;
 523
 524     if (my $set_bind_count = $final_sql =~ y/?//) {
 525
 526       delete $lob_bind_indices->{$_} for (0 .. ($set_bind_count - 1));
 527
 528       # bail if only the update part contains blobs
 529       return ($sql, $bind) unless %$lob_bind_indices;
 530
 531       @final_binds = splice @$bind, 0, $set_bind_count;
 532       $lob_bind_indices = { map
 533         { $_ - $set_bind_count => $lob_bind_indices->{$_} }
 534         keys %$lob_bind_indices
 535       };
 536     }
 537
 538     # if we got that far - assume the where SQL is all we got
 539     # (the first part is already shoved into $final_sql)
 540     $sql = $where_sql;
 541   }
 542   elsif ($op ne 'select' and $op ne 'delete') {
 543     $self->throw_exception("Unsupported \$op: $op");
 544   }
 545
 546   my @sql_parts = split /\?/, $sql;
 547
 548   my $col_equality_re = qr/ (?<=\s) ([\w."]+) (\s*=\s*) $/x;
 549
 550   for my $b_idx (0 .. $#$bind) {
 551     my $bound = $bind->[$b_idx];
 552
 553     if (
 554       $lob_bind_indices->{$b_idx}
 555         and
 556       my ($col, $eq) = $sql_parts[0] =~ $col_equality_re
 557     ) {
 558       my $data = $bound->[1];
 559
 560       $data = "$data" if ref $data;
 561
 562       my @parts = unpack '(a2000)*', $data;
 563
 564       my @sql_frag;
 565
 566       for my $idx (0..$#parts) {
 567         push @sql_frag, sprintf (
 568           'UTL_RAW.CAST_TO_VARCHAR2(RAWTOHEX(DBMS_LOB.SUBSTR(%s, 2000, %d))) = ?',
 569           $col, ($idx*2000 + 1),
 570         );
 571       }
 572
 573       my $sql_frag = '( ' . (join ' AND ', @sql_frag) . ' )';
 574
 575       $sql_parts[0] =~ s/$col_equality_re/$sql_frag/;
 576
 577       $final_sql .= shift @sql_parts;
 578
 579       for my $idx (0..$#parts) {
 580         push @final_binds, [
 581           {
 582             %{ $bound->[0] },
 583             _ora_lob_autosplit_part => $idx,
 584             dbd_attrs => undef,
 585           },
 586           $parts[$idx]
 587         ];
 588       }
 589     }
 590     else {
 591       $final_sql .= shift(@sql_parts) . '?';
 592       push @final_binds, $lob_bind_indices->{$b_idx}
 593         ? [
 594           {
 595             %{ $bound->[0] },
 596             dbd_attrs => undef,
 597           },
 598           $bound->[1],
 599         ] : $bound
 600       ;
 601     }
 602   }
 603
 604   if (@sql_parts > 1) {
 605     carp "There are more placeholders than binds, this should not happen!";
 606     @sql_parts = join ('?', @sql_parts);
 607   }
 608
 609   $final_sql .= $sql_parts[0];
 610
 611   return ($final_sql, \@final_binds);
 612 }
 613
 614 # Savepoints stuff.
 615
 616 sub _exec_svp_begin {
 617   my ($self, $name) = @_;
 618   $self->_dbh->do("SAVEPOINT $name");
 619 }
 620
 621 # Oracle automatically releases a savepoint when you start another one with the
 622 # same name.
 623 sub _exec_svp_release { 1 }
 624
 625 sub _exec_svp_rollback {
 626   my ($self, $name) = @_;
 627   $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
 628 }
 629
 630 =head2 relname_to_table_alias
 631
 632 L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
 633 queries.
 634
 635 Unfortunately, Oracle doesn't support identifiers over 30 chars in length, so
 636 the L<DBIx::Class::Relationship> name is shortened and appended with half of an
 637 MD5 hash.
 638
 639 See L<DBIx::Class::Storage::DBI/relname_to_table_alias>.
 640
 641 =cut
 642
 643 sub relname_to_table_alias {
 644   my $self = shift;
 645   my ($relname, $join_count) = @_;
 646
 647   my $alias = $self->next::method(@_);
 648
 649   # we need to shorten here in addition to the shortening in SQLA itself,
 650   # since the final relnames are crucial for the join optimizer
 651   return $self->sql_maker->_shorten_identifier($alias);
 652 }
 653
 654 =head2 with_deferred_fk_checks
 655
 656 Runs a coderef between:
 657
 658   alter session set constraints = deferred
 659   ...
 660   alter session set constraints = immediate
 661
 662 to defer foreign key checks.
 663
 664 Constraints must be declared C<DEFERRABLE> for this to work.
 665
 666 =cut
 667
 668 sub with_deferred_fk_checks {
 669   my ($self, $sub) = @_;
 670
 671   my $txn_scope_guard = $self->txn_scope_guard;
 672
 673   $self->_do_query('alter session set constraints = deferred');
 674
 675   my $sg = Scope::Guard->new(sub {
 676     $self->_do_query('alter session set constraints = immediate');
 677   });
 678
 679   return
 680     preserve_context { $sub->() } after => sub { $txn_scope_guard->commit };
 681 }
 682
 683 =head1 ATTRIBUTES
 684
 685 Following additional attributes can be used in resultsets.
 686
 687 =head2 connect_by or connect_by_nocycle
 688
 689 =over 4
 690
 691 =item Value: \%connect_by
 692
 693 =back
 694
 695 A hashref of conditions used to specify the relationship between parent rows
 696 and child rows of the hierarchy.
 697
 698
 699   connect_by => { parentid => 'prior personid' }
 700
 701   # adds a connect by statement to the query:
 702   # SELECT
 703   #     me.persionid me.firstname, me.lastname, me.parentid
 704   # FROM
 705   #     person me
 706   # CONNECT BY
 707   #     parentid = prior persionid
 708
 709
 710   connect_by_nocycle => { parentid => 'prior personid' }
 711
 712   # adds a connect by statement to the query:
 713   # SELECT
 714   #     me.persionid me.firstname, me.lastname, me.parentid
 715   # FROM
 716   #     person me
 717   # CONNECT BY NOCYCLE
 718   #     parentid = prior persionid
 719
 720
 721 =head2 start_with
 722
 723 =over 4
 724
 725 =item Value: \%condition
 726
 727 =back
 728
 729 A hashref of conditions which specify the root row(s) of the hierarchy.
 730
 731 It uses the same syntax as L<DBIx::Class::ResultSet/search>
 732
 733   start_with => { firstname => 'Foo', lastname => 'Bar' }
 734
 735   # SELECT
 736   #     me.persionid me.firstname, me.lastname, me.parentid
 737   # FROM
 738   #     person me
 739   # START WITH
 740   #     firstname = 'foo' and lastname = 'bar'
 741   # CONNECT BY
 742   #     parentid = prior persionid
 743
 744 =head2 order_siblings_by
 745
 746 =over 4
 747
 748 =item Value: ($order_siblings_by | \@order_siblings_by)
 749
 750 =back
 751
 752 Which column(s) to order the siblings by.
 753
 754 It uses the same syntax as L<DBIx::Class::ResultSet/order_by>
 755
 756   'order_siblings_by' => 'firstname ASC'
 757
 758   # SELECT
 759   #     me.persionid me.firstname, me.lastname, me.parentid
 760   # FROM
 761   #     person me
 762   # CONNECT BY
 763   #     parentid = prior persionid
 764   # ORDER SIBLINGS BY
 765   #     firstname ASC
 766
 767 =head1 FURTHER QUESTIONS?
 768
 769 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 770
 771 =head1 COPYRIGHT AND LICENSE
 772
 773 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 774 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 775 redistribute it and/or modify it under the same terms as the
 776 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 777
 778 =cut
 779
 780 1;
 781 # vim:sts=2 sw=2: