1#!/usr/bin/perl 2 3use Data::Dumper; 4 5$express= { 6 type=>'AND', 7# type=>'OR', 8# arg1=>{type=>'REF', arg1=>'a'}, 9 arg1=>{type=>'NOT', arg1=>{type=>'REF', arg1=>'a'}}, 10 arg2=>{type=>'REF', arg1=>'b'} 11 }; 12 13$list= ['a','b', 'ab','abc', 'ac', 'c','bc']; 14 15#print Dumper($express); 16#print Dumper($list); 17 18# WARNING: NOT doesn't work properly unless it's surrounded by parenthesis 19 20#$string= "a AND (NOT c) AND b"; 21#$string= "NOT (a AND b AND c)"; 22#$string= "(a AND (NOT b)) OR (b AND (NOT a))"; 23#$string= "(a OR b) AND (NOT (a AND b))"; 24$string= "(a) AND (b)"; 25$express= read_express(\$string); 26print Dumper($express),"\n"; 27print join(" ",@{eval_express($express, $list)}),"\n"; 28 29sub eval_express{ 30 my $express= shift; 31 my $list= shift; 32 33 my $type= $express->{type}; 34 my $arg1= $express->{arg1}; 35 my $arg2= $express->{arg2}; 36 if ($type eq 'AND'){ 37 return(eval_express($arg2, eval_express($arg1,$list))); 38 } 39 elsif ($type eq 'OR'){ 40 my $list1= eval_express($arg1, $list); 41 my $list2= eval_express($arg2, $list); 42 return([@$list1,@$list2]); 43 } 44 elsif ($type eq 'XOR'){ 45 my $list1= eval_express($arg1, $list); 46 my $list2= eval_express($arg2, $list); 47 my %remove=(); 48 for my $item (@$list1){ 49 $remove{$item}=1; 50 } 51 my @lnew=(); 52 for my $item (@$list2){ 53 push @lnew, $item if (!($remove{$item})); 54 } 55 return([@lnew]); 56 } 57 elsif ($type eq 'NOT'){ 58 my $list1= eval_express($arg1, $list); 59 my %remove=(); 60 for my $item (@$list1){ 61 $remove{$item}=1; 62 } 63 my @lnew=(); 64 for my $item (@$list){ 65 push @lnew, $item if (!($remove{$item})); 66 } 67 return([@lnew]); 68 } 69 elsif ($type eq 'REF'){ 70 my @lnew= (); 71 for my $item (@$list){ 72 if ($item=~ /$arg1/){ 73 push @lnew, $item; 74 } 75 } 76 return([@lnew]); 77 } 78 else { 79 return(""); 80 } 81} 82 83{ 84 my $open=0; 85 86 sub read_express { 87 my $string= shift; 88 my $express=""; 89 my $expect_arg1=0; 90 my $expect_arg2=0; 91 while ($$string ne ""){ 92 my $nh={}; 93 $$string=~ s/^\s+//; 94 if ($$string=~ s/^\(// ){ 95 ++$open; 96 $nh= read_express($string); 97 } 98 elsif ($$string=~ s/^AND\s+//){ 99 $nh->{type}= 'AND'; 100 die "Null first operand for AND" unless ($express ne ""); 101 $nh->{arg1}= $express; 102 $express= $nh; 103 $expect_arg2=1; 104 next; 105 } 106 elsif ($$string=~ s/^OR\s+//){ 107 $nh->{type}= 'OR'; 108 die "Null first operand for OR" unless ($express ne ""); 109 $nh->{arg1}= $express; 110 $express= $nh; 111 $expect_arg2=1; 112 next; 113 } 114 elsif ($$string=~ s/^XOR\s+//){ 115 die "XOR not yet implemented"; 116 $nh->{type}= 'XOR'; 117 die "Null first operand for XOR" unless ($express ne ""); 118 $nh->{arg1}= $express; 119 $express= $nh; 120 $expect_arg2=1; 121 next; 122 } 123 elsif ($$string=~ s/^NOT\s+//){ 124 $nh->{type}= 'NOT'; 125 $express= $nh; 126 $expect_arg1=1; 127 next; 128 } 129 elsif ($$string=~ s/^([^\s\)]+)//){ 130 $nh->{type}='REF'; 131 $nh->{arg1}=$1; 132 } 133 elsif ($$string=~ s/^\)// ){ 134 --$open; 135 die "Unmatched end parenthesis" if ($open<0); 136 die "Empty parenthesis" if ($express eq ""); 137 return($express); 138 } 139 # print Dumper($nh),"\n"; 140 if ($express eq ""){ 141 $express= $nh; 142 } 143 elsif($expect_arg1){ 144 $express->{arg1}=$nh; 145 $expect_arg1=0; 146 } 147 elsif($expect_arg2){ 148 $express->{arg2}=$nh; 149 $expect_arg2=0; 150 } 151 else{ 152 die "Expression without operator"; 153 } 154 } 155 if ($expect_arg1){ 156 die "Missing unary operand"; 157 } 158 if ($expect_arg2){ 159 die "Missing binary operand"; 160 } 161 die "Missing end parenthesis" unless ($open==0); 162 return($express); 163 } 164} 165