#! perl -slw
use strict;
use Benchmark qw[ cmpthese ];
use List::MoreUtils qw[ zip ];

sub zipD($$) {
    my( $a, $b ) =  length( $_[0] ) < length( $_[1] ) ? @_[ 1, 0 ] : @
+_[ 0, 1 ];
    substr( $a, $_*2+1, 0, substr( $b, $_, 1 ) ) for 0 .. length( $b )
+ -1;
    return $a;
}

sub zipR {
    my ($s1, $s2) = @_;
    my ($ls1, $ls2, $l, $tmp) = (length($s1), length($s2));
    $l = $ls1<$ls2 ? $ls1 : $ls2;
    $tmp = join("", map{substr($s1,$_,1), substr($s2,$_,1)} 0 .. $l-1)
         . substr($l==$ls2 ? $s1 : $s2,$l);
    return $tmp;
}

our $A = 'ABCDEFGHIJ';
our $B = 'abcde';

print zipD( $A, $B ), zipD( $B, $A );
print zipR( $A, $B ), zipD( $B, $A );

cmpthese -1, {
    Dd => q[ my $zipped = zipD( $A, $B ); ],
    Rr => q[ my $zipped = zipR( $A, $B ); ],
    dD => q[ my $zipped = zipD( $B, $A ); ],
    rR => q[ my $zipped = zipR( $B, $A ); ],
};

__END__
C:\test>1133857.pl
AaBbCcDdEeFGHIJAaBbCcDdEeFGHIJ
AaBbCcDdEeFGHIJAaBbCcDdEeFGHIJ
       Rate   Rr   rR   dD   Dd
Rr  82878/s   --  -1% -43% -44%
rR  83720/s   1%   -- -42% -44%
dD 145211/s  75%  73%   --  -2%
Dd 148473/s  79%  77%   2%   --
[download]