perl. помогите реализовать следующее

Качалку порнухи пишем? ;)

Первое, что приходит в голову: посчитать количество '?' в шаблоне,
скажем, в твоем примере их n=3. Соответственно в цикле генерим
числа от 0 до (10^n)-1. Каждое число разбиваем на n цифр (считая leading
zeroes), и слева направо подставляем их вместо '?' в шаблоне.

например:

sub gen
{
        (my $pat = shift) =~ s/\?/./g;
        my $max = 10 ** length $pat;
        my $min = '0' x length $pat;
        $pat = qr/^$pat\z/;
        grep /$pat/, $min .. "$max";
}

неэффективно, но коротко, и вполне "Perl way" :)

> неэффективно, но коротко, и вполне "Perl way" :)

IMHO _слишком_ неэффективно. Сложность алгоритма
зависит от полной длины шаблона, а не от количества
вопросиков. Ужоснах :-( Даже простенький шаблон
'123456789?' будет считаться хрен знает сколько.

Можно попробовать вот так (сильно не тестировал,
некогда, но должен работать, в шаблоне должен быть
обязательно хотя бы один вопросик):

#!/usr/bin/perl -w

use strict;

print join("\n" => gennum($ARGV[0])), "\n";

sub gennum
{
    my $nq = 0;
    $nq++ while $_[0] =~ /\?/g;
    map { (my $n = $_[0]) =~ s!\?!$a=$_%10;$_=int $_/10; $a!ge; $n }
        (0 .. '9' x $nq)
}

огромное спасибо всем...

Onanim в особенности...

хех, целый день сидел на лекции думал как это сделать, а вы в 5 минут сделали...

мне ещё учиться и учиться...

если честно я непонял как работает данный скрипт, не хочу тупо совать чужой код даже непонимая как он работает, нельзя ли немного прокоментировать...

Ну попробую прокомментировать. В принципе это реализация алгоритма,
предложенного int19h в самом первом ответе.
Итак, рассмотрим немного усовершенствованный вариант:

#!/usr/bin/perl -w

use strict;

print join("\n" => gennum($ARGV[0])), "\n";

sub gennum
{
    my $template = shift;

    my $nq = 0;
    $nq++ while $template =~ /\?/g;
    return unless $nq;

    map { (my $t = $template) =~ s/\?/substr($_,0,1,'')/ge; $t }
         ('0' x $nq .. '9' x $nq)
}

Итак, что же мы делаем в функции gennum?
Мы ожидаем единственный аргумент (шаблон) и засовываем его в 
переменную $template.
Затем в переменной $nq мы подсчитываем количество вопросиков в 
шаблоне. Если окажется, что вопросиков нет ($nq==0) мы делаем return
(упрощенно говоря, возвращаем пустой список) - типа ничего мы не
нагенерировали.
Для дальнейших примеров примем, что шаблон у нас скажем '3??4'.
В этом случае $nq равно 2.
Ну и теперь мы подходим к map. Выражения с map (и grep) лучше всего
читать наоборот - справа налево. Вначале надо понять, какой же массив
map будет обрабатывать. Это массив/список задан выражением:
('0' x $nq .. '9' x $nq)
В этом контексте символ 'x' - это не буква, как в слове "хуй". Это
оператор повтора (repetition operator). Подробности смотри в
perldoc perlop. После вычисления этих операторов выражение (в случае
нашего примера) станет выглядеть:
('00' .. '99')
Здесь '..' - это range operator. Будучи примененным, он даст нам 
список всех строк между '00' и '99'. Подробности в perldoc perlop.
Короче вся эта бодяга после вычисления есть список строк:
('00', '01', '02', ... '98', '99')
Асилил? Малацца!

Итак, у нас есть список строк и map теперь пройдется по этому
списку, выполнит для каждого элемента преобразование и выдаст
как результат новый список. Подробности в perldoc -f map

Разберемся теперь с пребразованием:
{ (my $t = $template) =~ s/\?/substr($_,0,1,'')/ge; $t }

Начало очевидно - мы делаем копию $template в $t. Затем мы применяем
оператор замены s/// к этой копии $t. Мы бы могли написать отдельно
присваивание, а потом отдельно $t =~ ... . Но так выглядит круче и на 
пару символов короче ;-)
Теперь сам оператор замены. Он идет по копии шаблона и заменяет
все вопросики (числа оставляет без изменения). А заменяет он их на 
результат выражения substr($_,0,1,''). Коротко - эта хрень берет
$_ (как строку), удаляет из нее первый символ и возвращает его как
результат. Подробности в perldoc -f substr
Ну и наконец обновленный $t возвращается как результат всего 
выражения.
Теперь надо только напрячься и вспомнить, что в $_ (согласно
описания map) пробегает по элементам списка ('00' .. '99').

