It's a bit weird that 0 is treated the same as '':

sub id2path3 {
    my $id = shift || return '';
    my $path;
    my( $pat, $bit ) = $id < 1e6 ? ( '%06u', '..' ) : ( '%09u', '...' 
+);
    $path = sprintf $pat, $id;
    $path =~ s[($bit)($bit)$][/$1/$2];
    return $path;
}
[download]

sub id2path_new {
    my ($id) = @_;
    return '' unless $id;

    my $path = '';

    if ($id >= 1_000_000) {
        $path =  sprintf("%09d", $id);
        $path =~ s#\A(.*)(...)(...)\z#$1/$2/$3#;
    } else {
        $path =  sprintf("%06d", $id);
        $path =~ s#\A(..)(..)(..)\z#$1/$2/$3#;
    }
    return $path;
}
[download]

\A(\d*)(\d{3})(\d{3})\z

You want Slashes instead of commas - that should be trivial.

Beauty is indeed subjective...
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

use strict;
use warnings;


sub id2p_choroba {
  my $id = shift or return q();

  my $chunk_length = length $id > 6 ? 3 : 2;

  $id = sprintf '%0' . ($chunk_length * 3) . 'd', $id;

  my $chunk = ".{$chunk_length}";
  my $path  = join '/', $id =~ / ^ (.*) ($chunk) ($chunk) $ /xg;
  return $path;
}

sub id2p_lanx {
  my $id = shift or return q();

 
  my ($chunk,$len) = (length $id > 6 )
    ? (3,9)
      : (2,6);

  my $norm = sprintf "%0${len}d", $id;
  
  my $path = join "/",
    ( $norm =~ m/ ^ (-?\d+) (\d{$chunk}) (\d{$chunk}) $ /x );

  #  $path ||= '-00/000/001'; # this weirdness is needed if '-?' is mi
+ssing
  
  return $path;
}


use Test::More tests => 23;

is(id2p_lanx($_), id2p_choroba($_), "id=$_")
  for q(), 0, 1, 9, 10, 99,
  100, 999, 1000, 9999, 10000,
  99999, 100000, 999999, 1e6,
  1e7-1, 1e7, 1e8-1, 1e8, 1e9,
  1e10, 1e11, 1e12;
[download]

update

hmm ... well ... surprisingly now after some modifications my code looks a lot like yours! ;-)

I'm not convinced I like any of the above when it comes to readability. Here is what I came up with that might make it easier for a junior-level programmer to at least have half a clue as to what is going on (it being understood that my choice of variable names could be better):

sub id2path_boftx
{
    my $id = shift or return q();

#    my $chunk_length = length $id > 6 ? 3 : 2;
    my $chunk_length = $id < 1e6 ? 2 : 3;
    my $path_pat = '%0' . $chunk_length . 'd';
    $path_pat = join('/', $path_pat, $path_pat, $path_pat);

    my $chunk_power = 10 ** $chunk_length;

    my $path = sprintf $path_pat, $id / ($chunk_power ** 2),
      ($id / $chunk_power) % $chunk_power, $id % $chunk_power;

    return $path;
}
[download]

FWIW, it passes all 23 tests.

Update: Changed how $chunk_lentgh is determined. I like the numeric test better after looking at it for a while.

Similar to BrowserUk's, but using substr instead of regex:

sub id2path_new {
    my $id   = shift or return q();
    my( $pat, @d ) = length $id > 6 ? ('%09d',6,3) : ('%06d',4,2);
    $id = sprintf $pat, $id;
    substr $id, -$_, 0, '/' for @d;
    return $id;
}
[download]

Or this?

sub id2path_new {
    my $id = shift or return q();
    return sprintf "%03d/$2/$3", $1 if $id =~ /(.+)(...)(...)/;
    return join "/", "00000$id" =~ /(..)(..)(..)$/;
}
[download]

Update: Changed the last line, was return sprintf "%02d/%02d/%02d", "00000$id" =~ /(..)(..)(..)$/;.

Update: Another variation:

sub id2path_new {
    my $id = shift or return q();
    $id =~ /(.+)(...)(...)/ or "00000$id" =~ /(..)(..)(..)$/;
    return sprintf "%0".length($3)."d/$2/$3", $1;
}
[download]

Update: ...and close to obfuscation...

sub id2path_new {
    my $id = shift or return q();
    sprintf "%0".($id=~/(.+)(...)(...)/?3:("00000$id"=~/(..)(..)(..)$/
+,2))."d/$2/$3",$1;
}
[download]

I am getting carried away, so here is yet another one:

sub id2path_new {
    $_[0]?join"/",grep{$_}"00000$_[0]"=~/0*(..)(..)(..)$|0*(.{3,})(...
+)(...)$/:q();
}
[download]

I’m afraid that, were I your team-lead, I would, rather decidedly, vote down your change, and not permit it to move forward into production.   And here would be my two three reasons why:

