Vyššie na [Platon] / perl-modules / Platon / MySQL

Fix: call bind_param() on delete record SQL.

#
# admin/sql.pm
#
# Developed by Lubomir Host 'rajo' <rajo AT platon.sk>
#
# Changelog:
# 2004-08-09 - created
#

# $Id: Admin.pm,v 1.2 2005/03/27 00:31:42 rajo Exp $

package Platon::MySQL::Admin;

use strict;
use Carp;
use DBI qw(:sql_types);

use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DEBUG);

@ISA        = qw(Exporter);
@EXPORT        = qw( );
$VERSION    = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
$DEBUG        = 0;

sub new
{ #{{{
    my ($this, $dbh, $param) = @_;
    my $class = ref($this) || $this;
    my $self  = {
        dbh    => $dbh,
    };
    if (defined($param) and ref($param)) {
        foreach my $key (keys %$param) {
            #warn "Overvwiting '$key' => " . Dumper($param->{$key});
            $self->{$key} = $param->{$key};
        }
    }

    # zistime, kto nas zavolal
    my ($caller_pkg, $caller_file, $caller_line) = caller;
    $self->{_caller} = "$caller_file:$caller_line"; #  (" . __FILE__ . ':' . __LINE__ . ')';

    bless $self, $class;

    $self->_prepare_sql($dbh);

    return $self;
} # }}}