Давай один шаг рассмортрим вручную:

Итак, map начинает с элемента '00' и засовывает его в переменную $_
У нас в переменной $t свежая копия '3??4' и мы вызываем наш s///ge.
Оператор замены находит перый ? в $t. Функция substr возвращает '0'
и s/// заменяет ? на 0. То есть теперь $t равно '30?4',  а из $_
первый ноль выкинут и она равна '0'. То же самое происходит со
вторым ? и $t принимает вид '3004'. Этои есть первый элемент
нашего списка-результата. На следующем шагу появится '3014' и так
далее до '3994'.

Да, посмотри perldoc perlop на тему почему именно 'ge' в s///ge.

Кто ничего не понял - вперед в аптеку пить йад!

благодарю, вы прям всё так расписали :) , но всё равно спасибо...

именно меня интересовал шаблон замены , ну ну флаги то там понятны, код в 
шаблон вставлять и глобальный поиск

я вчера смотрел ваш пример ночью и не как не мог впереться что там делает

$a=$_%10;$_=int $_/10; $a

c substr всё прояснилось...

особенно классно сделано с $t ,которая по мере генерации модифицируется...

по поводу итераций, то биш сколько у нас в шаблоне вопросов можно юзать

мне нужно было сгенерировать массив , я использовав ваш код сделал это следующим образом

push ( @ports, join("\n", map { (my $t = $template) =~ s/\?/substr($_,0,1,'')/ge; $t } ('0' .. '9' x scalar (@a = $ARGV[0] =~ m/\?/g) ) ) ) if $template =~ /\?/;

ещё раз благодарю...

тьфу $ARGV[0] это там я пробовал просто с командной строки различные шаблоны... разумеется на скаляр $template, можно даже немного упростить

push ( @ports, join("\n", map { (my $t = $template) =~ s/\?/substr($_,0,1,'')/ge; $t } ('0' .. '9' x scalar (@i) ) ) ) if @i = $template =~ m/\?/g;

вот за что обожаю perl - минимализм :)

> push ( @ports, join("\n", map { (my $t = $template) =~ s/\?/substr($_,0,1,'')/ge; $t } ('0' .. '9' x scalar (@i) ) ) ) if @i = $template =~ m/\?/g;

Не, ('0' .. '9' x scalar (@i) ) не подходит, надо именно
('0' x scalar (@i) .. '9' x scalar (@i) ) - иначе не будет leading
zeroes. А нам надо, чтобы в строках было ровно столько цифр,
сколько в шаблоне вопросиков.
Да, и AFAIK scalar лишнее. Достаточно ('0' x @i .. '9' x @i)

HTH

>иначе не будет leading zeroes ааа, да, понял...

> Ужоснах :-(

разумеется, это годится только как "а еще вот так можно сделать".

>        my $nq = 0;
>        $nq++ while $_[0] =~ /\?/g;

я думаю, лучше было бы:

        my $nq = $_[0] =~ tr/?//;

Вариант, использующий динамические свойства перла:

$templ = $ARGV[0] || die;
@templ = ();

push @templ, substr($templ, $_, 1) foreach (0 .. length($templ));

$const_loop = q/$arr[%1$d] = $templ[%1$d]; %2$s/;
$query_loop = q/foreach (0 .. 9) {$arr[%1$d] = $_; %2$s}/;

$code = '%s';

for ($i = 0; $i <= $#templ; $i++) {
        $code = sprintf(($templ[$i] eq '?') ? $query_loop : $const_loop, $i, $code);
}

$code = sprintf($code, q/print @arr, "\n";/);

eval "$code";