WAIT/Query/Base.pm

#                              -*- Mode: Cperl -*- 
# Query.pm -- 
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Fri Sep 13 13:05:52 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Fri Apr 14 16:27:01 2000
# Language        : CPerl
# Update Count    : 57
# Status          : Unknown, Use with caution!
#
# Copyright (c) 1996-1997, Ulrich Pfeifer
#

package WAIT::Query::Base;

sub new {
  my $type  = shift;
  my $table = shift;
  my $self  = {Table => $table};

  bless $self, ref($type) || $type;
  if (@_) {
    $self->add(@_);
  } else {
    $self;
  }
}

sub add {
  my ($self, $fldorref, %parm) = @_;
  my @fld = (ref $fldorref)?@$fldorref:$fldorref;
  my $fld;

  for $fld (@fld) {
    if (defined $parm{Plain}) {
      if (defined $self->{Plain}->{$fld}) {
        $self->{Plain}->{$fld} .= ' ' . $parm{Plain};
      } else {
        $self->{Plain}->{$fld}  =       $parm{Plain};
      }
    }
    if (defined $parm{Raw}) {
      if (defined $self->{Raw}->{$fld}) {
        $self->{Raw}->{$fld}->merge($parm{Raw});
      } else {
        $self->{Raw}->{$fld} =      $parm{Raw};
      }
    }
  }
  $self;
}

sub merge {
  my ($self, $other) = @_;
  my $fld;

  if (ref($self) ne ref($other)) {
    return $other->merge($self);
  }
  for $fld (keys %{$other->{Plain}}) {
    $self->add($fld, Plain => $other->{Plain}->{$fld});
  }
  for $fld (keys %{$other->{Raw}}) {
    $self->add($fld, Raw => $other->{Raw}->{$fld});
  }

  $self;
}

sub clone {
  my $self = shift;
  my %copy;
  my $fld;

  for $fld (keys %{$self->{Plain}}) {
    $copy{Plain}->{$fld} = $self->{Plain}->{$fld};
  }
  for $fld (keys %{$self->{Raw}}) {
    next unless defined $self->{Raw}->{$fld}; # XXX bug elsewere
    $copy{Raw}->{$fld} = $self->{Raw}->{$fld}->clone;
  }

  $self;
}

sub execute {
  my $self = shift;
  my $tb   = $self->{Table};
  my %result;
  my $fld;

  for $fld (keys %{$self->{Plain}}, keys %{$self->{Raw}}) {
    %r = $tb->search(
                     { attr => $fld,
                       cont => $self->{Plain}->{$fld},
                       raw  => $self->{Raw}->{$fld},
                       @_
                     }
                    );
    # warn sprintf("DEBUG: attr[%s]cont[%s]raw[%s]scalar keys %%r[%d]",
    #             $fld,
    #             $self->{Plain}->{$fld},
    #             $self->{Raw}->{$fld},
    #             scalar keys %r
    #            );
    my ($key, $val);
    while (($key, $val) = each %r) {
      if (exists $result{$key}) {
        $result{$key} += $val;
      } else {
        $result{$key}  = $val;
      }
    }
  }
  %result;
}

sub hilight {
  my $self = shift;
  $self->{Table}->hilight($_[0], $self->{Plain}, $self->{Raw})
}

sub flatten {
  my $self = shift;
  #print STDERR "WAIT::Query::Base::flatten($self)\n";
  $self->clone()
}

package WAIT::Query::bin;

sub new {
  my $type = shift;
  my $self = [@_];

  #print STDERR "WAIT::Query::bin::new $type $self\n";
  bless $self, ref($type) || $type;
}

sub flatten {
  my $self = shift;
  #print STDERR "WAIT::Query::bin::flatten($self)\n";
  $self->[0]->flatten->merge($self->[1]->flatten)
}

sub hilight {
  my $self  = shift;
  my $query = $self->flatten();

  $query->hilight(@_);
}

package WAIT::Query::and;

@ISA = qw(WAIT::Query::bin);

sub execute {
  my $self = shift;
  my %ra = $self->[0]->execute();
  my %rb = $self->[1]->execute();

  #print STDERR "WAIT::Query::and::execute\n";
  for (keys %ra) {
    if (exists $rb{$_}) {
      $ra{$_} *= $rb{$_};
      delete $ra{$_} if $ra{$_} <= 0;
    } else {
      delete $ra{$_};
    }
  }
  %ra;
}


sub merge {
  #print STDERR "WAIT::Query::and::merge(@_)\n";
  new WAIT::Query::or @_;        # XXX
}

package WAIT::Query::or;

@ISA = qw(WAIT::Query::bin);

sub execute {
  my $self = shift;
  my %ra = $self->[0]->execute();
  my %rb = $self->[1]->execute();

  for (keys %ra) {
    if (exists $rb{$_}) {
      $ra{$_} += $rb{$_}
    }
  }
  for (keys %rb) {
    unless (exists $ra{$_}) {
      $ra{$_} = $rb{$_}
    }
  }
  %ra;
}


