use Data::Dumper; $Data::Dumper::Indent = 1; use strict; sub ebay_search_logic { my $str = shift; my ($word, $neg, $alt); $word = qr{ (?{ save_pos() }) (\w+) (?{ push_word() }) }x; $neg = qr{ - (??{ $word }) (?{ mod_neg() }) }x; $alt = qr{ \( (??{ $word }) (?{ alt1(); }) (?: , (??{ $word }) (?{ alt2() }) )+ \) }x; return $str =~ m{ (?{ [] }) ^ \s* (?: (??{ $word }) | (??{ $neg }) | (??{ $alt }) ) (?: \s+ (?: (??{ $word }) | (??{ $neg }) | (??{ $alt }) ) )* \s* $ (?{ print Dumper($^R); $^R; }) }x; return $str; } print ebay_search_logic("this that those"), "\n"; # LIKE 'this' AND LIKE 'that' AND LIKE 'those' print ebay_search_logic("this -that those"), "\n"; # LIKE 'this' AND (NOT LIKE 'that') AND LIKE 'those' print ebay_search_logic("this (that,those)"), "\n"; # LIKE 'this' AND (LIKE 'that' OR LIKE 'those') sub save_pos { my @r = @{ $^R }; [ @r, $+[0] ]; } sub push_word { my @r = @{ $^R }; my $p = pop @r; my $w = substr($_, $p, $+[0] - $p); [ @r, { WORD => $w } ]; } sub mod_neg { my @r = @{ $^R }; my $w = pop @r; [ @r, { NOT => $w->{WORD} } ]; } sub alt1 { my @r = @{ $^R }; my $w = pop @r; [ @r, { ALT => [ $w->{WORD} ] } ]; } sub alt2 { my @r = @{ $^R }; my $w = pop @r; my $alt = pop @r; [ @r, { ALT => [ @{ $alt->{ALT} }, $w->{WORD} ] } ]; }