package Collection::AutoSQLnotUnique;
=head1 NAME
Collection::AutoSQLnotUnique - class for collections of data, stored in database.
=head1 SYNOPSIS
use Collection::AutoSQL;
my $metaobj = new Collection::AutoSQL::
dbh => $dbh, #database connect
table => 'metadata', #table name
field=> 'mid', #key field (IDs)
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 not unique key field.
=cut
use Collection::AutoSQL;
use Data::Dumper;
use Carp;
use strict;
use warnings;
our @ISA = qw(Collection::AutoSQL);
our $VERSION = '0.01';
#overwrite this method !
sub after_load {
my $self = shift;
return $_[0]
}
#overwrite this method !
sub before_save {
my $self = shift;
return $_[0]
}
sub _fetch {
my $self = shift;
my $dbh = $self->_dbh;
my $table_name = $self->_table_name();
my $field = $self->_key_field;
my @extra_id;
my @docs;
foreach (@_) {
ref $_ ? push @extra_id, $_ : push @docs, $_
}
my @add_where;
if (
@extra_id
and
my $ext_where = $self->_prepare_where(@extra_id)
) {
push @docs, @{ $self->get_ids_where($ext_where) };
return $self->_fetch( @docs)
} else {
return {} unless @docs;
my $where = $self->_prepare_where(@docs);
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;
push @{ $result->{$id} }, \%hash;
}
$qrt->finish;
#prepare result records
while ( my ($key, $val) = each %$result ) {
my $val = $result->{$key};
$result->{$key} = $self->after_load(ref $val ? @$val : $val);
}
return { map { $_ => $result->{$_}||{} } ( keys %$result, @docs ) };
}
}
#=head1 _create - create record
#use:
# $obj->create(234=>{attr1=>1,attr2=>'value'},)
#=cut
sub _create {
my $self = shift;
my %args = @_;
return {} unless %args;
my $coll_ref = $self->_obj_cache();
my %created;
while ( my ($id, $attr_hash_ref) = each %args ) {
next if exists $coll_ref->{$id};
my $res = $self->_prepare_record($id,$attr_hash_ref);
$coll_ref->{$id} = $res;
$created{$id}++
}
return \%created
}
sub _store {
my ( $self, $ref ) = @_;
my $dbh = $self->_dbh();
my $table_name = $self->_table_name();
my $field = $self->_key_field;
my @id2del = keys %$ref;
$self->_delete(@id2del);
while ( my ( $key, $rec_ref ) = each %$ref ) {
my $tmp_val = ref($rec_ref) eq 'HASH' ? $rec_ref : $rec_ref->_get_attr;
#add key for save
$tmp_val->{$field} = $key;
my $prepared = $self->before_save($tmp_val);
my @rows = ref($prepared) eq 'ARRAY' ? @$prepared : ($prepared);
foreach my $val ( @rows ) {
my @fields = keys %$val;
my $exex_opt = join ",", map { '?' } (@fields);
my $sth = $dbh->prepare("INSERT INTO $table_name ( ".join(',',@fields).") VALUES ( $exex_opt )");
$sth->execute(@$val{ @fields });
}
}
}
sub list_ids {
my $self = shift;
# return array ref by default
return $self->_fetch_ids unless scalar(@_);
return $self->SUPER::list_ids(@_, uniq=>1);
}
1;
__END__
=head1 SEE ALSO
Collection::AutoSQL, Collection, README
=head1 AUTHOR
Zahatski Aliaksandr, <zag@cpan.org>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005-2008 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