my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||=
'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
- $self->_do_query("alter session set nls_date_format = '$date_format'");
$self->_do_query(
-"alter session set nls_timestamp_format = '$timestamp_format'");
+ "alter session set nls_date_format = '$date_format'"
+ );
$self->_do_query(
-"alter session set nls_timestamp_tz_format='$timestamp_tz_format'");
+ "alter session set nls_timestamp_format = '$timestamp_format'"
+ );
+ $self->_do_query(
+ "alter session set nls_timestamp_tz_format='$timestamp_tz_format'"
+ );
}
=head2 source_bind_attributes
sub source_bind_attributes
{
- require DBD::Oracle;
- my $self = shift;
- my($source) = @_;
+ require DBD::Oracle;
+ my $self = shift;
+ my($source) = @_;
- my %bind_attributes;
+ my %bind_attributes;
- foreach my $column ($source->columns) {
- my $data_type = $source->column_info($column)->{data_type} || '';
- next unless $data_type;
+ foreach my $column ($source->columns) {
+ my $data_type = $source->column_info($column)->{data_type} || '';
+ next unless $data_type;
- my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
+ my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
- if ($data_type =~ /^[BC]LOB$/i) {
- $column_bind_attrs{'ora_type'} = uc($data_type) eq 'CLOB' ?
- DBD::Oracle::ORA_CLOB() :
- DBD::Oracle::ORA_BLOB();
- $column_bind_attrs{'ora_field'} = $column;
- }
+ if ($data_type =~ /^[BC]LOB$/i) {
+ if ($DBD::Oracle::VERSION eq '1.23') {
+ $self->throw_exception(
+"BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
+"version.\n\nSee: https://rt.cpan.org/Public/Bug/Display.html?id=46016\n"
+ );
+ }
- $bind_attributes{$column} = \%column_bind_attrs;
- }
+ $column_bind_attrs{'ora_type'} = uc($data_type) eq 'CLOB'
+ ? DBD::Oracle::ORA_CLOB()
+ : DBD::Oracle::ORA_BLOB()
+ ;
+ $column_bind_attrs{'ora_field'} = $column;
+ }
+
+ $bind_attributes{$column} = \%column_bind_attrs;
+ }
- return \%bind_attributes;
+ return \%bind_attributes;
}
sub _svp_begin {
- my ($self, $name) = @_;
-
- $self->_get_dbh->do("SAVEPOINT $name");
+ my ($self, $name) = @_;
+ $self->_get_dbh->do("SAVEPOINT $name");
}
# Oracle automatically releases a savepoint when you start another one with the
sub _svp_release { 1 }
sub _svp_rollback {
- my ($self, $name) = @_;
-
- $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
+ my ($self, $name) = @_;
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
=head2 relname_to_table_alias
$ctx->add($alias);
my $md5 = $ctx->b64digest;
+ # remove alignment mark just in case
+ $md5 =~ s/=*\z//;
+
# truncate and prepend to truncated relname without vowels
(my $devoweled = $relname) =~ s/[aeiou]//g;
- my $res = substr($devoweled, 0, 18) . '_' . substr($md5, 0, 11);
+ my $shortened = substr($devoweled, 0, 18);
+
+ my $new_alias =
+ $shortened . '_' . substr($md5, 0, 30 - length($shortened) - 1);
+
+ return $new_alias;
+}
+
+=head2 with_deferred_fk_checks
+
+Runs a coderef between:
+
+ alter session set constraints = deferred
+ ...
+ alter session set constraints = immediate
+
+to defer FK checks.
+
+=cut
- return $res;
+sub with_deferred_fk_checks {
+ my ($self, $sub) = @_;
+ $self->_do_query('alter session set constraints = deferred');
+ $sub->();
+ $self->_do_query('alter session set constraints = immediate');
}
=head1 AUTHOR