lib/A3C/SQL.pm

package A3C::SQL;

use strict;
use warnings;

use base qw(Jifty::Object Class::Accessor::Fast);
__PACKAGE__->mk_accessors( qw(query arguments dbh encoding duration) );

use Data::Dump qw/dump/;
use Time::HiRes qw/time/;

=head1 NAME

A3C::SQL

=head1 DESCRIPTION

Issue SQL queries

=head1 METHODS

=head2 new

  my $sql = A3C::SQL->new({ query => 'select now()' });

As a alternative, if you don't want to use Jifty's database handle,
specify it like this:

  my $sql = A3C::SQL->new({
        query => 'select now()',
        dbh => $my_dbh,
        encoding => 'UTF-8',
  });

Mungling with C<encoding> is rearly needed, especially if using recent C<DBD::Pg> as driver.

=head2 sth

Execute query and return statement handle. Ususally you don't have to call this manually.

=cut

sub sth {
        my $self = shift;
        if ( ! $self->{_sth} ) {
                my $dbh = $self->dbh || Jifty->handle->dbh;
                my $sth = $dbh->prepare( $self->query ) or $dbh->errstr;
                my $t = time();
                if ( $self->arguments ) {
                        Jifty->log->debug( $self->sql . ' arguments: ' . dump( $self->arguments ) );
                        $sth->execute( $self->arguments ) or die $dbh->errstr;
                } else {
                        $sth->execute or die $dbh->errstr;
                }
                $self->duration( time() - $t );
                $self->{_sth} = $sth;
        }

        return $self->{_sth};
}

=head2 next

  while ( my $row = $sql->next ) {
        print $row->now;
  }

=cut

sub next {
        my $self = shift;
        my $row = $self->sth->fetchrow_hashref;
        return unless defined $row;
#       $self->log->debug( dump( $row ) );
        return A3C::SQL::row->new( $row, $self->encoding );
}

=head2 count

  print $sql->count;

=cut

sub count {
        my $self = shift;
        return $self->sth->rows;
}

=head1 HELPERS

This helpers are accessor to L<DBI>

=head2 _column_names

  my @columns = $sql->_column_names;

=cut

sub _column_names {
        my $self = shift;
        return @{ $self->sth->{NAME} };
}

package A3C::SQL::row;

use Encode qw/decode/;
use Data::Dump qw/dump/;
use base qw/Jifty::Object/;

our $AUTOLOAD;

sub new {
        my $that  = shift;
        my $class = ref($that) || $that;
        my $self = shift;
        bless $self, $class;
        $self->{__encoding} = shift || 'UTF-8';
        return $self;
}  

sub AUTOLOAD {
        my $self = shift;
        my $type = ref($self) or die "$self is not an object";
        my $name = lc($AUTOLOAD);       # DBI lowercase columns so we do same for accessors
        $name =~ s/.*://;
        my $v = $self->{$name};
        Jifty->log->error("SQL: $name doesn't exist") unless defined $v;
        if ( ! Encode::is_utf8( $v ) ) {
                eval { $v = decode( $self->{__encoding}, $self->{$name} ) };
                if ( $@ ) {
                        warn "## column $name can't decode ",dump( $self->{$name} );
                        $v = $self->{$name};
                }
        }
        return $v;
}

sub DESTROY {}

