While the OP specified that the second string is always the shortest, I wanted one that worked without that restriction:

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

sub zipA {
    my( $str1, $str2 ) = @_;
    $str1 =~ s/.\K/ substr $str2, 0, 1, ''/gesr;
}

sub zipB {
    no warnings qw/ uninitialized /;
    my( $a, $b ) = @_;
    my @a1 = split( '', $a );
    my @a2 = split( '', $b );
    return join'', zip @a1, @a2;
}

sub zipC($$){
   my( $n, $a, $b ) = ( 1, @_ );
   substr( $a, $n, 0, $_), $n += 2 for split '', $b;
   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;
}


sub zipD {
    my ($str1, $str2) = @_;
    for (0 .. length $str2) {
        substr $str1, $_ * 2 + 1, 0, substr $str2, $_, 1;
    }
    return $str1;
}

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

my (%tests,%results);
for my $T (qw(A B C D R)) {
    $tests{$T.'a'} = "my \$z = zip$T( \$A, \$B )";
    $tests{$T.'b'} = "my \$z = zip$T( \$B, \$A )";
    my $a = eval($tests{$T.'a'});
    my $b = eval($tests{$T.'b'});
}

my %R = ( a=>eval $tests{Ba}, b=>eval $tests{Bb} );
print "Expected: a=<$R{a}>, b=<$R{b}>";

for my $test (sort keys %tests) {
    no warnings 'uninitialized';
    my $S = eval $tests{$test};
    my $R = $R{substr($test,1,1)};
    if ($R ne $S) {
        print "test $test failed: <$S>";
        delete $tests{$test};
    }
}

cmpthese -1, \%tests;
__END__
$ perl 1133865.pl
Expected: a=<AaBbCcDdEeFGHIJ>, b=<aAbBcCdDeEFGHIJ>
test Ab failed: <aAbBcCdDeE>
test Cb failed: <>
test Db failed: <>
       Rate   Bb   Ba   Aa   Rb   Ra   Ca   Da
Bb 105326/s   --   0% -62% -69% -69% -81% -86%
Ba 105326/s   0%   -- -62% -69% -69% -81% -86%
Aa 276648/s 163% 163%   -- -18% -19% -50% -62%
Rb 336364/s 219% 219%  22%   --  -1% -39% -54%
Ra 339856/s 223% 223%  23%   1%   -- -39% -54%
Ca 553781/s 426% 426% 100%  65%  63%   -- -25%
Da 735965/s 599% 599% 166% 119% 117%  33%   --
[download]

So I have the fastest one that works without that restriction. (Prediction, someone else will hold that title within 20 minutes......)

...roboticus

When your only tool is a hammer, all problems look like your thumb.

#! 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]

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

I'm with torvalds on this Agile (and TDD) debunked I told'em LLVM was the way to go. But did they listen!

BrowserUk:

When I saw your original version, I did basically the same thing (swap strings to make the shorter one last). The only problem is that it flips the order of the alternating characters--I expect the first argument to provide the first character, the second argument to provide the second, etc.

I tried a couple quick hacks on yours (and kcotts) version to make it work the way I wanted, but when I didn't get it quickly, I punted. My quick hacks caused the strings to truncate when I was munging with substr on the left because it seems that I can't count properly today--I got bit several times by fencepost errors. For example, one of my attempts was to use zipC and change the starting value of $n based on which string was shorter, but had no luck--nor patience.

You can see what I mean if you fix line 25:

$ cat 1133959.pl
#! perl -slw
use strict;
   . . . snip . . .
print zipD( $A, $B ), zipD( $B, $A );
print zipR( $A, $B ), zipR( $B, $A );
   . . . snip . . .
$ perl 1133959.pl
AaBbCcDdEeFGHIJAaBbCcDdEeFGHIJ
AaBbCcDdEeFGHIJaAbBcCdDeEFGHIJ
       Rate   rR   Rr   Dd   dD
rR 327095/s   --  -2% -55% -55%
Rr 334881/s   2%   -- -54% -54%
Dd 720854/s 120% 115%   --  -0%
dD 721504/s 121% 115%   0%   --
[download]

...roboticus

When your only tool is a hammer, all problems look like your thumb.

Oz leading the world.