1 package Yaala::Data::Core;
7 =head1 Yaala::Data::Core
9 Store data to the internal structure and retrieve it again.
14 use Yaala::Data::Setup qw#$USED_FIELDS $USED_AGGREGATIONS $SELECTS#;
15 use Yaala::Data::Convert qw#convert#;
16 use Yaala::Data::Persistent qw#init#;
18 @Yaala::Data::Core::EXPORT_OK = qw#receive store get_values#;
19 @Yaala::Data::Core::ISA = ('Exporter');
23 our $DATA = init ('$DATA', 'hash');
25 # holds the order of all fields stored in $DATA
26 our @FIELD_ORDER = ();
28 # holds all values for each field (key)
29 our $VALUES_PER_FIELD = init ('$VALUES_PER_FIELD', 'hash');
31 # sort fields by occurence count in the config file.
32 # This _might_ speed things up.
33 @FIELD_ORDER = (sort { $USED_FIELDS->{$b} <=> $USED_FIELDS->{$a} } (keys %$USED_FIELDS));
35 my $VERSION = '$Id: Core.pm,v 1.13 2003/12/09 09:12:05 octo Exp $';
36 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
41 import Data::Dumper qw#Dumper#;
48 =head2 Yaala::Data::Core::delete_fields (\%data)
50 Removes uninteresting fields from the hash-ref
57 foreach my $key (keys %$data)
59 unless (defined ($USED_FIELDS->{$key})
60 or defined ($USED_AGGREGATIONS->{$key}))
62 delete ($data->{$key});
67 =head2 Yaala::Data::Core:receive ($sel, $agg, \%query)
69 query data from the internal structure. Takes care of wildcards (missing
70 keys in the query hash) itself..
79 my $sel_string = $sel->[3];
83 print STDERR $/, "Bug: ", join (', ', caller ());
86 if (!defined ($DATA->{$sel_string}{$agg}))
88 print STDERR $/, __FILE__, ": Unavailable aggregation requested: ``$agg''. Returning 0.";
92 my $dump = Data::Dumper->Dump ([$sel, $query], [qw#$sel $query#]);
93 my $file = __FILE__ . ': ';
94 $dump =~ s/^/$file/gm;
95 $dump =~ s/[\n\r]+$//s;
96 print STDERR $/, $dump;
102 my $ptr = $DATA->{$sel_string}{$agg};
106 my $dump = Data::Dumper->Dump ([$query], ['$query']);
107 my $tmp = __FILE__ . ': ';
108 $dump =~ s/^/$tmp/gm;
109 $dump =~ s/[\n\r]+$//g;
110 print STDERR $/, $dump;
116 if (defined ($query->{$fld}))
118 if (defined ($ptr->{$query->{$fld}}))
120 $ptr = $ptr->{$query->{$fld}};
124 print STDERR $/, __FILE__, ': Unavailable field requested. Returning 0.'
125 if ($::DEBUG & 0x10);
132 my @val = keys (%{$VALUES_PER_FIELD->{$sel_string}{$fld}});
133 print STDERR $/, __FILE__, ': Query not unique. Performing subqueries for ',
134 scalar (@val), " values of field '$fld'." if ($::DEBUG & 0x10);
138 my %new_query = %$query;
139 $new_query{$fld} = $val;
140 $sum += receive ($sel, $agg, \%new_query);
142 print $/, __FILE__, ": Returning, \$sum = $sum" if ($::DEBUG & 0x10);
146 print $/, __FILE__, ": Returning, \$\$ptr = $$ptr" if ($::DEBUG & 0x10);
150 =head2 Yaala::Data::Core:store (\%data)
152 Saves data in the internal structure.
159 delete_fields ($data);
163 my $dump = Data::Dumper->Dump ([$data, $DATA], [qw#$data $DATA#]);
164 my $file = __FILE__ . ': ';
165 $dump =~ s/^/$file/gm;
166 $dump =~ s/[\n\r]+$//s;
167 print STDERR $/, $dump;
174 my $sel_string = $sel->[3];
176 my $total_fields = 0;
179 if (check_where_clauses ($sel, $data))
188 if (!defined $DATA->{$sel_string}{$agg}) { $DATA->{$sel_string}{$agg} = {}; }
189 my $ptr = $DATA->{$sel_string}{$agg};
191 print STDERR $/, __FILE__, ": \$DATA->{$sel_string}{$agg}" if ($::DEBUG & 0x10);
193 $total_fields = scalar (@{$sel->[1]});
194 for ($i = 0; $i < $total_fields; $i++)
196 my $fld = $sel->[1][$i];
198 my $field_value = convert ($fld, $data->{$fld});
199 print STDERR '{', $field_value, '}' if ($::DEBUG & 0x10);
201 if (!defined ($ptr->{$field_value}))
203 if ($i == ($total_fields - 1))
206 $ptr->{$field_value} = \$tmp;
210 $ptr->{$field_value} = {};
214 $ptr = $ptr->{$field_value};
216 $VALUES_PER_FIELD->{$sel_string}{$fld}{$field_value}++;
218 print STDERR " += ", $data->{$agg} if ($::DEBUG & 0x10);
220 if (!defined ($$ptr) or !defined ($data->{$agg}))
222 print STDERR $/, __FILE__, ': ',
223 Data::Dumper->Dump ([$sel, $data], [qw/sel data/]);
226 $$ptr += $data->{$agg};
234 my $sel_string = $sel->[3];
237 if (!defined ($VALUES_PER_FIELD->{$sel_string}))
239 print STDERR $/, __FILE__, ': selection not defined in $VALUES_PER_FIELD.' if ($::DEBUG);
243 my @vals = keys (%{$VALUES_PER_FIELD->{$sel_string}{$field}});
248 sub check_where_clauses
258 my ($key, $op, $val) = @$where;
261 if (!defined ($data->{$key}) and
267 print STDERR $/, __FILE__, ": \$data->{$key} not defined." if ($::DEBUG);
270 elsif (!defined ($data->{$key}) and
279 $data_val = $data->{$key};
283 if ($data_val =~ qr/$val/)
294 if ($data_val !~ qr/$val/)
306 my $eval = qq#if (\$data_val $op \$val) { \$retval = 0; } else { \$retval = 1; }#;
308 die ('eval: ' . $@) if ($@);
310 return (1) if ($retval);