One solution is to split the string at the last dot, then change the dots to underscores everywhere before it.

$_ = "mypic.jpg.jpg";
if (/^(.*)(\..*)/s) { 
        my($p, $s) = ($1, $2); 
        $p=~y/./_/; $_ = $p.$s; 
}
print $_, $/;
[download]

The if is needed so that you don't get an error if the string does not have a dot in it.

Update: Ysth's reply has reminded me that you can bind substitutions to substr. That's indeed a simpler solution than what I've given above.

Thus, here's a new variant using the same feature:

$_ = "mypic.jpg.jpg";
/^(.*)\./s and substr($_, 0, $+[1])=~s/\./_/g;
print $_, $/;
[download]

Update 2: Added hat anchor before (.*). Is that good?

Update 3: I mean Why does a Perl 5.6 regex run a lot slower on Perl 5.8?