sub merge {
  my $self = shift;

  if (ref($_[0]) eq 'WAIT::Query::Base') {
    $self->[0] = $self->[0]->merge($_[0]);
  } else {
    new WAIT::Query::or $self, @_;        # XXX
  }
}

package WAIT::Query::not;

@ISA = qw(WAIT::Query::and WAIT::Query::bin);

sub execute {
  my $self = shift;
  my %ra = $self->[0]->execute();
  my %rb = $self->[1]->execute();

  for (keys %ra) {
    if (exists $rb{$_}) {
      if (exists $ra{$_}) {
        $ra{$_} -= $rb{$_};
        delete $ra{$_} if $ra{$_} <= 0;
      }
    }
  }

  %ra;
}

package WAIT::Query::Raw;
use strict;
use Carp;

sub new {
  my $type = shift;
  my $self = shift;

  $self = {} unless defined $self;
  bless $self, ref($type) || $type;
}

sub clone {
  my $self = shift;
  my %copy;

  for (keys %$self) {
    $copy{$_} = [@{$self->{$_}}];
  }
  $self->new(\%copy);
}

# Modifies first argument
sub merge {
  my $self  = shift;
  my $other = shift;

  croak "$other is not at 'WAIT::Query'" unless ref($other) =~ /^WAIT::Query/;
  for (keys %$other) {
    if (exists $self->{$_}) {
      push @{$self->{$_}}, @{$other->{$_}}
    } else {
      $self->{$_} = $other->{$_};
    }
  }
}

