The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#===============================================================================
#
#  DESCRIPTION:  Collection with auto make crc checksum
#
#       AUTHOR:  Aliaksandr P. Zahatski, <zahatski@gmail.com>
#===============================================================================
=head1 NAME

 Collection::CrcColl - experimental class for collections 

=cut

package Collection::CrcColl;
use strict;
use warnings;
use String::CRC32;
use JSON::XS;
use Collection::AutoSQL;
our @ISA = qw(Collection::AutoSQL);

our $VERSION = '0.10';
sub raw2hex { lc unpack( "H*", shift ) }
sub hex2raw { pack( "H*", shift ) }

=head1 TYPES


varchar => string       strin
binary => hex2raw ( raw2hex)        BINARY
refhash => { var1=>'1', var2=>0}    string ('var1=0 , var=2')

=cut
sub _create {
    my ( $self, %arg ) = @_;
    my $table_name = $self->_table_name();
    my $field      = $self->_key_field;
    my $id         = $arg{$field} || die "Need key field $field when create";

    my $rec  = $self->before_save(\%arg);
    my @keys = keys %$rec;
    #prepare
    my $str =
        "INSERT INTO  $table_name ("
      . join( ",", @keys )
      . ") VALUES ("
      . join( ',' => qw/?/ x @keys ) . ")";
    $self->_query_dbh( $str, map { $rec->{$_} } @keys );
    return { $id => $self->fetch_one($id) };
}

sub _init {
    my $self = shift;
    my %args = @_;
    my $res  = $self->SUPER::_init(@_);
    return $res;
}

=head2 _expand_rules

Owerwrite method and add check _crc fields

=cut

sub _expand_rules {
    my $self     = shift;
    my @expanded = $self->SUPER::_expand_rules(@_);
    my @res      = ();
    my $fields   = $self->_fields;

    #converts mid to raws
    foreach my $group (@expanded) {
        my @group = ();
        foreach my $rec (@$group) {
            next unless ( $rec->{type} || '' ) eq 'binary';

            $_ = hex2raw($_) for @{ $rec->{values} };
        }
    }
    foreach my $group (@expanded) {
        my @group = ();
        foreach my $rec (@$group) {
            my $field_name     = $rec->{field};
            my $crc_field_name = $field_name . "_crc";
            unless ( exists $fields->{$crc_field_name} ) {
                push @group, $rec;
            }
            else {

                # expand to crc and field_name
                my $values = $rec->{'values'};
                my ($crcrec) = $self->SUPER::_expand_rules(
                    { $crc_field_name => [ map { crc32($_) } @$values ] } );
                push @group, @$crcrec, $rec;
            }
        }
        push @res, \@group;
    }
    @res;
}

=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;

    # group ids and add fill type of fields
    my @processed = $self->_expand_rules(@_);
    my @sql_or    = ();
    my @values    = ();
    foreach my $group (@processed) {
        my @sql_and = ();
        foreach my $rec (@$group) {

            my $values = [ @{ $rec->{'values'} } ];
            my $type   = $rec->{'type'};
            my $term   = $rec->{'term'};
            my $field  = $rec->{'field'};

            #construct query
            my $sql_term = $term;

            #this
            #
            # check type and = or like !
            #
            #
            my $values_sql;
            if ( scalar @$values > 1 ) {
                $values_sql = "(" . join( ',' => qw/?/ x @$values ) . ")";
                $sql_term = "in" if $sql_term eq '=';
            }
            else {
                $values_sql = "?";
            }
            push @values,  @$values;
            push @sql_and, "$field $sql_term $values_sql";
        }
        push @sql_or, "(" . join( " and ", @sql_and ) . ")";
    }
    return join( " or ", @sql_or ), @values;
}

sub after_load {
    my $self   = shift;
    my $fields = $self->_fields;
    my $rec = $_[0];
    my %res;
    while ( my ($key, $val)  =each %$rec)  {
        #key without type
        unless (exists $fields->{$key}) {
            $res{$key} = $val;
            next;
        }
        my $type = $fields->{$key};

        if ( $type eq 'binary' ) {
            $val = raw2hex( $val );
        }
        if ($type eq 'refhash' ) {
        # unpack string 'test_val=1,mod=0'
            $val ={ map { split/=/,$_ } split /,/, $val }; 
        }
         if ($type eq 'json' ) {
            unless ($val) {
                $val = {}
            } else {
                $val = decode_json($val)
            }
        }
       $res{$key} = $val;
    
    }
    return \%res;
}

sub before_save {
    my $self = shift;
    my $ref  = shift;

    my $fields = $self->_fields;
    my %res    = ();
    my %crced  = ();
    while ( my ( $key, $val ) = each %$ref ) {

        #skip crced
        next if exists $crced{$key};
        #key without type
        unless (exists $fields->{$key}) {
            $res{$key} = $val;
            next;
        }

        $val = hex2raw($val)
          if exists $fields->{$key} and $fields->{$key} eq 'binary';
        my $crc_field_name = $key . "_crc";
        if ( exists $fields->{$crc_field_name} ) {
            $crced{$crc_field_name} = $res{$crc_field_name} = crc32($val);
        }
        if ($fields->{$key} eq 'refhash' ) {
            $val={} unless ref($val);
            #serialize
            $val = join ","=> map {"$_=".$val->{$_}} keys %$val;
        }
        if ($fields->{$key} eq 'json' ) {
            $val={} unless ref($val);
            $val = encode_json($val);
        }
        $res{$key} = $val;
    }
    return \%res;
}

sub sub_ref {
    my $self = shift;
    if ( my $val = shift ) {
        $self->_sub_ref($val);
    }
    return $self->_sub_ref();
}

sub _fetch {
    my $self       = shift;
    my $dbh        = $self->_dbh();
    my $table_name = $self->_table_name();
    my $field      = $self->_key_field;
    my ( $where, @values ) = $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, @values );

    while ( my $rec = $qrt->fetchrow_hashref ) {
        my %hash = %{ $self->after_load($rec) };
        my $id   = $hash{$field};
        delete $hash{$field} if $self->_is_delete_key_field;
        $result->{$id} = \%hash;
    }
    $qrt->finish;
    return $result;
}

sub _delete {
    my $self = shift;
    return [] unless scalar @_;
    my @ids = @_;
    #add support for user defined query
    # $col->delete({field=>[232323]})

    my $user_query = ref($ids[0]) eq 'HASH' ? $ids[0] : '';
    #where
    my ( $where, @values ) =
      $self->_prepare_where( $user_query ? $user_query : { $self->_key_field => \@ids } );
    my $table_name = $self->_table_name();
    my $str        = "DELETE FROM $table_name WHERE $where";
    $self->_query_dbh( $str, @values );
    return \@_;
}

sub _store {
    my ( $self, $ref ) = @_;
    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);

        #where
        my ( $where, @values ) = $self->_prepare_where( { $field => $key } );
        foreach my $val (@rows) {
            my @records =
              map { [ $_, defined( $val->{$_} ) ? $val->{$_} : '' ] }
              keys %$val;
            my $query =
                "UPDATE $table_name SET "
              . join( ",", map { qq!$_->[0]=\?! } @records )
              . " where $where";
            $self->_query_dbh( $query, map ( $_->[1], @records ), @values );
        }    #foreach
    }    #while
}

1;