#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

sub increment {
    my $pos = rindex $_[0], 0;
    if ($pos > -1) {
        substr $_[0], $pos, 1, '1';
        substr $_[0], $pos + 1, length($_[0]) - $pos - 1,
                         '0' x (length($_[0]) - $pos - 1);
    } else {
        $_[0] = '1' . ('0' x length $_[0]);
    }
}

my $ones = 3;
my $length = 10;
my $n = '0' x $length;
while ($length == length $n) {
    increment($n);
    next unless $ones == $n =~ tr/1//;
    say $n;
}