#!/usr/bin/perl -- use strict; use warnings; my $s = q[dogs OR cats OR "flying fish" OR (shrimp AND squid)]; my $parser = do { use Regexp::Grammars; qr{ # <[TERM]>* | | | "([^"]+?)" AND|OR \w+ \( <[TERM]>* \) }xs }; if($s =~ $parser){ my(%rash) = %/;#bah for scite lexer /# undef %/;# bah for scite lexer /# use Data::Dumper(); print Data::Dumper->new([\%rash])->Indent(1)->Useqq(1)->Dump,"\n"; kek(\%rash); # kill empty key print Data::Dumper->new([\%rash])->Indent(1)->Useqq(1)->Dump,"\n"; my $rash = reorder_terms(\%rash); # consumes %rash print Data::Dumper->new([$rash])->Indent(1)->Useqq(1)->Dump,"\n"; } sub reorder_terms { my( $ref ) = @_; if( $$ref{TERM}){ my @term; my @op; for my $t( @{$$ref{TERM}} ){ if( ref $t ){ if( $$t{OP} ){ push @op, delete $$t{OP}; }elsif( $$t{LIST} ){ push @term, reorder_terms(delete $$t{LIST} ); }else{ die "uh oh, no OP or LIST key"; } } else { push @term, $t; } } undef %$ref; #return [@op, @term ]; return [$op[0], @term ]; } die "uh oh, no TERM key"; } sub kek { my ($ref) = @_; my $typ = ref $ref; if( $typ eq 'HASH'){ delete $$ref{""}; for my $val( values %$ref){ ref $val and kek($val); } } if( $typ eq 'ARRAY'){ for my $val( @$ref){ ref $val and kek($val); } } return; } __END__ $VAR1 = { "" => "dogs OR cats OR \"flying fish\" OR (shrimp AND squid)", "TERM" => [ "dogs", { "" => " OR", "OP" => "OR" }, "cats", { "" => " OR", "OP" => "OR" }, "\"flying fish\"", { "" => " OR", "OP" => "OR" }, { "" => " (shrimp AND squid)", "LIST" => { "" => "(shrimp AND squid)", "TERM" => [ "shrimp", { "" => " AND", "OP" => "AND" }, "squid" ] } } ] }; $VAR1 = { "TERM" => [ "dogs", { "OP" => "OR" }, "cats", { "OP" => "OR" }, "\"flying fish\"", { "OP" => "OR" }, { "LIST" => { "TERM" => [ "shrimp", { "OP" => "AND" }, "squid" ] } } ] }; $VAR1 = [ "OR", "dogs", "cats", "\"flying fish\"", [ "AND", "shrimp", "squid" ] ];