1;
1	ulpfr	13	# -- Mode: Cperl --
2	ulpfr	10	# Query.pm --
3			# ITIID : $ITI$ $Header $__Header$
4			# Author : Ulrich Pfeifer
5			# Created On : Fri Sep 13 13:05:52 1996
6			# Last Modified By: Ulrich Pfeifer
7	ulpfr	19	# Last Modified On: Fri Apr 14 16:27:01 2000
8	ulpfr	10	# Language : CPerl
9	ulpfr	19	# Update Count : 57
10	ulpfr	10	# Status : Unknown, Use with caution!
11	ulpfr	13	#
12	ulpfr	10	# Copyright (c) 1996-1997, Ulrich Pfeifer
13	ulpfr	13	#
14	ulpfr	10
15			package WAIT::Query::Base;
16
17			sub new {
18			my $type = shift;
19			my $table = shift;
20			my $self = {Table => $table};
21	ulpfr	13
22	ulpfr	10	bless $self, ref($type) \|\| $type;
23			if (@_) {
24			$self->add(@_);
25			} else {
26			$self;
27			}
28			}
29
30			sub add {
31			my ($self, $fldorref, %parm) = @_;
32			my @fld = (ref $fldorref)?@$fldorref:$fldorref;
33			my $fld;
34
35			for $fld (@fld) {
36			if (defined $parm{Plain}) {
37			if (defined $self->{Plain}->{$fld}) {
38			$self->{Plain}->{$fld} .= ' ' . $parm{Plain};
39			} else {
40			$self->{Plain}->{$fld} = $parm{Plain};
41			}
42			}
43			if (defined $parm{Raw}) {
44			if (defined $self->{Raw}->{$fld}) {
45			$self->{Raw}->{$fld}->merge($parm{Raw});
46			} else {
47			$self->{Raw}->{$fld} = $parm{Raw};
48			}
49			}
50			}
51			$self;
52			}
53
54			sub merge {
55			my ($self, $other) = @_;
56			my $fld;
57
58			if (ref($self) ne ref($other)) {
59			return $other->merge($self);
60			}
61			for $fld (keys %{$other->{Plain}}) {
62			$self->add($fld, Plain => $other->{Plain}->{$fld});
63			}
64			for $fld (keys %{$other->{Raw}}) {
65			$self->add($fld, Raw => $other->{Raw}->{$fld});
66			}
67
68			$self;
69			}
70
71			sub clone {
72			my $self = shift;
73			my %copy;
74			my $fld;
75	ulpfr	13
76	ulpfr	10	for $fld (keys %{$self->{Plain}}) {
77			$copy{Plain}->{$fld} = $self->{Plain}->{$fld};
78			}
79			for $fld (keys %{$self->{Raw}}) {
80			next unless defined $self->{Raw}->{$fld}; # XXX bug elsewere
81			$copy{Raw}->{$fld} = $self->{Raw}->{$fld}->clone;
82			}
83
84			$self;
85			}
86
87			sub execute {
88			my $self = shift;
89			my $tb = $self->{Table};
90			my %result;
91			my $fld;
92	ulpfr	13
93	ulpfr	10	for $fld (keys %{$self->{Plain}}, keys %{$self->{Raw}}) {
94	ulpfr	19	%r = $tb->search(
95			{ attr => $fld,
96			cont => $self->{Plain}->{$fld},
97			raw => $self->{Raw}->{$fld},
98			@_
99			}
100	ulpfr	10	);
101	laperla	40	# warn sprintf("DEBUG: attr[%s]cont[%s]raw[%s]scalar keys %%r[%d]",
102			# $fld,
103			# $self->{Plain}->{$fld},
104			# $self->{Raw}->{$fld},
105			# scalar keys %r
106			# );
107	ulpfr	10	my ($key, $val);
108			while (($key, $val) = each %r) {
109			if (exists $result{$key}) {
110			$result{$key} += $val;
111			} else {
112			$result{$key} = $val;
113			}
114			}
115			}
116			%result;
117			}
118
119			sub hilight {
120			my $self = shift;
121			$self->{Table}->hilight($_[0], $self->{Plain}, $self->{Raw})
122			}
123
124			sub flatten {
125			my $self = shift;
126			#print STDERR "WAIT::Query::Base::flatten($self)\n";
127			$self->clone()
128			}
129
130			package WAIT::Query::bin;
131
132			sub new {
133			my $type = shift;
134			my $self = [@_];
135
136			#print STDERR "WAIT::Query::bin::new $type $self\n";
137			bless $self, ref($type) \|\| $type;
138			}
139
140			sub flatten {
141			my $self = shift;
142			#print STDERR "WAIT::Query::bin::flatten($self)\n";
143			$self->[0]->flatten->merge($self->[1]->flatten)
144			}
145
146			sub hilight {
147			my $self = shift;
148			my $query = $self->flatten();
149
150			$query->hilight(@_);
151			}
152
153			package WAIT::Query::and;
154
155			@ISA = qw(WAIT::Query::bin);
156
157			sub execute {
158			my $self = shift;
159			my %ra = $self->[0]->execute();
160			my %rb = $self->[1]->execute();
161
162			#print STDERR "WAIT::Query::and::execute\n";
163			for (keys %ra) {
164			if (exists $rb{$_}) {
165			$ra{$_} *= $rb{$_};
166			delete $ra{$_} if $ra{$_} <= 0;
167			} else {
168			delete $ra{$_};
169			}
170			}
171			%ra;
172			}
173
174
175			sub merge {
176			#print STDERR "WAIT::Query::and::merge(@_)\n";
177			new WAIT::Query::or @_; # XXX
178			}
179
180			package WAIT::Query::or;
181
182			@ISA = qw(WAIT::Query::bin);
183
184			sub execute {
185			my $self = shift;
186			my %ra = $self->[0]->execute();
187			my %rb = $self->[1]->execute();
188
189			for (keys %ra) {
190			if (exists $rb{$_}) {
191			$ra{$_} += $rb{$_}
192			}
193			}
194			for (keys %rb) {
195			unless (exists $ra{$_}) {
196			$ra{$_} = $rb{$_}
197			}
198			}
199			%ra;
200			}
201
202
203			sub merge {
204			my $self = shift;
205
206			if (ref($_[0]) eq 'WAIT::Query::Base') {
207			$self->[0] = $self->[0]->merge($_[0]);
208			} else {
209			new WAIT::Query::or $self, @_; # XXX
210			}
211			}
212
213			package WAIT::Query::not;
214
215			@ISA = qw(WAIT::Query::and WAIT::Query::bin);
216
217			sub execute {
218			my $self = shift;
219			my %ra = $self->[0]->execute();
220			my %rb = $self->[1]->execute();
221
222			for (keys %ra) {
223			if (exists $rb{$_}) {
224			if (exists $ra{$_}) {
225			$ra{$_} -= $rb{$_};
226			delete $ra{$_} if $ra{$_} <= 0;
227			}
228			}
229			}
230
231			%ra;
232			}
233
234			package WAIT::Query::Raw;
235			use strict;
236			use Carp;
237
238			sub new {
239			my $type = shift;
240			my $self = shift;
241
242			$self = {} unless defined $self;
243			bless $self, ref($type) \|\| $type;
244			}
245
246			sub clone {
247			my $self = shift;
248			my %copy;
249
250			for (keys %$self) {
251			$copy{$_} = [@{$self->{$_}}];
252			}
253			$self->new(\%copy);
254			}
255
256			# Modifies first argument
257			sub merge {
258			my $self = shift;
259			my $other = shift;
260
261			croak "$other is not at 'WAIT::Query'" unless ref($other) =~ /^WAIT::Query/;
262			for (keys %$other) {
263			if (exists $self->{$_}) {
264			push @{$self->{$_}}, @{$other->{$_}}
265			} else {
266			$self->{$_} = $other->{$_};
267			}
268			}
269			}
270
271			1;