1. Although the existing code might “offend your personal sensibilities,” it is nonetheless obvious as to what it does.   I can, using nothing more than my two eyeballs and from this (looks to be, rather extreme) geographical distance, be pretty-darned sure that it works.   (Furthermore, you are not reacting to any outstanding bug-report that suggests that it does not work.)
2. Your “replacement” code, on the other hand, is not “visually obvious.”   At first glance, and the second and the third, I have no idea what this code is supposed to be doing.   Thank-you for providing test cases, but once again, I cannot be sure that these test cases are complete or exhaustive.
3. There is business risk associated with your “gratuitous” change, but without any apparent business justification.

Yes, I would make a mental note to be sure that, henceforth, you always had enough assigned tickets to deal with, that you nevermore felt that you felt that you had enough spare time to indulge any temptations to “distract yourself with things that ‘you thought’ needed to be ‘improved about’ stable production code that was in service.

I am, as usual, quite sure that “the downvote daemons” will jump-on this opinion ... as they have done with so many others ...but in my defense I would simply say that it boiled down to a pure-business decision:   “In some ways, we all work in a sewer.   We can’t be making decisions based on smells.”   Change, itself, is “the bugaboo” here.   The <<business risk | business cost>> intrinsically associated with any change at all (especially to “active” code such as this ...) is so extreme that it must never be undertaken lightly.

Let me disagree, even if the original code was not the worst example I could have brought up.
1. I was staring at the code for a long time before I understood what it does (originally, there was inconsistent indentation, global variables with meaningless names, almost no whitespace). I had to run it to see whether the numeric constants were correct and what the behaviour was for larger numbers.
2. Here I have to agree. I was not satisfied with my solution, that was why I asked here. To run an exhaustive test, you can modify the list to

   q(), 0 .. 1e12
   [download]

   Reserve enough time, though.
3. Business justification: I am the maintainer of the code. If the code changes only when fixing bugs, it will stay in the nineties and become unmaintainable. Without refactoring, the code becomes dead, and accumulates risk: at one point in the future, a bug or feature request will appear that will not be possible.

   Working with always enough assigned tickets to prevent any creativity leads to exhaustion. It will make me leave your company, which means «business cost»: you invested in the hiring process and in training me. Moreover, trust (both to expert opinions and business decisions) makes the working environment better.

لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

The downvote demons jump on your posts because it they look like a unicorn ate an APL keyboard and threw it all up. No one can ever figure out what you're trying to say because no one can ever ever ever read it.

No one can ever figure out what you're trying to say because no one can ever ever ever read it.

No figuring out is required; the text effects merely signal the stench volume of the advice

> it is nonetheless obvious as to what it does.

ORLY?

The original code is buggy for > 1e10, guess why!

Cheers Rolf

( addicted to the Perl Programming Language)

PS: Did anyone really expect you would contribute any code?

How exactly is it buggy for id > 1e10?

I will have to side with sundialsvc4 here. The original code is immediately obvious and clear for a C programmer.

I would make a mental note to be sure that, henceforth, you always had enough assigned tickets to deal with, that you nevermore felt that you felt that you had enough spare time to indulge any temptations to “distract yourself with things that ‘you thought’ needed to be ‘improved about’ stable production code that was in service.

I am thankful you are not in a position to exercise such childish mismanagement principles in my company.

I am, as usual, quite sure that “the downvote daemons” will jump-on this opinion ... as they have done with so many others.

It really doesn't occur to you at all that the reason you get downvoted so often is that you're both wrong and abrasive, does it?

I pity you.

sub id2path_new {
    my $id = shift;
    return q() unless $id;

    # group of digits
    my $bits = length $id > 6 ? 3 : 2;

    # prepend with 0 digits if necessary
    my $id = ('0' x (3 * $bits - length $id)) . $id;

    my @parts = (
        # leftmost part
        (substr $id, 0, -2 * $bits),
        # subparts
        (substr $id,    -2 * $bits) =~ m{(\d{$bits})}xmsg
    );

    return join q{/}, @parts; 
}
[download]

sub id2path_new {
    my ($id) = @_;
    return '' unless $id;

    my $path = '';

    if ($id >= 1_000_000) {  $path = sprintf("%09d", $id);  $path =~ s
+#\A(.*)(...)(...)\z#$1/$2/$3#;   } 
    else                  {  $path = sprintf("%06d", $id);  $path =~ s
+#\A(..) (..) (..)\z#$1/$2/$3#x;  }
    return $path;
}
[download]

    my $id = shift;
    # disallow ID 0;
    $id > 0 && $id < 1e9 or return q();
    $id = sprintf '%0*lu', ($id < 1e6 ? 6 : 9), $id;
    ...
[download]

sub id2path {
    my $id = shift;
    # allow ID 0; disallow 12.34
    $id =~ m/^\d{1,9}$/ or return q();
    my $n = length($id) > 6 ? 3 : 2;
    $id = sprintf '%0*s', 3 * $n, $id;
    $_ = "/$_/" for substr($id, $n, $n);
    # or: substr($id, $_, 0, '/') for -2*$n, -$n;
    return $id;
}
[download]