view release on metacpan or  search on metacpan

lib/DBIx/Simple.pm  view on Meta::CPAN

    my $old = $old_statements{$self};

    if (defined( my $i = (grep $old->[$_][0] eq $query, 0..$#$old)[0] )) {
        $st = splice(@$old, $i, 1)->[1];
        $sth = $st->{sth};
    } else {
        eval { $sth = $self->{dbh}->prepare($query) } or do {
            if ($@) {
                $@ =~ s/ at \S+ line \d+\.\n\z//;
                Carp::croak($@);
            }
            $self->{reason} = "Prepare failed ($DBI::errstr)";
            return _dummy;
        };

        # $self is quoted on purpose, to pass along the stringified version,
        # and avoid increasing reference count.
        $st = bless {
            db    => "$self",
            sth   => $sth,
            query => $query
        }, 'DBIx::Simple::Statement';
        $statements{$self}{$st} = $st;
    }

    eval { $sth->execute(@binds) } or do {
        if ($@) {
            $@ =~ s/ at \S+ line \d+\.\n\z//;
            Carp::croak($@);
        }

        $self->{reason} = "Execute failed ($DBI::errstr)";
	return _dummy;
    };

    $self->{success} = 1;

    return bless { st => $st, lc_columns => $self->{lc_columns} }, $self->{result_class};
}

sub begin_work     { $_[0]->{dbh}->begin_work }
sub begin          { $_[0]->begin_work        }
sub commit         { $_[0]->{dbh}->commit     }
sub rollback       { $_[0]->{dbh}->rollback   }
sub func           { shift->{dbh}->func(@_)   }

sub last_insert_id {
    my ($self) = @_;

    ($self->{dbi_version} ||= DBI->VERSION) >= 1.38 or Carp::croak(
    	"DBI v1.38 required for last_insert_id" .
	"--this is only $self->{dbi_version}, stopped"
    );

    return shift->{dbh}->last_insert_id(@_);
}

sub disconnect {
    my ($self) = @_;
    $self->_die(sprintf($err_cause, "$self->disconnect", (caller)[1, 2]));
    return 1;
}

sub DESTROY {
    my ($self) = @_;
    $self->_die(sprintf($err_cause, "$self->DESTROY", (caller)[1, 2]));
}

### public methods wrapping SQL::Abstract

for my $method (qw/select insert update delete/) {
    no strict 'refs';
    *$method = sub {
        my $self = shift;
        return $self->query($self->abstract->$method(@_));
    }
}

### public method wrapping SQL::Interp

sub iquery {
    require SQL::Interp;
    my $self = shift;
    return $self->query( SQL::Interp::sql_interp(@_) );
}

package DBIx::Simple::Dummy;

use overload
    '""' => sub { shift },
    bool => sub { 0 };

sub new      { bless \my $dummy, shift }
sub AUTOLOAD { return }

package DBIx::Simple::DeadObject;

sub _die {
    my ($self) = @_;
    Carp::croak(
        sprintf(
            "(This should NEVER happen!) " .
            sprintf($err_message, $self->{what}),
            $self->{cause}
        )
    );
}

sub AUTOLOAD {
    my ($self) = @_;
    Carp::croak(
        sprintf(
            sprintf($err_message, $self->{what}),
            $self->{cause}
        )
    );
}
sub DESTROY { }

package DBIx::Simple::Statement;

sub _die {
    my ($self, $cause, $save) = @_;

    $self->{sth}->finish() if defined $self->{sth};
    $self->{dead} = 1;

lib/DBIx/Simple.pm  view on Meta::CPAN

    $_[0]->{st}->{sth}->rows;
}

sub xto {
    $_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject';
    require DBIx::XHTML_Table;
    my $self = shift;
    my $attr = ref $_[0] ? $_[0] : { @_ };

    # Old DBD::SQLite (.29) spits out garbage if done *after* fetching.
    my $columns = $self->{st}->{sth}->{NAME};

    return DBIx::XHTML_Table->new(
        scalar $self->arrays,
        $columns,
        $attr
    );
}

sub html {
    $_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject';
    my $self = shift;
    my $attr = ref $_[0] ? $_[0] : { @_ };
    return $self->xto($attr)->output($attr);
}

sub text {
    $_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject';
    my ($self, $type) = @_;
    my $text_table = defined $type && length $type
        ? 0
        : eval { require Text::Table; $type = 'table'; 1 };
    $type ||= 'neat';
    if ($type eq 'box' or $type eq 'table') {
        my $box = $type eq 'box';
        $text_table or require Text::Table;
        my @columns = map +{ title => $_, align_title => 'center' },
            @{ $self->{st}->{sth}->{NAME} };
        my $c = 0;
        splice @columns, $_ + $c++, 0, \' | ' for 1 .. $#columns;
        my $table = Text::Table->new(
            ($box ? \'| ' : ()),
            @columns,
            ($box ? \' |' : ())
        );
        $table->load($self->arrays);
        my $rule = $table->rule(qw/- +/);
        return join '',
            ($box ? $rule : ()),
            $table->title, $rule, $table->body,
            ($box ? $rule : ());
    }
    Carp::carp("Unknown type '$type'; using 'neat'") if $type ne 'neat';
    return join '', map DBI::neat_list($_) . "\n", $self->arrays;
}

sub finish {
    $_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject';
    my ($self) = @_;
    $self->_die(
        sprintf($err_cause, "$self->finish", (caller)[1, 2])
    );
}

sub DESTROY {
    return if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject';
    my ($self) = @_;
    $self->_die(
        sprintf($err_cause, "$self->DESTROY", (caller)[1, 2])
    );
}

1;

__END__

=head1 NAME

DBIx::Simple - Very complete easy-to-use OO interface to DBI

=head1 SYNOPSIS

=head2 DBIx::Simple

    $db = DBIx::Simple->connect(...)  # or ->new

    $db->keep_statements = 16
    $db->lc_columns = 1
    $db->result_class = 'DBIx::Simple::Result';

    $db->begin_work         $db->commit
    $db->rollback           $db->disconnect
    $db->func(...)          $db->last_insert_id

    $result = $db->query(...)

=head2 DBIx::SImple + SQL::Interp

    $result = $db->iquery(...)

=head2 DBIx::Simple + SQL::Abstract

    $db->abstract = SQL::Abstract->new(...)

    $result = $db->select(...)
    $result = $db->insert(...)
    $result = $db->update(...)
    $result = $db->delete(...)

=head2 DBIx::Simple::Result

    @columns = $result->columns

    $result->into($foo, $bar, $baz)
    $row = $result->fetch

    @row = $result->list      @rows = $result->flat
    $row = $result->array     @rows = $result->arrays
    $row = $result->hash      @rows = $result->hashes
    @row = $result->kv_list   @rows = $result->kv_flat
    $row = $result->kv_array  @rows = $result->kv_arrays
    $obj = $result->object    @objs = $result->objects

    %map = $result->map              %grouped = $result->group
    %map = $result->map_hashes(...)  %grouped = $result->group_hashes(...)
    %map = $result->map_arrays(...)  %grouped = $result->group_arrays(...)

    $rows = $result->rows