my $s = "($big_string)";
list_extr(\$s)
####
list_extr(\( "(" . $big_string . ")" ));
####
my $ttt = "(" . $big_string . ")";
list_extr(\$ttt);
####
# \G(?:\s|#.*$)* -- means start from last position \G,
# skip spaces and comments # till the
# end of line
# ([[:alpha:]](?:_?[[:alnum:]])*) -- my identifier
# restrictions; start with letter, then
# letters, underscores, digits; but
# two underscores in a row not allowed,
# underscore at the end not allowed
sub list_extr {
my ($a) = @_;
ref $a eq 'SCALAR' or croak "wrong ref";
my @l;
$$a =~ /\G(?:\s|#.*$)*\(/mgc or croak "parse err";
while ($$a =~ /\G(?:\s|#.*$)*([[:alpha:]](?:_?[[:alnum:]])*)(?:\s|#.*$)*/mgc) {
push @l, {'name' => $1, 'parm' => parm_extr($a)};
}
$$a =~ /\G(?:\s|#.*$)*\)(?:\s|#.*$)*/mgc or croak "parse err";
return \@l;
}
sub parm_extr {
my ($a) = @_;
ref $a eq 'SCALAR' or croak "wrong ref";
my %p;
$$a =~ /\G(?:\s|#.*$)*\(/mgc or croak "parse err";
while ($$a =~ /\G(?:\s|#.*$)*([[:alpha:]](?:_?[[:alnum:]])*)(?:\s|#.*$)*/mgc) {
my $n = $1;
if ($$a =~ /\G([[:alpha:]](?:_?[[:alnum:]])*|"(?:[^\\"[:cntrl:]]+|\\[\\"nt])*")/mgc) {
$p{$n} = $1;
} elsif ($$a =~ /\G(?=[-+.\d])/mgc) {
$p{$n} = numb_extr($a);
} elsif ($$a =~ /\G(?=\()/mgc) {
$p{$n} = parm_extr($a);
} else {
croak "parse err";
}
}
$$a =~ /\G(?:\s|#.*$)*\)(?:\s|#.*$)*/mgc or croak "parse err";
return \%p;
}
sub numb_extr {
my ($a) = @_;
ref $a eq 'SCALAR' or croak "wrong ref";
$$a =~ /\G(?:\s|#.*$)*([-+]?\d*(\.\d*)?)/mgc or croak "parse err";
my $n = $1;
$n eq '0.0' and return 0;
$n =~ /\A[-+](?!0.0\z)(?=[1-9]|0\.)\d+\.\d+(?<=[.\d][1-9]|\.0)\z/ or croak "parse err";
length $n <= 15 + 2 or croak "numb too long";
$n = 0 + $n;
# 1234567890.12345
abs $n > 99999999999999.9 and croak "numb out of range";
return 0 + $n;
}