view release on metacpan or  search on metacpan

IO/mysqlIO.pm  view on Meta::CPAN

    my ($type,$length) = @_;
    return $length if $length;
    return 24 if $type =~ /float/i;
    return 53 if $type =~ /double/i;
    return 255;
}

sub insert_hash
{
    my ($self,$insert,$date_format) = @_;
    ref($self) || (warn("\$self not an object"),return undef);
    ref($insert) || ($self->_alert("\$insert_hash not a hash ref"),return undef);
    my $dbh = $self->{dbh};
    my $table = $self->table_name();

    %$insert || return -1.1;

    my ($fields,$values,$field,$qual_val);
    foreach $field (keys %$insert)
    {
        $field = uc($field);
        $fields .= "$field,";
        $qual_val = $self->qualify($insert->{$field},$field,$date_format);
        unless (defined($qual_val))
        {
            $self->_alert("Unable to qualify insert value: qualify($insert->{$field},$field,$date_format)");
            return undef;
        }
        $values .= "$qual_val,";
    }
    chop($fields);
    chop($values);
    my $sql = "INSERT INTO $table ($fields) VALUES ($values)";
    my $sth = $dbh->prepare($sql) || ($self->_alert("Can't prepare $sql"), return undef);
    my $rv = $sth->execute();
    unless ($rv)
    {
        if ($sth->err == 1062)
        {
            return -1.4;
        }
        else
        {
            return undef;
        }
    }

    my $pkname = $self->key_name();
    my $pk;
    if ($pkname && !exists($insert->{$pkname}))
    {
        $pk = $sth->{mysql_insertid};
    }
    elsif (exists($insert->{$pkname}))
    {
        $pk = $insert->{$pkname};
    }
    return (length($pk) ? $pk : -1.2);
}

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 ($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);
        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 $sql = "UPDATE $hint $table SET $set_sql $where";
    my $sth = $dbh->prepare($sql) || ($self->_alert("Can't prepare $sql"), return undef);
    return $sth->execute();
}

=pod

=item C<existing_table_names>

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

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

Class or object method.
$dbh is required if called as a class method.

Return undef if db error.

=cut
sub existing_table_names
{
    my ($caller,$dbh) = @_;
    $dbh ||= $caller->dbh();
    my $rv = $dbh->selectcol_arrayref('SHOW TABLES');
    return undef if $dbh->err;
    return $rv;
}

=pod