$ perl -le'
my @x = ( 5234, 523, 52, 5 );
my $limit = 2;
for my $x ( @x ) {
    print $x;
    my $y = $limit;           
    $x =~ s/(?<=\d)(?=\d)/ $y-- ? "_" : "" /eg;
    print $x;
    }
'
5234
5_2_34
523
5_2_3
52
5_2
5
5
[download]

How about:

use warnings;
use strict;


my @test = qw(1 12 123 1234 12345 1x12x123x1234x12345);
my $sep = '_';


for my $s (@test) {
    my $sa = append($s, $sep);
    if (defined($sa)) {
        print "'$s' -> '$sa' \n";
        }
    else {
        print "'$s' append undefined \n";
        }
    }


sub append {

    my ($string,
        $sep,
        ) = @_;

    return unless  # return undef unless substitution(s) made
        $string =~ s{ (?<! \d) (\d{2,4}) (?! \d)   }
                    { join $sep, split /\B/, $1, 3 }xmsge;

    return $string;  # return string with substitution(s)

    }
[download]

Output:

'1' append undefined
'12' -> '1_2'
'123' -> '1_2_3'
'1234' -> '1_2_34'
'12345' append undefined
'1x12x123x1234x12345' -> '1x1_2x1_2_3x1_2_34x12345'
[download]

use strict;
use warnings;

my $val1 = 5234;

my @digits = split(//,$val1);
my $string = join ('_',@digits);
$string =~ s/_(\d)$/$1/ if @digits == 4;

print $string, "\n";
#prints 5_2_34
#
#$val1 5234 prints 5_2_34
#$val1 52   prints 5_2
#$val1 523  prints 5_2_3
[download]

I am just trying to demonstrate a technique. Once you see how this works, you can adapt it for your exact specific needs. Like maybe if @digits is >4, that is an error or whatever. A subroutine would be like this (shamelessly plugging my code into toolic's loop structure, thanks toolic!): (this is 2nd update)

for (qw(5234 523 52)) 
{
    print append($_ , '_'), "\n";
}

sub append 
{
    my ($val, $character) = @_;
    my @digits = split(//,$val);
    my $string = join ($character,@digits);
    $string =~ s/$character(\d)$/$1/ if @digits >= 4;
    return $string;
}
[download]

use strict;
use warnings;

for (qw(5234 523 52)) {
    print append($_ , '_'), "\n";
}

sub append {
    my $val2      = shift;
    my $character = shift;
    if ($val2 =~ /(\d{2,3})/) {
        my $in = $1;
        my $num = join $character, split //, $in;
        $val2 =~ s/$in/$num/;
    }
    else {
        return;
    }
    return $val2;
}

__END__

5_2_34
5_2_3
5_2
[download]

perl -le '@arr=qw(5 52 523 5234 52341);foreach $a (@arr) { $a=join "_"
+,split //,$a,(length($a)>3)?3:length($a) if length($a) < 5 and length
+($a)>1;print $a}
'
[download]