[backend] fix typo in BSXPathKey. does not fix Adrian's search bug, though
[opensuse:build-service.git] / src / backend / BSXPathKeys.pm
1 #
2 # Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
3 #
4 # This program is free software; you can redistribute it and/or modify
5 # it under the terms of the GNU General Public License version 2 as
6 # published by the Free Software Foundation.
7 #
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11 # GNU General Public License for more details.
12 #
13 # You should have received a copy of the GNU General Public License
14 # along with this program (see the file COPYING); if not, write to the
15 # Free Software Foundation, Inc.,
16 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
17 #
18 ################################################################
19 #
20 # Abstract data implementation for the BSXPath engine. Data is
21 # identified via keys.
22 #
23
24
25 package BSXPathKeys;
26
27 use BSXPath;
28 use Data::Dumper;
29
30 use strict;
31
32 #
33 # needs:
34 #   db->values($path)       -> array of values;
35 #   db->keys($path, $value) -> array of keys;
36 #   db->fetch($key)         -> data;
37 #
38
39
40 #
41 # node types:
42 #
43 # value defined
44 #     -> concrete node element
45 #        keys/other must also be set, define value set
46 #
47 # keys defined
48 #     -> abstract node element
49 #        limited to keys
50 #
51 # all other
52 #     -> abstract node element, unlimited
53 #
54
55
56
57
58 sub node {
59   my ($db, $path, $limit) = @_;
60   my $v = bless {};
61   $v->{'db'} = $db;
62   $v->{'path'} = $path;
63   $v->{'limit'} = $limit;
64   return $v;
65 }
66
67 sub selectpath {
68   my ($v, $path) = @_;
69   $v = [ $v ] unless ref($v) eq 'ARRAY';
70   my @v = @$v;
71   my $c;
72   while(1) {
73     last if !defined($path) || $path eq '';
74     ($c, $path) = split('/', $path, 2);
75     for my $vv (splice(@v)) {
76       next unless ref($vv) eq 'HASH';
77       $vv = $vv->{$c};
78       next unless defined($vv);
79       push @v, ref($vv) eq 'ARRAY' ? @$vv : $vv;
80     }
81   }
82   return @v;
83 }
84
85 sub value {
86   my ($self) = @_;
87   my @v;
88   if (exists($self->{'value'})) {
89     return [ $self->{'value'} ];        # hmm, what about other?
90   }
91   my $db = $self->{'db'};
92   my $path = $self->{'path'};
93   if (!exists($self->{'keys'})) {
94     if (defined($path)) {
95       push @v, $db->values($path);
96     } else {
97       push @v, $db->keys();
98     }
99   } else {
100     die("413 search limit reached\n") if $self->{'limit'} && @{$self->{'keys'}} > $self->{'limit'};
101     for my $k (@{$self->{'keys'}}) {
102       my $v = $db->fetch($k);
103       next unless defined $v;
104       push @v, selectpath($v, $path);
105     }
106   }
107   die("413 search limit reached\n") if $self->{'limit'} && @v > $self->{'limit'};
108   return \@v;
109 }
110
111 sub step {
112   my ($self, $c) = @_;
113   return [] if exists $self->{'value'}; # can't step concrete value
114   my $v = bless {};
115   $v->{'db'} = $self->{'db'};
116   $v->{'keys'} = $self->{'keys'} if $self->{'keys'};
117   $v->{'limit'} = $self->{'limit'} if $self->{'limit'};
118   if ($self->{'path'} eq '') {
119     $v->{'path'} = "$c";
120   } else {
121     $v->{'path'} = "$self->{'path'}/$c";
122   }
123   return $v;
124 }
125
126 sub toconcrete {
127   my ($self) = @_;
128   my $vv = bless {};
129   $vv->{'db'} = $self->{'db'};
130   $vv->{'limit'} = $self->{'limit'} if $self->{'limit'};
131   if ($self->{'keys'}) {
132     $vv->{'keys'} = $self->{'keys'};
133     $vv->{'value'} = 'true';
134     $vv->{'other'} = '';
135   } else {
136     $vv->{'keys'} = [];
137     $vv->{'value'} = '';
138     $vv->{'other'} = 'true';
139   }
140   return $vv;
141 }
142
143 sub boolop {
144   my ($self, $v1, $v2, $op, $negpol) = @_;
145   if (ref($v1) ne ref($self) && ref($v2) ne ref($self)) {
146     return $op->($v1, $v2) ? 'true' : '';
147   }
148   #print "boolop ".Dumper($v1).Dumper($v2)."---\n";
149   #print "negated!\n" if $negpol;
150   if (ref($v1) eq ref($self) && ref($v2) eq ref($self)) {
151     $v1 = toconcrete($v1) unless exists $v1->{'value'};
152     $v2 = toconcrete($v2) unless exists $v2->{'value'};
153     my $v = bless {};
154     $v->{'db'} = $v1->{'db'};
155     $v->{'limit'} = $v1->{'limit'} if $v1->{'limit'};
156     my @k;
157     my %k1 = map {$_ => 1} @{$v1->{'keys'}};
158     my %k2 = map {$_ => 1} @{$v2->{'keys'}};
159     if ($op->($v1->{'other'}, $v2->{'other'})) {
160       push @k, grep {$k2{$_}} @{$v1->{'keys'}} if !$op->($v1->{'value'}, $v2->{'value'});
161       push @k, grep {!$k2{$_}} @{$v1->{'keys'}} if !$op->($v1->{'value'}, $v2->{'other'});
162       push @k, grep {!$k1{$_}} @{$v2->{'keys'}} if !$op->($v1->{'other'}, $v2->{'value'});
163       $v->{'value'} = '';
164       $v->{'other'} = 'true';
165     } else {
166       push @k, grep {$k2{$_}} @{$v1->{'keys'}} if $op->($v1->{'value'}, $v2->{'value'});
167       push @k, grep {!$k2{$_}} @{$v1->{'keys'}} if $op->($v1->{'value'}, $v2->{'other'});
168       push @k, grep {!$k1{$_}} @{$v2->{'keys'}} if $op->($v1->{'other'}, $v2->{'value'});
169       $v->{'value'} = 'true';
170       $v->{'other'} = '';
171     }
172     $v->{'keys'} = \@k;
173     return $v;
174   }
175   if (ref($v1) eq ref($self)) {
176     my $v = bless {};
177     $v->{'db'} = $v1->{'db'};
178     $v->{'limit'} = $v1->{'limit'} if $v1->{'limit'};
179     my $db = $v1->{'db'};
180     if (exists($v1->{'value'})) {
181       $v->{'keys'} = $v1->{'keys'};
182       $v->{'value'} = $op->($v1->{'value'}, $v2) ? 'true' : '';
183       $v->{'other'} = $op->($v1->{'other'}, $v2) ? 'true' : '';
184       return $v;
185     }
186     my @k;
187     my %k = map {$_ => 1} @{$v1->{'keys'} || []};
188     if ($v1->{'keys'} && !@{$v1->{'keys'}}) {
189       @k = ();
190     } elsif ($op == \&BSXPath::boolop_eq) {
191       @k = $db->keys($v1->{'path'}, $v2, $v1->{'keys'});
192       @k = grep {$k{$_}} @k if $v1->{'keys'};
193       #die("413 search limit reached\n") if $v1->{'limit'} && @k > $v1->{'limit'};
194       $negpol = 0;
195     } else {
196       my @values = $db->values($v1->{'path'}, $v1->{'keys'});
197       if ($v1->{'keys'} && @values > @{$v1->{'keys'}}) {
198         for my $k (@{$v1->{'keys'}}) {
199           my $vv = $db->fetch($k);
200           next unless defined $vv;
201           if (!$negpol) {
202             next unless grep {$op->($_, $v2)} selectpath($vv, $v1->{'path'});
203           } else {
204             next if grep {$op->($_, $v2)} selectpath($vv, $v1->{'path'});
205           }
206           push @k, $k;
207         }
208       } else {
209         for my $vv (@values) {
210           if (!$negpol) {
211             next unless $op->($vv, $v2);
212           } else {
213             next if $op->($vv, $v2);
214           }
215           if ($v1->{'keys'}) {
216             push @k, grep {$k{$_}} $db->keys($v1->{'path'}, $vv, $v1->{'keys'});
217           } else {
218             push @k, $db->keys($v1->{'path'}, $vv, $v1->{'keys'});
219           }
220           die("413 search limit reached\n") if $v1->{'limit'} && @k > $v1->{'limit'};
221         }
222       }
223     }
224     $v->{'keys'} = \@k;
225     $v->{'value'} = $negpol ? '' : 'true';
226     $v->{'other'} = $negpol ? 'true' : '';
227     #print "==> ".Dumper($v)."<===\n";
228     return $v;
229   }
230   if (ref($v2) eq ref($self)) {
231     my $v = bless {};
232     $v->{'db'} = $v1->{'db'};
233     $v->{'limit'} = $v1->{'limit'} if $v1->{'limit'};
234     my $db = $v1->{'db'};
235     if (exists($v2->{'value'})) {
236       $v->{'keys'} = $v2->{'keys'};
237       $v->{'value'} = $op->($v1, $v2->{'value'}) ? 'true' : '';
238       $v->{'other'} = $op->($v1, $v2->{'other'}) ? 'true' : '';
239       return $v;
240     }
241     my @k;
242     my %k = map {$_ => 1} @{$v2->{'keys'} || []};
243     if ($v2->{'keys'} && !@{$v2->{'keys'}}) {
244       @k = ();
245     } elsif ($op == \&BSXPath::boolop_eq) {
246       @k = $db->keys($v2->{'path'}, $v1, $v2->{'keys'});
247       @k = grep {$k{$_}} @k if $v2->{'keys'};
248       #die("413 search limit reached\n") if $v2->{'limit'} && @k > $v2->{'limit'};
249       $negpol = 0;
250     } else {
251       my @values = $db->values($v2->{'path'}, $v2->{'keys'});
252       if ($v2->{'keys'} && @values > @{$v2->{'keys'}}) {
253         for my $k (@{$v2->{'keys'}}) {
254           my $vv = $db->fetch($k);
255           next unless defined $vv;
256           if (!$negpol) {
257             next unless grep {$op->($v1, $_)} selectpath($vv, $v2->{'path'});
258           } else {
259             next if grep {$op->($v1, $_)} selectpath($vv, $v2->{'path'});
260           }
261           push @k, $k;
262         }
263       } else {
264         for my $vv (@values) {
265           if (!$negpol) {
266             next unless $op->($v1, $vv);
267           } else {
268             next if $op->($v1, $vv);
269           }
270           if ($v2->{'keys'}) {
271             push @k, grep {$k{$_}} $db->keys($v2->{'path'}, $vv, $v2->{'keys'});
272           } else {
273             push @k, $db->keys($v2->{'path'}, $vv, $v2->{'keys'});
274           }
275         }
276       }
277     }
278     $v->{'keys'} = \@k;
279     $v->{'value'} = $negpol ? '' : 'true';
280     $v->{'other'} = $negpol ? 'true' : '';
281     return $v;
282   }
283 }
284
285 sub op {
286   my ($self, $v1, $v2, $op) = @_;
287   if (ref($v1) ne ref($self) && ref($v2) ne ref($self)) {
288     return $op->($v1, $v2);
289   }
290   die("op not implemented for abstract elements\n");
291 }
292
293 sub predicate {
294   my ($self, $v) = @_;
295   if (ref($v) ne ref($self)) {
296     $v = @$v ? 'true' : '' if ref($v) eq 'ARRAY';
297     if ($v =~ /^-?\d+$/) {
298       die("enumeration not implemented for abstract elements\n");
299     } else {
300       return $v ? $self : [];
301     }
302   }
303   $v = toconcrete($v) unless exists $v->{'value'};
304   my $vv = bless {};
305   $vv->{'db'} = $self->{'db'};
306   $vv->{'path'} = $self->{'path'};
307   $vv->{'limit'} = $self->{'limit'} if $self->{'limit'};
308   my @k;
309   if ($v->{'value'}) {
310     @k = @{$v->{'keys'}};
311   } elsif ($v->{'other'}) {
312     my %k = map {$_ => 1} @{$v->{'keys'}};
313     @k = grep {!$k{$_}} $self->{'db'}->keys();
314   }
315   if (@k && $self->{'keys'}) {
316     my %k = map {$_ => 1} @{$self->{'keys'}};
317     @k = grep {$k{$_}} @k;
318   }
319   $vv->{'keys'} = \@k;
320   return $vv;
321 }
322
323 sub keymatch {
324   my ($self, $expr) = @_;
325   my $v;
326   ($v, $expr) = BSXPath::predicate([[$self, $self, 1, 1]], $expr, [$self]);
327   die("junk at and of expr: $expr\n") if $expr ne '';
328   return $v->[0]->{'keys'} || [];
329 }
330
331 sub limit {
332   my ($self, $v) = @_;
333   if (ref($v) ne ref($self)) {
334     return $self;
335   }
336   return $self if $self->{'value'};
337   if ($v->{'value'}) {
338     my @k = @{$v->{'keys'}};
339     my $vv = bless {};
340     $vv->{'db'} = $self->{'db'};
341     $vv->{'limit'} = $self->{'limit'} if $self->{'limit'};
342     $vv->{'path'} = $self->{'path'};
343     if (@k && $self->{'keys'}) {
344       my %k = map {$_ => 1} @{$self->{'keys'}};
345       @k = grep {$k{$_}} @k;
346     }
347     $vv->{'keys'} = \@k;
348     return $vv;
349   } else {
350     return $self;
351   }
352 }
353
354 1;