package Gtk2::Ex::DbLinker::DatasheetHelper;

use Gtk2::Ex::DbLinker::DbTools;
our $VERSION = $Gtk2::Ex::DbLinker::DbTools::VERSION;

=head1 NAME

Gtk2::Ex::DbLinker::DatasheetHelper - Common methods for Gtk2::Ex::DbLinker::Datasheet and Wx::Perl::DbLinker::Wxdatasheet

=head1 SYNOPSIS

See L<Gtk2::Ex::DbLinker::Datasheet> and L<Wx::Perl::DbLinker::Wxdatasheet>. The methods in this module are not supposed to be called directly.

=cut


use strict;
use warnings;
use Carp qw(confess);
use Data::Dumper;

use constant {
    UNCHANGED     => 0,
    CHANGED       => 1,
    INSERTED      => 2,
    DELETED       => 3,
    LOCKED        => 4,
    STATUS_COLUMN => 0
};

use constant STATUS_LAB => ( ' ', '!', '*', 'x', 'o' );

=head2 new

parameters:

=over

=item cols

Array ref of fields name

=item dman 

A xxxDataManager object

=item col_number

A code ref of a function returning the field position (0 based) from its name

=back

    $self->{ds_helper} = Gtk2::Ex::DbLinker::DatasheetHelper->new(
        cols       => $self->{cols},
        dman       => $self->{dman},
        col_number => \&{ $self->colnumber_from_name },

    );

=cut

sub new {
    my $class = shift;
    my %def   = ();
    my %arg   = ( ref $_[0] eq "HASH" ? ( %def, %{ $_[0] } ) : ( %def, @_ ) );
    my $self;
    @$self{ keys %arg } = values(%arg);

    $self->{log} = Log::Log4perl->get_logger(__PACKAGE__);
    $self->{log}->debug("new called");
     my %hcols = map { $_ => 1 } @{$self->{cols}};
    $self->{hcols} = \%hcols;
    bless $self, $class;
}

sub _has_more_row {
    my $self = shift;
    # $self->_next;
    return $self->{has_more_row};

}

sub _get_val {
    my $self = shift;
    my ( $row, $col, $name ) = @_;
    $self->{log}->debug("_get_val \n", Dumper $row);
    $self->{get_val}->( $row, $col, $name );

}

sub _set_val {
    my $self = shift;
    my ( $row, $col, $val ) = @_;
    $self->{log}->debug("_set_val row: ",  $row, " col: ", $col, " val: ", $val);
    $self->{set_val}->( $row, $col, $val );
}

sub _get_row {
    my $self = shift;
    $self->{iter};
}

sub _next {
    my $self = shift;
    my $iter = $self->{next}->( $self->{iter} );
    $self->{has_more_row} = ( defined $iter ? 1 : 0 );
    $self->{curr_row}++;
    $self->{iter} = $iter;

}

=head2 init

In a datasheet module, calls init to pass a list of code refs that will be used when apply is called.

Mandatory parameters: a list of function references, the keys are

=over

=item next

returning the next row. Parameter the current iterator or row number 

=item set_val

setting the value for a given row and column. Parameters are row and column number, value

=item get_val

returning the value for a given row and column. Parameters: row and column number

=item del_row

deleting a row. Parameter: row and column number

=item has_more_row

returning 1 or 0 if there are more rows after the curreont one. 

=item iter

the iterator or row position of the first row.

=back

    $self->{ds_helper}->init(
   	sig =>  $self->{changed_signal},
	sig_block => sub { $self->{log}->debug("sig_block"); $model->signal_handler_block($_[0])},
   	sig_unblock =>  sub { $model->signal_handler_unblock($_[0]) },
   	next =>  sub {$model->iter_next($_[0])},
   	get_val => sub {$self->{log}->debug("get_val col: ", $_[1]); 
                                my $x = $model->get($_[0], $_[1]); 
                                $self->{log}->debug("get_val found ",  $x); 
                                 return $x
                        },
   	set_val => sub {  $self->{log}->debug("set_val", $_[2]); $model->set($_[0], $_[1], $_[2])},
   	del_row =>  sub  { $model->remove($_[0]) },
   	has_more_row => sub { return ( defined $iter ? 1 : 0 )},
    	iter => $iter,

   );


=cut

sub init {
	my $self = shift;
	my %arg = (ref $_[0] eq "HASH" ? %$_[0] : (@_));
	my @given = keys %arg;
	my @needed = qw(next get_val set_val del_row has_more_row iter);
	  my %seen;    #find if some value from needed are not in arg
        %seen = map { $_ => $seen{$_}++ }  @given ;
	#$self->{log}->debug( Dumper @given);
	#$self->{log}->debug( Dumper %seen);
         foreach my $arg (@needed){ 
		 confess (__PACKAGE__ ,"init : ", $arg,  " keys with code ref is missing" ) unless (exists $seen{$arg}); 
	 }
	 #$self->{log}->debug( Dumper %seen);
	 @$self{@given} = values %arg;
	 $self->{curr_row}= 0;
	

}

