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