# funkcia skopiruje nejaky riadok v tabulke, ale niektore hodnoty stlpcov mozno zmenit
sub sql_copy_row($;)
{ # {{{
    my ($self, $data) = @_;
    my $dbh = $self->{dbh};

    $data = defined($data) ? $data : $self;

    foreach my $key (qw' table primary_key_name primary_key_value delete_columns new_values ') {
        if (!defined($data->{$key})) {
            die "Undefined REQUIRED parameter '$key'";
        }
    }
    $dbh = $data->{dbh} if (defined $data->{dbh});

    my $sql_select = $dbh->prepare(" /* sql_select " . __FILE__ . ':' . __LINE__ . "*/
        SELECT
            *
        FROM $data->{table} WHERE $data->{primary_key_name} = ?
    ") or $self->sql_error(__LINE__, $dbh->errstr);
    $sql_select->bind_param(1, 0, SQL_INTEGER);

    $sql_select->execute($data->{primary_key_value}) or $self->sql_error(__LINE__, $dbh->errstr);
    my $sel = $sql_select->fetchrow_hashref() or $self->sql_error(__LINE__, $dbh->errstr);
    $sql_select->finish() or $self->sql_error(__LINE__, $dbh->errstr);

    # prepisanie hodnot
    foreach my $key (@{$data->{delete_columns}}) {
        delete ($sel->{$key});
    }
    foreach my $key (keys %{$data->{new_values}}) {
        $sel->{$key} = $data->{new_values}->{$key};
    }

    # vytvorenie query
    my @val;
    my @var;
    my $sql = "INSERT INTO $data->{table}\n\t(" . (defined($data->{datetime_col}) ? "$data->{datetime_col}, " : "");
    foreach my $key (keys %$sel) {
        push @var, $key;
        push @val, $sel->{$key};
    }
    $sql .= join(", ", @var) . ")\n VALUES (" . (defined($data->{datetime_col}) ? "NOW(), " : "") . ("?, " x (scalar(@val) - 1)) . "?)";
    my $sql_insert = $dbh->prepare("/* sql_insert " . __FILE__ . ':' . __LINE__
        . "*/\n$sql") or $self->sql_error(__LINE__, $dbh->errstr);
    $sql_insert->execute(@val) or $self->sql_error(__LINE__, $dbh->errstr);

    my $mid = $sql_insert->{'mysql_insertid'} or $self->sql_error(__LINE__, $dbh->errstr);

    return $mid;

} # }}}

# do something if error during sql query occures
sub sql_error($$;)
{ # {{{
    my ($self, $line, $errstr) = @_;
    
    #push @sql_errors, "line $line: $errstr";
    print STDERR "$line: $errstr\n";
    
} # }}}

# vrati zoznam vsetkych prvkov
sub get_data($)
{ # {{{
    my ($self, $param) = @_;
    my @param;
    my $dbh = $self->{dbh};

    foreach my $key (qw'data_where data_limit ') {
        if (defined($param->{$key}) and ref($param->{$key}) eq 'ARRAY') {
            push @param, $param->{$key};
        }
    }
    
    $self->{sql_get_data}->execute(@param) or $self->sql_error(__LINE__, $dbh->errstr);
    my $data = $self->{sql_get_data}->fetchall_arrayref({}) or $self->sql_error(__LINE__, $dbh->errstr);
    $self->{sql_get_data}->finish();

    return $data;

} # }}}

# vrati udaje o jednom zazname v tabulke
sub get_record($$;)
{ # {{{
    my ($self, $pk) = @_;
    my $dbh = $self->{dbh};

    $self->{sql_get_record}->execute($pk) or $self->sql_error(__LINE__, $dbh->errstr);
    my $data = $self->{sql_get_record}->fetchrow_hashref() or $self->sql_error(__LINE__, $dbh->errstr);
    $self->{sql_get_record}->finish();

    return $data;

} # }}}

# aktualizuje jeden zaznam v tabulke
sub update_record($$;)
{ # {{{
    my ($self, $data) = @_;
    my @param;
    my $dbh = $self->{dbh};

    # fill with parameter from user
    foreach my $key (@{$self->{update_columns}}) {
        push @param, $data->{$key};
    }
    $self->{sql_update_record}->execute(@param, $data->{ $self->{primary_key_name} }) or $self->sql_error(__LINE__, $dbh->errstr);

    return $self->{sql_update_record}->rows();

} # }}}

# vutvori jeden zaznam v tabulke
sub create_record($$;)
{ # {{{
    my ($self, $data) = @_;
    my @param;
    my $dbh = $self->{dbh};

    # fill with parameter from user
    foreach my $key (@{$self->{update_columns}}) {
        push @param, $data->{$key};
    }
    $self->{sql_create_record}->execute(@param) or $self->sql_error(__LINE__, $dbh->errstr);

    return $self->{sql_create_record}->{'mysql_insertid'};

} # }}}

# zmaze jeden zaznam v tabulke
sub delete_record($$;)
{ # {{{
    my ($self, $pk, $limit) = @_;
    my $dbh = $self->{dbh};

    $limit = defined($limit) ? $limit : 1;

    $self->{sql_delete_record}->execute($pk, $limit) or $self->sql_error(__LINE__, $dbh->errstr);

    return $self->{sql_delete_record}->rows();

} # }}}

sub _prepare_sql ($$;)
{ # {{{
    my ($self, $dbh) = @_;

    $self->{sql_get_data} = $dbh->prepare(" /* sql_get_data $self->{_caller} */
        SELECT "
            . join(', ', @{$self->{select_columns}}) .
    "    FROM $self->{table} "
    . ((defined($self->{data_where}) and $self->{data_where} ne '')
        ? "WHERE " . join('AND ', @{$self->{data_where}}) : '')

    . ((defined($self->{data_order}) and $self->{data_order} ne '')
        ? "ORDER BY " . join(', ', @{$self->{data_order}}) : '')

    . ((defined($self->{data_limit}) and $self->{data_limit} ne '')
        ? "LIMIT " . join(', ', @{$self->{data_limit}}) : '')
    ) or croak "Can't get record: " . $dbh->errstr;

    $self->{sql_get_record} = $dbh->prepare(" /* sql_get_record $self->{_caller} */
        SELECT "
            . join(', ', @{$self->{select_columns}}) .
    "    FROM $self->{table}
        WHERE $self->{primary_key_name} = ?
        LIMIT 1
    ") or croak "Can't get record: " . $dbh->errstr;

    $self->{sql_update_record} = $dbh->prepare(" /* sql_update_record $self->{_caller} */
        UPDATE $self->{table} "
        . "SET " . join(' = ?, ', @{$self->{update_columns}}) . " = ?
        WHERE $self->{primary_key_name} = ?
        LIMIT 1
    ") or croak "Can't update record: " . $dbh->errstr;

    $self->{sql_create_record} = $dbh->prepare(" /* sql_create_record $self->{_caller} */
        INSERT INTO  $self->{table} "
        . "(" . join(', ', @{$self->{update_columns}}) . ")
        VALUES (" . ('?, ' x (scalar(@{$self->{update_columns}}) - 1)) . "?)
    ") or croak "Can't create record: " . $dbh->errstr;

    $self->{sql_delete_record} = $dbh->prepare(" /* sql_delete_record $self->{_caller} */
        DELETE FROM  $self->{table}
        WHERE $self->{primary_key_name} = ?
        LIMIT ?
    ") or croak "Can't delete record: " . $dbh->errstr;
    $self->{sql_delete_record}->bind_param(2, 0, SQL_INTEGER);

} # }}}

1;

__END__

=head1 NAME

sql - <<<description of module>>>

=head1 SYNOPSIS

  use Platon::MySQL::Admin;

  my $xxx = new sql;

=head1 DESCRIPTION

The sql module allows you ...
<<<your description here>>>

=head2 EXPORT

<<here describe exported methods>>>

=head1 SEE ALSO

=head1 AUTHORS

Lubomir Host 'rajo', <rajo AT platon.sk>

=cut

# vim: ts=4
# vim600: fdm=marker fdl=0 fdc=3