@array = map { $_ eq "c" ? ("c","f") : $_ } @array
[download]

You could easily fix that by adding a counter:

@array = map { $_ eq "c" && !$found++ ? ("c","f") : $_ } @array
[download]

(as a sub)

 sub insert_after_first {
   my $arr_ref = shift;
   my $to_insert = shift;
   my $insert_after_me = shift;

   my $found = 0;

   map { $_ eq $insert_after_me && !$found++ ? ( $insert_after_me, $to
+_insert ) : $_ } @$arr_ref;
 }
[download]

--------------
"But what of all those sweet words you spoke in private?"
"Oh that's just what we call pillow talk, baby, that's all."

Ajusted to only do it once:

my $first = 1;
@array = map {
   if ($first && $_ eq "c") {
      $first = 0;
      ($_, "x")
   } else {
      $_
   }
} @array;
[download]

hum, ugly. How about:

my $first = 1;
@array = map {
   my @a = $_;
   push(@a, "x") if ($first && $_ eq "c");
   $first ||= @a-1;
   @a
} @array
[download]

Nope, still ugly. Well, you could always do:

foreach (0..$#array) {
   if ($array[$_] eq "c") {
      splice(@array, $_+1, 0, "x");
      last;      
   }
}
[download]

Actually, I think this is along the lines of what I'm looking to do with something I'm working on.

Updated to address Roy Johnson's concerns below

sub insertAfter{
    use List::Util qw[ first ];

    my( $aref, $before, $insert ) = @_;
    my $first = first{ $aref->[ $_ ] eq $before } 0 .. $#$aref ;
    return unless defined $first;
    splice @{ $aref }, ++$first, 0, $insert;
}
[download]

If the $before isn't found, though, it inserts $insert after the first element.

---

Caution: Contents may have been coded under pressure.

use List::Util 'first';

sub insert_after_first {
  my ($arr, $element, $insert) = @_;
  if (my $first = first {$arr->[$_] eq $element} 0..$#$arr) {
    splice @$arr, $first+1, 0, $insert;
    return 1;
  }
}
[download]

There's no point in your returning the array; you're modifying it in-place. You just want to indicate success or failure.

Agreed, but return the value of $first+1 to indicate that it was successful, and it may be of use to some caller (undef otherwise).

--
[ e d @ h a l l e y . c c ]

If elegance is more important than effeciency, try this recursive version:

sub insert_after_first {
    return if @_ < 3;
    my ( $elem, $new, $front ) = splice @_, 0, 3;
    return ( $front, $new, @_ ) if $front eq $elem;
    return ( $front, insert_after_first( $elem, $new, @_ ) );
}
[download]

Maybe factor out the common $front in each return statement to make one return statement:

sub insert_after_first {
    return if @_ < 3;
    my ( $elem, $new, $front ) = splice @_, 0, 3;
    return ( $front,
             $front eq $elem
             ? ($new, @_ )
             : insert_after_first( $elem, $new, @_ )
           );
}
[download]

Update: Oo! In fact, you don't do anything with $new, except stick it back on the front of @_, so don't take it off:

sub insert_after_first {
    return if @_ < 3;
    my ( $elem, $front ) = (splice(@_, 0, 1), splice(@_, 1, 1));
    return ( $front,
             $front eq $elem
             ? @_
             : insert_after_first( $elem, @_ )
             );
}
[download]

Then, to change Lispish elegance to Perlish elegance (or madness), make your argument list the way you want it for the recursion, and use & without parentheses to recurse:

sub insert_after_first {
    return if @_ < 3;
    my $front = splice(@_, 2, 1);
    return ( $front,
             $front eq $_[0]
             ? @_[1..$#_]
             : &insert_after_first
       );
}
[download]

---

Caution: Contents may have been coded under pressure.

Getting a bit unreadable, though, I'd say. ;)

The Perl6 version is about the same:

sub insert_after_first( $elem, $new, *@data ) {
    return if @data.elems < 1;
    my $front = @data.shift;
    return ( $front, $new, *@data ) if $front ~~ $new;
    return ( $front, insert_after_first( $elem, $new, *@data ) );
}
[download]

I thought the parameter naming being specified in the declaration would help, but you still neet to shift the front element off of the data list for comparison or it gets real ugly.

My offering (similar to above):

use strict;

my @arr = qw(a b c d c e f);
insert_after_first(\@arr, "c", "x");

sub insert_after_first
{
    my $arr = shift;
    my $before = shift;
    my @new = @_;

    @$arr = map { 
        defined $before && $_ eq $before ? 
            do { $before = undef; @new } :
            $_
    } @$arr
}

use Data::Dumper;
print Dumper(\@arr);
[download]

sub insert_after_first {
    my ($element, $insert, @array) = @_;
    my @ret = ();
    while (push(@ret, shift @array) && $ret[-1] ne $element && @array)
    {};
#   (@ret, $insert, @array);
    (@ret, scalar @array ? $insert : (), @array);
}
print join(' ', insert_after_first('c', 'x', 
       qw ( a b c d c e f ))), "\n";
print join(' ', insert_after_first('q', 'x', 
       qw ( a b c d c e f ))), "\n";
[download]

I still don't think you should insert if the elment you specify isn't there.

sub insert_after_first {
    my ($element, $insert, @array) = @_;
    my $hit;
    map {($_, ($_ eq $element and !$hit++) ? $insert : ())} @arr;
}
[download]

---

Caution: Contents may have been coded under pressure.

% perl -le 'print"@{[split//,join q(x),split/(?<=c)/,join(q(),qw(a b c
+ d c e f)),2]}"'
a b c x d c e f
[download]

This works for the example given, but will break if one of the elements contain white-space.

CountZero

"If you have four groups working on a compiler, you'll get a 4-pass compiler." - Conway's Law

Oh, it breaks if any of the elements consists of more than one character:

% perl -le 'print"@{[split//,join q(x),split/(?<=c)/,join(q(),qw(a b c
+ d c e foo f)),2]}"'
a b c x d c e f o o f
[download]

but single spaces are fine:

% perl -le 'print"@{[split//,join q(x),split/(?<=c)/,join(q(),qw(a b c
+ d c e),q( ),q(f)),2]}"'
a b c x d c e   f
[download]

To fix this, I guess one could do something like

perl -le 'print"@{[split/\0/,join qq(\0x),split/(?<=c)/,join(qq(0),qw(
+a b c d c e foo f)),2]}"'
a b c x d c e foo f
[download]

the lowliest monk

sub insert_after_first {
   my ($arr, $find, $insert) = @_;
   my $found = 0;
   my ($pos) = grep { $arr->[$_] eq $find and !$found++ } 0..$#$arr;
   splice @$arr, $pos+1, 0, $insert if $found;
}
[download]

Update: A shorter, slightly neater variant:

sub insert_after_first {
   my ($arr, $find, $insert) = @_;
   my ($pos) = grep { $arr->[$_] eq $find } 0..$#$arr;
   splice @$arr, $pos+1, 0, $insert if defined($pos);
}
[download]

A variation using index (you didn't say it had to be efficient!)

sub insert_after_first
{
    my ( $a_ref, $afterthis, $insertme ) = @_;
    my $pos = index( join( '', @$a_ref ), $afterthis );
    splice( @$a_ref, $pos+1, 0, $insertme ) if $pos >= 0;
}
[download]

Update: As tall_man mentioned, this only works when the elements of the array are single characters, because the offset for splice represents the number of chars from the beginning of the string/array (rather than the number of individual array elements). Thanks for pointing it out. (I still thought it was a neat idea for the sample data, though!)

This doesn't work if you try it on a non-toy example where the array contains more than single-letter keys.

sub insert_after_first {
  my ($count, $arr, $elt, $ins) = (0, @_);
  return map {($_ eq $elt and $count++ == 0) ? ($_,$ins) : $_} @$arr;
}
[download]

sub insert_after_first {
    my ($ndx, $arr, $elt, $ins) = (0, @_);
    $ndx > @$arr and return while $arr->[$ndx++] ne $elt;
    splice @$arr, $ndx, 0, $ins;
}
[download]

Update: Here's a version that is a little more efficient, removing one boolean comparison from the loop.

sub insert_after_first {
    my ($ndx, $arr, $elt, $ins) = (0, @_);
    $arr->[$ndx++] eq $elt and last for 0 .. @$arr;
    splice @$arr, $ndx, 0, $ins if $ndx <= @$arr;
}
[download]

#!/usr/bin/perl

@a=("a","b","c","b","a");
$targ="b";
$ins="d";
THINGY: foreach(@a) {
    $_ =~ $targ && do {
        splice(@a,$i,1,($_, $ins));
        last THINGY
    };
    $i++;
};
print join ", ", @a;
print "\n"
[download]

a, b, d, c, b, a
[download]