#!/usr/bin/perl

use 5.6.0;

use strict;
use warnings FATAL => 'all';

use Benchmark qw( cmpthese );

my $s1 = do_rand(0, 100_000);
my $s2 = do_rand(1, 100_000);

my $subs =  {
#    'split1'     => sub { my $s3 = split1( $s1, $s2 ) },
#    'substr1'    => sub { my $s3 = substr1( $s1, $s2 ) },
#    'kyle'       => sub { my $s3 = kyle( $s1, $s2 ) },
    'moritz'     => sub { my $s3 = moritz( $s1, $s2 ) },
#    'corion'     => sub { my $s3 = corion( $s1, $s2 ) },
    'ikegami_s'  => sub { my $s3 = ikegami_s( $s1, $s2 ) },
    'ikegami_tr' => sub { my $s3 = ikegami_tr( $s1, $s2 ) },
    'avar'       => sub { my $s3 = avar( $s1, $s2 ) },
    'avar2'      => sub { my $s3 = avar2( $s1, $s2 ) },
    'avar2_pos'  => sub { my $s3 = avar2_pos( $s1, $s2 ) },
    'avar2_pos_inplace'  => sub { avar2_pos_inplace( \$s1, $s2 ); $s1 },
    'mrm_1'      => sub { mrm_1( \$s1, $s2 ); $s1 },
#    'mrm_2'      => sub { mrm_2( \$s1, $s2 ); $s1 },
    'mrm_3'      => sub { mrm_3( \$s1, $s2 ); $s1 },
    'mrm_4'      => sub { mrm_4( \$s1, $s2 ); $s1 },
    'mrm_5'      => sub { mrm_5( \$s1, $s2 ); $s1 },
    'mrm_6'      => sub { mrm_6( \$s1, \$s2 ); $s1 },
};

cmpthese( -2, $subs );

use Test::More;

plan 'tests' => scalar keys %{$subs};

my $s3;
foreach my $subname ( keys %{$subs} ) {
    my $sub = $subs->{$subname};
    if ( defined $s3 ) {
	is( $sub->(), $s3, "$subname gets same value" );
    }
    else {
	$s3 = $sub->();
	ok( defined $s3, "$subname gets some value" );
    }
}

sub split1 {
    my ($s1, $s2) = @_;

    my @s1 = split //, $s1;
    my @s2 = split //, $s2;

    foreach my $idx ( 0 .. $#s1 ) { 
	if ( $s1[$idx] eq chr(0) ) { 
	    $s1[$idx] = $s2[$idx];
	} 
    } 

    return join '', @s1;
}

sub substr1 {
    my ($s1, $s2) = @_;

    for my $idx ( 0 .. length($s1) ) {
	if ( substr($s1,$idx,1) eq chr(0) ) {
	    substr($s1, $idx, 1) = substr($s2, $idx, 1);
	}
    } 

    return $s1;
} 

sub kyle {
    my ($s1, $s2) = @_;

    my $out = $s1;
    while ( $s1 =~ m/\000/g ) {
	my $pos = pos;
	substr( $out, $pos, 1 ) = substr( $s2, $pos, 1 );
    }

    return $out;
}

sub moritz {
    my ($s1, $s2) = @_;

    my $pos = 0;
    while ( -1 < ( $pos = index $s1, "\000", $pos ) ) {
	substr( $s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }

    return $s1;
}

sub ikegami_s {
    my ($s1, $s2) = @_;
    (my $mask = $s1) =~ s/[^\x00]/\xFF/g;
    return ($s1 & $mask) | ($s2 & ~$mask);
}

sub ikegami_tr {
   my ($s1, $s2) = @_;
   (my $mask = $s1) =~ tr/\x00/\xFF/c;
   return ($s1 & $mask) | ($s2 & ~$mask);
}

sub corion {
   my ($s1, $s2) = @_;

   my $ofs = 0;
   return join "", map { $ofs += length; $_ => substr $s2, $ofs++, 1 } split /\0/, $s1, -1;
}

sub avar {
    my ($s1, $s2) = @_;

    my $s3 = $s1;

    {
        use bytes;
        $s3 =~ s/(\0)/substr $s2, $+[0]-1, 1/eg;
    }

    $s3;
}


sub avar2 {
    my ($s1, $s2) = @_;

    use bytes;
    $s1 =~ s/(\0)/substr $s2, $+[0]-1, 1/eg;

    return $s1;
}

sub avar2_pos {
    my ($s1, $s2) = @_;

    use bytes;
    $s1 =~ s/\0/substr $s2, pos($s1), 1/eg;

    return $s1;
}

sub avar2_pos_inplace {
    my ($s1, $s2) = @_;

    use bytes;
    $$s1 =~ s/\0/substr $s2, pos($$s1), 1/eg;
}

sub mrm_1 {
    my ( $s1, $s2 ) = @_;
    # from [moritz]'s work
    use bytes;
    my $pos = 0;
    while ( -1 < ( $pos = index $$s1, "\x00", $pos ) ) {
        substr( $$s1, $pos, 1 ) = substr( $s2, $pos, 1 );
    }
}

sub mrm_3 {
    my ( $s1, $s2 ) = @_;
    # from moritz's, builds a separate loop of zeros
    use bytes;

    my @zeros = ();
    my $pos = 0;
    while ( -1 < ( $pos = index $$s1, "\x00", $pos ) ) {
        push @zeros, $pos;
    }
    for ( @zeros ) {
        substr( $$s1, $_, 1 ) = substr( $s2, $_, 1 );
    }
}

sub mrm_4 {
    # from [bart]'s vec()
    my ($s1, $s2) = @_;
    use bytes;

    my $pos = 0;
    while ( -1 < ( $pos = index $$s1, "\x00", $pos ) ) {
        vec( $$s1, $pos, 8 ) ||= vec( $s2, $pos, 8 );
    }
}

sub mrm_5 {
    # from moritz's, seeing if four-arg substr() is faster or slower than lvalue substr()
    my ( $s1, $s2 ) = @_;
    use bytes;
    my $pos = 0;
    while ( -1 < ( $pos = index $$s1, "\x00", $pos ) ) {
        substr( $$s1, $pos, 1, substr( $s2, $pos, 1 ) );
    }
}

sub mrm_6 {
    # from mrn_5, testing bytes::misc explicitly instead of importing
    # also in-place using of $s2
    my ( $s1, $s2 ) = @_;
    use bytes ();
    my $pos = 0;
    while ( -1 < ( $pos = bytes::index( $$s1, "\x00", $pos ) ) ) {
        bytes::substr( $$s1, $pos, 1, bytes::substr( $$s2, $pos, 1 ) );
    }
}


# This makes sure that $s1 has chr(0)'s in it and $s2 does not.
sub do_rand {
    my $min = shift;
    my $len = shift;
    my $n = "";
    for (1 .. $len)
    {
        $n .= chr( rand(255-$min)+$min );
    }
    return $n;
}

#sub do_rand {
#    my $n = (shift) ? int(rand(255)) : int(rand(254)) + 1;
#    return chr( $n );
#}

__END__