view release on metacpan or  search on metacpan

lib/DBIO/Oracle/Storage/LOBSupport.pm  view on Meta::CPAN

      }

      my $sql_frag = '( ' . (join ' AND ', @sql_frag) . ' )';
      $sql_parts[0] =~ s/$col_equality_re/$sql_frag/;

      $final_sql .= shift @sql_parts;

      for my $idx (0..$#parts) {
        push @final_binds, [
          { %{ $bound->[0] }, _ora_lob_autosplit_part => $idx, dbd_attrs => undef },
          $binary ? uc unpack('H*', $parts[$idx][1]) : $parts[$idx][1],
        ];
      }
    }
    else {
      $final_sql .= shift(@sql_parts) . '?';
      push @final_binds, $lob_bind_indices->{$b_idx}
        ? [{ %{ $bound->[0] }, dbd_attrs => undef }, $bound->[1]]
        : $bound;
    }
  }

  if (@sql_parts > 1) {
    carp "There are more placeholders than binds, this should not happen!";
    @sql_parts = join('?', @sql_parts);
  }

  $final_sql .= $sql_parts[0];
  return $op eq 'update'
    ? $self->_wrap_lob_dml($final_sql, \@final_binds, 'update')
    : ($final_sql, \@final_binds);
}

# see "INSERT and UPDATE with LOB values" above
sub _wrap_lob_dml {
  my ($self, $sql, $bind, $op) = @_;

  return ($sql, $bind) unless grep {
    my $b = $_->[0];
    ref $b eq 'HASH'
      and (
        ( $b->{dbd_attrs} and ref $b->{dbd_attrs} eq 'HASH' and exists $b->{dbd_attrs}{ora_type} )
          or
        ( !exists $b->{dbd_attrs} and $b->{sqlt_datatype} and $self->_is_lob_type($b->{sqlt_datatype}) )
      )
  } @$bind;

  return ("BEGIN $sql; END;", $bind) unless $op and $op eq 'update';

  # DBD::Oracle reports the row count of the block (always 1), not of the
  # UPDATE inside it. The block hands the real one back in an out bind.
  my $rc;
  $self->{_ora_lob_update_rowcount} = \$rc;
  return (
    "BEGIN $sql; ? := SQL%ROWCOUNT; END;",
    [ @$bind, [ { dbd_attrs => undef, dbd_size => 40 }, \$rc ] ],
  );
}


sub update {
  my $self = shift;

  local $self->{_ora_lob_update_rowcount};
  my $rv = $self->next::method(@_);

  my $rc = $self->{_ora_lob_update_rowcount};
  return $rv unless $rc and defined $$rc;
  return $$rc || '0E0';
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

DBIO::Oracle::Storage::LOBSupport - LOB binding and chunking for Oracle

=head1 VERSION

version 0.900004

=head1 DESCRIPTION

Handles Oracle LOB binding and chunked comparison logic.

=head1 METHODS

=head2 update

Returns the number of rows the C<UPDATE> changed, C<0E0> when none. When the
statement was sent as a block (see L</INSERT and UPDATE with LOB values>) the
count is the one the block read from C<SQL%ROWCOUNT>, so C<< $rs->update >>
and the "no row matched" check of C<< $row->update >> see the real number.

=head1 INSERT and UPDATE with LOB values

DBD::Oracle (1.95 and earlier, checked against Oracle 23ai) re-reads a LOB it
has just written, from the table and column names it takes out of the
C<INSERT>/C<UPDATE> text and I<upper-cases>. A table or a LOB column that was
created with a quoted lower-case or mixed-case name (what every quoting DBIO
schema does) is not found: the statement dies with ORA-01741 or ORA-00904
although the SQL itself is valid, and without C<ora_type> the same statement
dies with ORA-01465 or ORA-24816. The refetch only looks at statements that
begin with C<INSERT> or C<UPDATE>, so this storage sends every such statement
that binds a LOB inside an anonymous block, C<BEGIN ... ; END;>. The block runs
the same statement, C<RETURNING ... INTO> included, and DBD::Oracle binds the
LOB with C<ora_type> as before, but without the refetch. The upstream report
draft is C<maint/upstream/dbd-oracle-lob-refetch-quoted-identifiers.md>.

=head1 Comparing a LOB by value

A LOB cannot be compared with C<=> (ORA-22848), so a condition C<< { col =E<gt>
$value } >> on a LOB column is written as one comparison per part of the value,
joined with C<AND>, each on C<DBMS_LOB.SUBSTR> of the column.