view release on metacpan or  search on metacpan

DB/Pg.pm  view on Meta::CPAN

package Embedix::DB::Pg;

use strict;
use vars qw($AUTOLOAD);

# for warning message from the caller's perspective
use Carp;

# for loading data from files
use Embedix::ECD;

# for database support
use DBI;

# constructor
#_______________________________________
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    (@_ & 1) && croak("Odd number of parameters.");
    my %opt   = @_;

    my $dbh  = DBI->connect(@{$opt{source}}) || croak($DBI::errstr);
    my $self = {
        dbh        => $dbh,
        distro     => undef,    # hashref w/ info on current working distro
        path_cache => { },      # $path_cache->{node_id} eq $path
    };
    bless($self => $class);

    #self->workOnDistro(name => $opt{name}, board => $opt{board});
    return $self;
}

# destructor
#_______________________________________
sub DESTROY {
    my $self = shift;
    $self->{dbh}->disconnect();
}

# for when things go wrong...
#_______________________________________
sub rollbackAndCroak {
    my $self = shift;
    my $msg  = shift;
    my $dbh  = $self->{dbh};
    my $err  = $dbh->errstr . "\n$msg";
    $dbh->rollback;
    croak($err);
}

# $insert_statement = $hotel->buildInsertStatement (
#     table => "table",
#     data  => \%column
# );
#_______________________________________
sub buildInsertStatement {
    my $self = shift;
    my $dbh  = $self->{dbh};

    (@_ & 1) && croak "Odd number of parameters\n";
    my %opt    = @_;
    my $column = $opt{data};

    my $insert = "insert into $opt{table} ( ";
    $insert .= join(", ", keys %$column);
    $insert =~ s/, $//;
    $insert .= " ) values ( ";
    $insert .= join(", ", map { $dbh->quote($_) } values %$column);
    $insert =~ s/, $//;
    $insert .= " );";

    return $insert;
}

# $update_statement = $hotel->buildUpdateStatement (
#     table => "table",
#     data  => \%column,
#     where => "id = 'whatever'",
#     primary_key => 'id',
# );
#
# note that you should use 'where' xor 'primary_key'.
# do not use both at the same time
# use at least one of them.  ...xor
#_______________________________________
sub buildUpdateStatement {
    my $self = shift;