view release on metacpan or  search on metacpan

IO/OracleIO.pm  view on Meta::CPAN

            return -1.4;
        }
        else
        {
            return undef;
        }
    }

    return (length($pk) ? $pk : -1.2);
}


=pod

=item C<sequence_name>

 $sequence_name = $io->sequence_name([$sequence_name]);

Get/set the name of the sequence that generates key values
for inserts. Defaults to the name of the table prepended with "SEQ_".

=cut
sub sequence_name
{
    my ($self,$sequence_name) = @_;
    if (defined($sequence_name))
    {
        return $self->{sequence_name} = $sequence_name;
    }
    return $self->{sequence_name};
}


=pod

=item C<key_nextval>

 $next_seq_val = $io->key_nextval([$seq_name]);

Returns the next value in the Oracle sequence object named
$seq_name or the table name prepended with "SEQ_"
All sequence statement handles are cached per $dbh for performance
reasons. A new $sth will be prepared unless the object that calls
this method has previously called it with the same sequence request.

Returns undef if error.

=cut
sub key_nextval
{
    my ($self,$seq) = @_;
    ref($self) || (warn("\$self not an object"),return undef);
    my $dbh = $self->{dbh};
    $seq ||= $self->{sequence_name};
##at DBI version requirement prepare_cached
    my $crs = $dbh->prepare_cached("SELECT $seq.NEXTVAL FROM DUAL") || return undef;
    $crs->execute() || return undef;
    return (($crs->fetchrow_array)[0]);
}

sub update_hash
{
    my ($self,$update,$key,$date_format,$hint) = @_;
    ref($self) || (warn("\$self not an object"),return undef);
    ref($update) || ($self->_alert("\$update not a hash ref"), return undef);
    %$update || return -1;
    my $dbh = $self->dbh();
    my $table = $self->table_name();
    unless (ref($key))
    {
        $key = { $self->key_name() => $key };
    }

    my $where = $self->_build_where_clause($key) || return undef;

    my $set_sql;
    my $attrs = $self->column_types();
    my %bind;
    my ($col,$val);
    while (($col,$val) = each %$update)
    {
        $col = uc($col);
##at does insert implement it's optional $hint feature?
        $val = $self->qualify($val,$col,$date_format);
        if (is_long_type($attrs->{$col}))
        {
            $bind{":$col"} = [ $col,$val ];
            $val = ":$col";
        }
        unless (defined($val))
        {
            $self->_alert("Unable to qualify insert value: qualify($val,$col,$date_format)");
            return undef;
        }
        $set_sql .= "$col = $val,";
    }
    chop($set_sql);
    my ($bind_field,$bind_val);
    my $sql = "UPDATE $hint $table SET $set_sql $where";
    my $sth = $dbh->prepare($sql) || ($self->_alert("Can't prepare $sql"), return undef);
    while (($bind_field,$bind_val) = each %bind)
    {
        my ($field,$val) = @$bind_val;
        my $type = $long_lob_types{$attrs->{$field}};
        $sth->bind_param($bind_field,$val,{ ora_type => $type, ora_field => $field }) || ($self->_alert("Error binding $bind_field"), return undef);
    }
    return $sth->execute();
}

##at should normalize the data types, e.g. $io->{column_types}{$column} = $DBIx::IO::GenLib::NORMAL_DATETIME_TYPE

=pod

=item C<existing_table_names>

 $sorted_arrayref = DBIx::IO::OracleIO->existing_table_names([$dbh]);

Return a sorted arrayref of table names found in the
data dictionary.

Class or object method.