[Moscow.pm] Парсинг текстовой строки

[Dmitry E. Oboukhov]

вот тест вроде только падежи приделать:

#!/usr/bin/perl

use warnings;
use strict;
use utf8;
use open qw(:std :utf8);

my $string=<<endstr;
0,5(бухты по 50 м), 0,6(катушки по 300 м), 2,4(катушки по 300 м),
2,4(катушки по 300 м), 2,4(катушки по 300 м), 2,4(катушки по 300 м),
2,4(катушки по 300 м), 2,4(катушки по 300 м), 2,4(катушки по 300 м),
2,4(катушки по 300 м), 2,4(катушки по 300 м), 2,4(катушки по 300 м),
2,4(катушки по 300м), 2,4(катушки по 300 м), 2,4(катушки по 300 м),
2,4(катушки по 300 м), 2,4(катушки по 300 м), 2,4(катушки по 300 м),
2,4(катушки по 300 м), 2,4(катушки по 300 м), 2,4(катушки по 300 м),
2,4(катушки по 300 м), 2,4(катушки по 300 м), 2,5(катушки по 500 м),
3(катушки по 500 м), 3(катушки по 500 м), 3(катушки по 500 м), 3(катушки по
500 м), 3(катушки по 500 м), 3(катушки по 500 м), 3(катушки по 500 м),
3(катушки по 500 м), 3(катушки по 500 м), 3(катушки по 500 м), 3(катушки по
500 м), 3(катушки по 500 м), 3(катушки по 500 м), 3(катушки по 500 м),
3(катушки по 300 м), 3,6(бухты по 100 м), 3,6(катушки по 300 м), 4,3(бухты
по 100 м), 4,4(бухты по 50 м), 4,4(бухты по 50 м)
endstr

sub split_one($$$)
{
    my ($num, $what, $by)=@_;

    $num=~s/,/./;

    my $ret = '';
    while($num>1)
    {
        $ret .= "$by $what\n";
        $num -= 1;
    }
    $ret .= sprintf "%s %s\n", $by*$num, $what;
    return $ret;
}

$string =~ s{(\d+(?:,\d+)?)\s*\(\s*(\S+)\s+(?:по\s+)?(\d+).*?\)\s*,?\s*}
    { split_one($1, $2, $3) }esg;

print $string;

результат:

25 бухты
180 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
300 катушки
300 катушки
120 катушки
500 катушки
500 катушки
250 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
500 катушки
300 катушки
300 катушки
300 катушки
100 бухты
100 бухты
100 бухты
60 бухты
300 катушки
300 катушки
300 катушки
180 катушки
100 бухты
100 бухты
100 бухты
100 бухты
30 бухты
50 бухты
50 бухты
50 бухты
50 бухты
20 бухты
50 бухты
50 бухты
50 бухты
50 бухты
20 бухты

--
... mpd playing: Крематорий - Кокаин

. ''`.                               Dmitry E. Oboukhov
: :’  :   email: unera на debian.org jabber://UNera@uvw.ru
`. `~’              GPGKey: 1024D / F8E26537 2006-11-21
  `- 1B23 D4F8 8EC0 D902 0555  E438 AB8C 00CF F8E2 6537
----------- следущая часть -----------
A non-text attachment was scrubbed...
Name: отсутствует
Type: application/pgp-signature
Size: 197 bytes
Desc: Digital signature
URL: <http://mail.pm.org/pipermail/moscow-pm/attachments/20081106/66be05a9/attachment.bin>