package Objects::Collection::AutoSQL; =head1 NAME Objects::Collection::AutoSQL - class for collections of data, stored in database. =head1 SYNOPSIS use Objects::Collection::AutoSQL; my $metaobj = new Objects::Collection::AutoSQL:: dbh => $dbh, #database connect table => 'metadata', #table name field=> 'mid', #key field (IDs), usually primary,autoincrement cut_key =>1, #delete field mid from readed records, #or delete_key=>1 sub_ref => #callback for create objects for readed records sub { my $id = shift; new MyObject:: shift } =head1 DESCRIPTION Provide simply access to records, with unique field. For exampe: HAVE mysql table: mysql> \u orders mysql> select * from beers; +-----+--------+-----------+ | bid | bcount | bname | +-----+--------+-----------+ | 1 | 1 | heineken | | 2 | 1 | broadside | | 3 | 2 | tiger | | 4 | 2 | castel | | 5 | 3 | karhu | +-----+--------+-----------+ 5 rows in set (0.00 sec) my $beers = new Objects::Collection::AutoSQL:: dbh => $dbh, #database connect table => 'beers', #table name field => 'bid', #key field (IDs), usually primary,autoincrement cut_key => 1; #delete field 'bid' from readed records, my $heineken = $beers->fetch_object(1); #SELECT * FROM beers WHERE bid in (1) print Dumper($heineken); ... $VAR1 = { 'bcount' => '1', 'bname' => 'heineken' }; ... $heineken->{bcount}++; my $karhu = $beers->fetch_object(5); #SELECT * FROM beers WHERE bid in (5) $karhu->{bcount}++; $beers->store_changed; #UPDATE beers SET bcount='2',bname='heineken' where bid=1 #UPDATE beers SET bcount='4',bname='karhu' where bid=5 my $hash = $beers->fetch_objects({bcount=>[4,1]}); #SELECT * FROM beers WHERE ( bcount in (4,1) ) print Dumper($hash); ... $VAR1 = { '2' => { 'bcount' => '1', 'bname' => 'broadside' }, '5' => { 'bcount' => '4', 'bname' => 'karhu' } }; ... =head1 METHODS =cut use strict; use warnings; use Data::Dumper; use Carp; use Objects::Collection; use Objects::Collection::Base; use Objects::Collection::ActiveRecord; @Objects::Collection::AutoSQL::ISA = qw(Objects::Collection); $Objects::Collection::AutoSQL::VERSION = '0.02'; attributes qw( _dbh _table_name _key_field _is_delete_key_field _sub_ref); sub _init { my $self = shift; my %arg = @_; $self->_dbh( $arg{dbh} ); $self->_table_name( $arg{table} ); $self->_key_field( $arg{field} ); $self->_is_delete_key_field( $arg{delete_key} || $arg{cut_key} ); $self->_sub_ref( $arg{sub_ref} ); $self->SUPER::_init(@_); } =head2 get_dbh Return current $dbh. =cut sub get_dbh { return $_[0]->_dbh; } =head2 get_ids_where() Return ref to ARRAY of readed IDs. =cut sub get_ids_where { my $self = shift; my $where = shift || return []; my $dbh = $self->_dbh(); my $table_name = $self->_table_name(); my $field = $self->_key_field; my $query = "SELECT $field FROM $table_name WHERE $where"; return ( $dbh->selectcol_arrayref($query) || [] ); } sub after_load { my $self = shift; return $_[0]; } sub before_save { my $self = shift; return $_[0]; } sub _query_dbh { my $self = shift; my $query = shift; my $dbh = $self->_dbh; my $sth = $dbh->prepare($query) or croak $dbh::errstr. "\nSQL: $query"; $sth->execute or croak $dbh::errstr. "\nSQL: $query"; return $sth; } sub _store { my ( $self, $ref ) = @_; my $dbh = $self->_dbh(); my $table_name = $self->_table_name(); my $field = $self->_key_field; while ( my ( $key, $rec_ref ) = each %$ref ) { my $tmp_val = ref($rec_ref) eq 'HASH' ? $rec_ref : $rec_ref->_get_attr; my $prepared = $self->before_save($tmp_val); my @rows = ref($prepared) eq 'ARRAY' ? @$prepared : ($prepared); foreach my $val (@rows) { my @records = map { [ $_, $dbh->quote( defined( $val->{$_} ) ? $val->{$_} : '' ) ] } keys %$val; my $query = "UPDATE $table_name SET " . join( ",", map { qq!$_->[0]=$_->[1]! } @records ) . " where $field=$key"; $self->_query_dbh($query); } #foreach } #while } =head2 _prepare_where return expression or undef else =cut sub _prepare_where { my $self = shift; my $dbh = $self->_dbh(); my $field = $self->_key_field; my @extra_id; my @docs; foreach (@_) { if ( defined $_->{id} ) { push @docs, $_->{id}; } else { push @extra_id, $_; } } my @add_where; push @add_where, "$field in (" . join( "," => @docs ) . ")" if @docs; foreach my $exp (@extra_id) { my @and_where; while ( my ( $key, $val ) = each %$exp ) { my $vals = join ",", map { /^\d+$/ ? $_ : $dbh->quote($_) } ( ref($val) ? @$val : ($val) ); if ( $key =~ s%([<>])%% ) { push @and_where, qq!$key $1 $vals!; } else { push @and_where, qq!$key in ($vals)!; } } push @add_where, " ( " . join( " and ", @and_where ) . " ) " if @and_where; } my $extr_where = join " or ", @add_where if @add_where; return $extr_where; } sub _fetch { my $self = shift; my $dbh = $self->_dbh(); my $table_name = $self->_table_name(); my $field = $self->_key_field; my $where = $self->_prepare_where(@_); return {} unless $where; my $str = "SELECT * FROM $table_name WHERE $where"; my $result = {}; my %keys_hash; my $qrt = $self->_query_dbh($str); while ( my $rec = $qrt->fetchrow_hashref ) { my %hash = %$rec; my $id = $hash{$field}; delete $hash{$field} if $self->_is_delete_key_field; $result->{$id} = $self->after_load( \%hash ); } $qrt->finish; return $result; } sub _create { my ( $self, %arg ) = @_; my $table_name = $self->_table_name(); my $id; my $field = $self->_key_field; if ( $self->_is_delete_key_field ) { $id = $arg{$field}; delete $arg{$field}; } my @keys = keys %arg; my $str = "INSERT INTO $table_name (" . join( ",", @keys ) . ") VALUES (" . join( ",", map { $self->_dbh()->quote( defined($_) ? $_ : '' ) } map { $arg{$_} } @keys ) . ")"; $self->_query_dbh($str); my $inserted_id; if ( !$self->_is_delete_key_field && exists $arg{$field} ) { $inserted_id = $arg{$field}; } else { $inserted_id = $self->_dbh->last_insert_id( '', '', $table_name, $field ) || $self->GetLastID(); } return { $inserted_id => $self->fetch_object($inserted_id) }; } sub _delete { my $self = shift; my $table_name = $self->_table_name(); my $field = $self->_key_field; return [] unless scalar @_; my $str = "DELETE FROM $table_name WHERE $field IN (" . join( ",", map { $_->{id} } @_ ) . ")"; $self->_query_dbh($str); return \@_; } sub _fetch_ids { my $self = shift; my $dbh = $self->_dbh(); my $table_name = $self->_table_name(); my $field = $self->_key_field; my $query = "SELECT $field FROM $table_name"; return $dbh->selectcol_arrayref($query); } sub _prepare_record { my ( $self, $key, $ref ) = @_; my %hash; tie %hash, 'Objects::Collection::ActiveRecord', hash => $ref; if ( ref( $self->_sub_ref ) eq 'CODE' ) { return $self->_sub_ref()->( $key, \%hash ); } return \%hash; } # overlap for support get by query sub fetch_object { my $self = shift; my ($obj) = values %{ $self->fetch_objects(@_) }; $obj; } sub GetLastID { my $self = shift; my $table_name = $self->_table_name(); my $field = $self->_key_field; my $res = $self->_query_dbh("select max($field)as res from $table_name") ->fetchrow_hashref; return $res->{res}; } 1; __END__ =head1 SEE ALSO Objects::Collection::ActiveRecord, Objects::Collection, README =head1 AUTHOR Zahatski Aliaksandr, =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2007 by Zahatski Aliaksandr This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut