#!/usr/local/bin/perl -s

use strict;
use warnings;

#---------------------------------------------------------------------
# modules:

use Fcntl qw(:DEFAULT :flock);
use SDBM_File;
use FlatFile::DataStore;
use Math::Int2Base qw( base_chars int2base base2int );

#---------------------------------------------------------------------
# parameters

our( $from_dir, $from_name, $to_dir, $to_name );

# testing ...
$from_dir = '.';             $to_dir   = '.';
$from_name = 'example';      $to_name   = 'example2';

#---------------------------------------------------------------------
# main

# start with new datastore objects

my $from_ds = FlatFile::DataStore->new( {
    dir  => $from_dir,
    name => $from_name,
    } );

my $to_ds   = FlatFile::DataStore->new( {
    dir  => $to_dir,
    name => $to_name,
    } );

validate( $from_ds         );
migrate ( $from_ds, $to_ds );
validate( $to_ds           );
# compare ( $from_ds, $to_ds );

#---------------------------------------------------------------------

=for comment

 1. - for each keynum in name.key file (each current record)
      - get the history
      - for each preamble in the history
        - seen{ preamble }++ (name.tmp.seen dbm file)
        - write to name.tmp.history
          - transnum keynum status [date reclen user]?
 2. - for each record in name.n.dat files (each transaction)
      - die "seen too many times" if seen{ preamble }++ > 1
      - write to name.tmp.transactions
        - transnum keynum status [date reclen user]?
      - if read line from name.md5
        - compare transnum keynum user md5--die if not equal
      - else write to name.md5
        - transnum keynum user md5 (of record data) [date reclen]?

 result:
     name.tmp.seen dbm file(s)       - of no use after step 2.
     name.tmp.history flat file      - can compare to new after migrate
                                           of no use after that
     name.tmp.transactions flat file - can compare to new after migrate
                                           of no use after that
     name.md5 [sha]?                 - can compare to new after migrate
                                           keep around for next validation

 Note: we plan to add optional 'digest' preamble field for one of
       crc, md5, sha  (of record data)

=cut

{ my $seenfile;
sub validate {
    my( $ds ) = @_;

    my $name = $ds->name();
    my $crud = $ds->crud();
    my %status = map { $crud->{$_} => $_ } keys %$crud;

    $seenfile = "$name.tmp.seen";

    my %seen;
    tie( %seen, "SDBM_File", $seenfile, O_RDWR|O_CREAT, 0666 )
        or die qq/Couldn't tie file $seenfile: $!/;

    my $histfile = "$name.tmp.history";
    open my $histfh, '>', $histfile or die qq/Can't open "$histfile": $!/;
    flock $histfh, LOCK_EX          or die qq/Can't lock "$histfile": $!/;

    my $keyfile = $ds->keyfile();
    my $lastkey = $ds->lastkeynum(); 

    for my $keynum ( 0 .. $lastkey ) {
        my @history = $ds->history( $keynum );
        for my $rec ( @history ) {

            my $string = $rec->string();  # preamble string
            die qq/Seen $string too many times/ if $seen{ $string }++;

            my $transnum  = $rec->transnum();
            my $keynum    = $rec->keynum();
            my $status    = $status{ $rec->indicator() };
            my $reclen    = $rec->reclen();
            print $histfh "$transnum $keynum $status $reclen\n";
        }
    }
    close $histfh;

    # get some magic numbers

    my $uri         = $ds->uri();
    my $fnumlen  = $ds->fnumlen();
    my $recsep      = $ds->recsep;
    my $recseplen   = length( $recsep );
    my $preamblelen = $ds->preamblelen();

    my $create = $crud->{'create'};  # these are single ascii chars
    my $oldupd = $crud->{'oldupd'};
    my $update = $crud->{'update'};
    my $olddel = $crud->{'olddel'};
    my $delete = $crud->{'delete'};

    my $fnumbase = $ds->fnumbase();
    my @files       = $ds->all_datafiles();
    my $this        = 0;  # zero in any base

    my $translen    = $ds->translen();
    my $transbase   = $ds->transbase();
    my $transnum    = int2base( 1, $transbase, $translen );

    my $transfile = "$name.tmp.transactions";
    open my $transfh, '>', $transfile or die qq/Can't open "$transfile": $!/;
    flock $transfh, LOCK_EX           or die qq/Can't lock "$transfile": $!/;

    my $md5file = "$name.md5";
    my $md5fh   = locked_for_write( $md5file );
    my $md5size = -s $md5file;
    my $md5pos  = 0;

    my $last_keynum = -1;  # to be less than 0

    for my $datafile ( @files ) {

        my $filesize = -s $datafile;
        my $fh       = locked_for_read( $datafile );

        my $seekpos = 0;

        my %pending_deletes;

        RECORD: while(1) {

            my $rec       = $ds->read_record( $fh, $seekpos );
            my $transnum  = $rec->transnum();
            my $keynum    = $rec->keynum();
            my $reclen    = $rec->reclen();
            my $data_ref  = $rec->data();
            my $status    = $status{ $rec->indicator() };
            my $string    = $rec->string();  # preamble string
            die qq/Seen $string too many times/ if $seen{ $string }++ > 1;

            print $transfh "$transnum $keynum $status $reclen\n";
            # XXX temporarily using reclen for md5
            my $md5out = "$transnum $keynum $reclen $reclen\n";
            my $len = length( $md5out );
            if( $md5pos < $md5size ) {
                my $md5line = $ds->read_bytes( $md5fh, $md5pos, $len );
                die qq/Mismatched md5 lines/ unless $md5line eq $md5out;
            }
            else {
                $ds->write_bytes( $md5fh, $md5pos, $md5out );
            }
            $md5pos += $len;

            $seekpos += $preamblelen + $reclen;
            my $sentinel = $ds->read_bytes( $fh, $seekpos, $recseplen );

            die qq/Expected a recsep but got: "$sentinel" (at byte "$seekpos" in "$datafile")/
                unless $sentinel eq $recsep;

            $seekpos += $recseplen;

            last RECORD if $seekpos >= $filesize;
        }
    }
    close $transfh;
    untie %seen;
}

END {
    if( $seenfile ) {
        for( "$seenfile.dir", "$seenfile.pag" ) {
            unlink or die qq/Can't delete $_: $!/;
        }
    }
}}

#---------------------------------------------------------------------
sub compare {
    my( $ds ) = @_;
}

#---------------------------------------------------------------------

=for comment

    data scanning procedure:

    read each data record in from_ds
      read first preamble
        get reclen, read record, skip recsep
        read next preamble
        repeat until end of file
    repeat for every datafile

=cut

sub migrate {
    my( $from_ds, $to_ds )= @_;  # datastore objects

    # check some fundamental constraints

    # XXX don't do it this way!
    my $from_count = $from_ds->howmany();  # should not be zero
    my $to_count   = $to_ds->howmany();    # should     be zero

    die qq/Can't migrate: "from" datastore empty?/
        unless $from_count;
    die qq/Can't migrate: "to" datastore not empty?/
        if $to_count;

    my $try = $to_ds->which_datafile( 1 );  # they start with 1

    die qq/Can't migrate: "$to_name" has a data file, e.g., "$try")/
        if -e $try;

    # get some magic numbers

    my $from_uri         = $from_ds->uri();
    my $from_fnumlen  = $from_ds->fnumlen();
    my $from_recsep      = $from_ds->recsep;
    my $from_recseplen   = length( $from_recsep );
    my $from_preamblelen = $from_ds->preamblelen();

    my $from_crud = $from_ds->crud();
    my $create    = $from_crud->{'create'};  # these are single ascii chars
    my $oldupd    = $from_crud->{'oldupd'};
    my $update    = $from_crud->{'update'};
    my $olddel    = $from_crud->{'olddel'};
    my $delete    = $from_crud->{'delete'};

    my $fnumlen  = $from_ds->fnumlen();
    my $fnumbase = $from_ds->fnumbase();
    my @files       = $from_ds->all_datafiles();
    my $this        = 0;  # zero in any base

    my $translen    = $from_ds->translen();
    my $transbase   = $from_ds->transbase();
    my $transnum    = int2base( 1, $transbase, $translen );

    my $last_keynum = -1;  # to be less than 0

    for my $datafile ( @files ) {

        my $filesize = -s $datafile;
        my $fh       = locked_for_read( $datafile );

        my $seekpos = 0;

        my %pending_deletes;

        RECORD: while(1) {

            my $from_rec       = $from_ds->read_record( $fh, $seekpos );
            my $keynum         = $from_rec->keynum();
            my $reclen         = $from_rec->reclen();
            my $from_data_ref  = $from_rec->data();
            my $from_user_data = $from_rec->user();

            # cases:                  pending
            # indicator:  keynum:     delete:       action:              because:
            # ----------  ----------  ------------  -------------------  ----------
            # create  +   always new                create               current
            # oldupd  #   new                       create               was +
            # oldupd  #   old         on, turn off  retrieve and delete  was -
            # oldupd  #   old                       retrieve and update  was =
            # update  =   always old                retrieve and update  current
            # olddel  *   new         turn on       create               was +
            # olddel  *   old         turn on       retrieve and update  was =
            # delete  -   always old  turn off      retrieve and delete  current


            for( $from_rec->indicator() ) {
                /[$create]/ && do { $to_ds->create( $from_data_ref, $from_user_data );
                                    last };
                /[$oldupd]/ && $keynum > $last_keynum  # new
                            && do { $to_ds->create( $from_data_ref, $from_user_data );
                                    last };
                /[$oldupd]/ && $pending_deletes{ $keynum }
                            && do { my $to_rec =
                                    $to_ds->retrieve( $keynum );
                                    $to_ds->delete( $to_rec, $from_data_ref, $from_user_data );
                                    delete $pending_deletes{ $keynum };
                                    last };
                /[$oldupd]/ && do { my $to_rec =
                                    $to_ds->retrieve( $keynum );
                                    $to_ds->update( $to_rec, $from_data_ref, $from_user_data );
                                    last };
                /[$update]/ && do { my $to_rec =
                                    $to_ds->retrieve( $keynum );
                                    $to_ds->update( $to_rec, $from_data_ref, $from_user_data );
                                    last };
                /[$olddel]/ && $keynum > $last_keynum  # new
                            && do { $to_ds->create( $from_data_ref, $from_user_data );
                                    ++$pending_deletes{ $keynum };
                                    last };
                /[$olddel]/ && do { my $to_rec =
                                    $to_ds->retrieve( $keynum );
                                    $to_ds->update( $to_rec, $from_data_ref, $from_user_data );
                                    ++$pending_deletes{ $keynum };
                                    last };
                /[$delete]/ && do { my $to_rec =
                                    $to_ds->retrieve( $keynum );
                                    $to_ds->delete( $to_rec, $from_data_ref, $from_user_data );
                                    delete $pending_deletes{ $keynum };
                                    last };
            }

            $last_keynum = $keynum if $keynum > $last_keynum;

            $seekpos += $from_preamblelen + $reclen;
            my $sentinel = $from_ds->read_bytes( $fh, $seekpos, $from_recseplen );

            die qq/Expected a recsep but got: "$sentinel" (at byte "$seekpos" in "$datafile")/
                unless $sentinel eq $from_recsep;

            $seekpos += $from_recseplen;

            last RECORD if $seekpos >= $filesize;
        }
    }
}

#---------------------------------------------------------------------
sub locked_for_read {
    my( $file ) = @_;

    my $fh;
    open $fh, '<', $file or die "Can't open $file: $!";
    flock $fh, LOCK_SH   or die "Can't lock $file: $!";
    binmode $fh;

    return $fh;
}

#---------------------------------------------------------------------
sub locked_for_write {
    my( $file ) = @_;

    my $fh;
    sysopen( $fh, $file, O_RDWR|O_CREAT ) or die "Can't open $file: $!";
    my $ofh = select( $fh ); $| = 1; select ( $ofh );
    flock $fh, LOCK_EX                    or die "Can't lock $file: $!";
    binmode $fh;

    return $fh;
}

__END__