=head2 apply

Call apply after init to transmit to the database via the datamanager, the changes (a row deletion, a row addition, a row modification) made in the datasheet

=cut

sub apply {
    my $self = shift;
    my $pkref = ( defined $_[0] ? $_[0] : undef );
    my @iters_to_remove;
     my @rowpos_to_remove;
    #my $row_pos = 0;
    my $row;
	$self->{log}->debug("apply called dman->row_count : ", $self->{dman}->row_count);
	$self->{log}->debug("pkref ", Dumper ($pkref)) if ($pkref);
    my @fields_to_save;
    if ($pkref) {
        my %seen;    #remove from cols the fields received in arg
        %seen = map { $_ => $seen{$_}++ } ( @{ $self->{cols} }, @{$pkref} );
        @fields_to_save = grep { $seen{$_} < 1 } keys %seen;
    } else {
        @fields_to_save = @{ $self->{cols} };
    }
    $self->{sig_block}->( $self->{sig} ) if ($self->{sig});
    while ( $self->_has_more_row ) {
        my $status = $self->_get_val( $self->_get_row, STATUS_COLUMN );
        $self->{dman}->set_row_pos( $self->{curr_row} );
        if ( $status == UNCHANGED || $status == LOCKED ) {
            $self->_next;
            next;
        }

        if ( $status == INSERTED ) {    # new row for the database
            $self->{dman}->new_row;
        }

        if ( $status == DELETED ) {
=for commwent
            if ( $self->{dman}->delete ) {
                $self->{log}->debug("deleting current row in dman");
            } else {
                $self->{log}->debug("Can't delete");
            }
=cut
            push @iters_to_remove, $self->_get_row;
	    push @rowpos_to_remove, $self->{curr_row};

        } else { #update, insert
            my $count_update;

            #for my $field ( @{$self->{fields}} )
            for my $name (@fields_to_save) {

                #my $name = $field->{name};

                # if ( $field->{name} ~~ @{$self->{cols}})
                if ( defined $self->{hcols}->{$name} ) {
			#die ref $self->{col_number};
			my $col =  $self->{col_number}->($name);
		
                    my $x = $self->_get_val( $self->_get_row, $col, $name);

                    # $model->get( $iter, $self->{colname_to_number}->{$name} );
                    $count_update++;
                    $self->{log}->debug( "Set dman field: " . $name . " row_pos " . $self->{curr_row}  . " value: " . ( $x ? $x : "undef" ) );
                    $self->{dman}->set_field( $name, $x );

                } else {
                    $self->{log}->debug( "apply : " . $name . " not found in " . join( " ", @{ $self->{cols} } ) );

                }

                if ($count_update) {
                    $self->{log}->debug("saving...");

                    #$row->save;
                    $self->{dman}->save;
                } else {
                    $self->{log}->debug("no field updated, not saving");
                }
            }    # for


            #$row_pos++;
            #$iter = $model->iter_next($iter);

        }    #else
	
         #replace the unchanged icon in the col 0 
	 #with Wx widget the row label is not delete with the row it stay for the row at pos i
	 #
         $self->_set_val( $self->_get_row, STATUS_COLUMN, UNCHANGED );

	$self->_next; 
    }    # while
  
    foreach my $i (@iters_to_remove) {
	#$self->{log}->debug("deleting in the datasheet and in the db row: ", $rowpos_to_remove[$i] );
        #$model->remove($iter);
	#$self->{log}->debug("iters ", Dumper (@iters_to_remove));
	#$self->{log}->debug("rowpos ", Dumper (@rowpos_to_remove));
	$self->{del_row}->($i);
	my $row_pos = shift @rowpos_to_remove;
	$self->{log}->debug("deleting in dman at row : ", $row_pos);
	$self->{dman}->set_row_pos($row_pos);
	$self->{dman}->delete;
    }

    $self->{sig_unblock}->( $self->{sig} ) if ($self->{sig});
}    # apply


1;

__END__

=head1 SUPPORT

Any Gk2::Ex::DbLinker questions or problems can be posted to me (rappazf) on my gmail account.  

The current state of the source can be extract using Mercurial from
L<http://sourceforge.net/projects/gtk2-ex-dblinker/>.

=head1 AUTHOR

FranE<ccedil>ois Rappaz <rappazf@gmail.com>

=head1 COPYRIGHT

Copyright (c) 2016 by F. Rappaz.  All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Gtk2::Ex::DbLinker::Datasheet> L<Wx::Perl::DbLinker::Wxdatasheet>.

=cut