1;
1	dpavlin	78	package A3C::SQL;
2
3			use strict;
4			use warnings;
5
6	dpavlin	145	use base qw(Jifty::Object Class::Accessor::Fast);
7	dpavlin	220	__PACKAGE__->mk_accessors( qw(query arguments dbh encoding duration) );
8	dpavlin	145
9			use Data::Dump qw/dump/;
10	dpavlin	220	use Time::HiRes qw/time/;
11	dpavlin	145
12	dpavlin	78	=head1 NAME
13
14			A3C::SQL
15
16			=head1 DESCRIPTION
17
18			Issue SQL queries
19
20			=head1 METHODS
21
22			=head2 new
23
24			my $sql = A3C::SQL->new({ query => 'select now()' });
25
26	dpavlin	145	As a alternative, if you don't want to use Jifty's database handle,
27			specify it like this:
28	dpavlin	78
29	dpavlin	145	my $sql = A3C::SQL->new({
30			query => 'select now()',
31			dbh => $my_dbh,
32	dpavlin	162	encoding => 'UTF-8',
33	dpavlin	145	});
34	dpavlin	78
35	dpavlin	218	Mungling with C<encoding> is rearly needed, especially if using recent C<DBD::Pg> as driver.
36
37	dpavlin	78	=head2 sth
38
39			Execute query and return statement handle. Ususally you don't have to call this manually.
40
41			=cut
42
43			sub sth {
44			my $self = shift;
45			if ( ! $self->{_sth} ) {
46	dpavlin	145	my $dbh = $self->dbh \|\| Jifty->handle->dbh;
47	dpavlin	78	my $sth = $dbh->prepare( $self->query ) or $dbh->errstr;
48	dpavlin	220	my $t = time();
49	dpavlin	78	if ( $self->arguments ) {
50			Jifty->log->debug( $self->sql . ' arguments: ' . dump( $self->arguments ) );
51	dpavlin	160	$sth->execute( $self->arguments ) or die $dbh->errstr;
52	dpavlin	78	} else {
53	dpavlin	160	$sth->execute or die $dbh->errstr;
54	dpavlin	78	}
55	dpavlin	220	$self->duration( time() - $t );
56	dpavlin	78	$self->{_sth} = $sth;
57			}
58
59			return $self->{_sth};
60			}
61
62			=head2 next
63
64			while ( my $row = $sql->next ) {
65			print $row->now;
66			}
67
68			=cut
69
70			sub next {
71			my $self = shift;
72			my $row = $self->sth->fetchrow_hashref;
73			return unless defined $row;
74	dpavlin	233	# $self->log->debug( dump( $row ) );
75	dpavlin	162	return A3C::SQL::row->new( $row, $self->encoding );
76	dpavlin	78	}
77
78			=head2 count
79
80			print $sql->count;
81
82			=cut
83
84			sub count {
85			my $self = shift;
86			return $self->sth->rows;
87			}
88
89	dpavlin	159	=head1 HELPERS
90
91			This helpers are accessor to L<DBI>
92
93			=head2 _column_names
94
95			my @columns = $sql->_column_names;
96
97			=cut
98
99			sub _column_names {
100			my $self = shift;
101			return @{ $self->sth->{NAME} };
102			}
103
104	dpavlin	78	package A3C::SQL::row;
105
106			use Encode qw/decode/;
107			use Data::Dump qw/dump/;
108	dpavlin	159	use base qw/Jifty::Object/;
109	dpavlin	78
110			our $AUTOLOAD;
111
112			sub new {
113			my $that = shift;
114			my $class = ref($that) \|\| $that;
115			my $self = shift;
116			bless $self, $class;
117	dpavlin	162	$self->{__encoding} = shift \|\| 'UTF-8';
118	dpavlin	78	return $self;
119			}
120
121			sub AUTOLOAD {
122			my $self = shift;
123			my $type = ref($self) or die "$self is not an object";
124	dpavlin	233	my $name = lc($AUTOLOAD); # DBI lowercase columns so we do same for accessors
125	dpavlin	78	$name =~ s/.*://;
126	dpavlin	218	my $v = $self->{$name};
127			Jifty->log->error("SQL: $name doesn't exist") unless defined $v;
128			if ( ! Encode::is_utf8( $v ) ) {
129			eval { $v = decode( $self->{__encoding}, $self->{$name} ) };
130			if ( $@ ) {
131			warn "## column $name can't decode ",dump( $self->{$name} );
132			$v = $self->{$name};
133			}
134			}
135			return $v;
136	dpavlin	78	}
137
138	dpavlin	82	sub DESTROY {}
139
140	dpavlin	78	1;