use printf or sprintf:

printf("%06d\n",$_) for (123, 1234, 12345, 123456);

my $val = sprintf("%06d",123);
[download]

my $name = '012345';
my ($three) = $name =~ /^(\d\d\d)/;
[download]

UPDATE:
more code for you :)

use strict;

while (<DATA>) {
   chomp;
   my ($numbs) = $_ =~ /^(\d+)/;
   my $formatted = sprintf("%06d",$numbs) . '.jpg';
   my ($dir) = $formatted =~ /^(\d\d\d)/;
   print "filename: $formatted\t\tdirname: $dir\n";   
}

__DATA__
123.jpg
1234.jpg
12345.jpg
123456.jpg
[download]

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

You might also want to make sure that all the filenames are in the format you think they are:
warn "Invalid file $file" unless $file =~ /^\d{3,6}\.jpe?g$/; This will complain unless the filename consists of 3-6 digits, followed by a period and the suffix "jpg" or "jpeg". You might want to make a pass before you start moving files, just to make sure your directories contain what you think they contain.

Requirement 1:

Find filenames within a directory that look like '\A\d+\.jpg\z'. (I prefer \A and \z over ^ and $ as \A and \z match 'beginning of string' and 'end of string' as opposed to 'beginning of line' and 'end of line')

my(@filenames, $directory);
opendir($directory, $directory_path)
    or die "opendir of $directory_path failed: $!\n";
@filenames = grep /\A\d+\.jpg\z/, readdir($directory);
closedir($directory);
[download]

Requirement 2:

Extend filenames such that they follow the form '\A\d{6,}\z'.

Requirement 3:

Creating directory (if it does not already exist) and moving files into the directory.

use File::Spec;
-d $subdir_path
    or mkdir($subdir_path, 0777)
        or die "mkdir of $subdir_path failed: $!\n";
rename($filename, File::Spec->catfile($subdir_path, $filename))
    or die "rename of $filename failed: $!\n";
[download]

Requirement 4:

Matching the first three (or more?) digits in the string.

Final Solution:

Putting this all together, we get:

use File::Spec;

for my $directory_path (@ARGV) {
    my $directory;
    my @filenames;

    # Determine @filenames to work with in $directory_path.
    opendir($directory, $directory_path)
        or die "opendir of $directory_path failed: $!\n";
    @filenames = grep /\A\d+\.jpg\z/, readdir($directory);
    closedir($directory);

    for (@filenames) {
        my($basename, $prefix) = /\A((.+).{3})\.jpg\z/s or next;
        my $subdir_path = File::Spec->catdir($directory_path, $prefix)
+;

        # Create the subdir if it does not yet exist.
        -d $subdir_path
            or mkdir($subdir_path, 0777)
                or die "mkdir of $subdir_path failed: $!\n";

        my $old_path = File::Spec->catfile($directory_path, $_);
        my $new_path = File::Spec->catfile($subdir_path, sprintf("%06d
+.jpg", $basename));

        # Move the file to the subdir.
        rename($old_path, $new_path)
            or die "rename of $old_path to $new_path failed: $!\n";

    }
}
[download]

Edit to by tye to remove PRE tags around CODE tags

You'll probably want to use something like grep /\.jpg/, readdir(DIR) to get your list of files. You might even want to sort them, as you go through, split off the back extension, and check the prefix.

You'll want to check to make sure your prefix is just made of digits. If not, figure out what you want to do with it. If so, sprintf("%06d", $var) for your new prefix and look into substr for getting the first three chars of that.

Then go ahead and make your sub-directories as needed, and make sure you already don't have the numbered file before you rename it. Since your original dir may have a 001234.jpg and 01234.jpg in it.

  opendir D, ".";
  my @old_files =
    grep { /^\d+\.jpg$/ } # keep only those of interest
    readdir D;
  closedir D;

  my %dirs;
  my %renames;
  @renames{ @old_files } =
    # insert slash; remember dir:
    map { s#(...)#$1/#; $dirs{$1}++; $_ }
    # pad with zeros:
    map { s/(\d+)/ sprintf "%06d", $1 /e; $_ }
    @old_files;

  for my $dir ( keys %dirs )
  {
    mkdir $dir;
    -d $dir or die "Error: failed to assert director $dir";
  }

  while ( my( $old, $new ) = each %renames )
  {
    rename $old, $new or warn "Failed to rename $old as $new: $!\n";
  }
[download]

jdporter
...porque es dificil estar guapo y blanco.

s/(\d*)/sprintf("%06d",$1)/e;
m/^(\d{3})/
[download]

To get the first three digits, you could also use the substr-function (substring). It is probably faster than using a regex.</p

CountZero

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

use File::Dosglob;
$dir = '/path/to/dir';
my @m = File::DosGlob::doglob(1,$dir.'/*'); # trailing /* is vital!
for (@m) {
  next unless m!/(\d*)(\d{3}\.jpg)$!;      # skip files which do not h
+ave at least 3 nos and .jpg
  my $sub = ('0'x(3-length($1))).$1;       # append 0s if req'd
  my $rest= $2;
  mkdir ($dir.$sub) unless -e ($dir.$sub); # create dir if req'd
  rename $_, $dir.$sub.'/'.$sub.$rest;     # move file using rename
}
[download]

Dingus