The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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(<SQL where  expression>)

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 <query hash>

return <where>  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, <zag@cpan.org>

=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