lib/Yaala/Data/Setup.pm

   1 package Yaala::Data::Setup;
   2
   3 use strict;
   4 use warnings;
   5 use vars qw#$USED_FIELDS $USED_AGGREGATIONS $SELECTS %DATAFIELDS#;
   6
   7 =head1 Yaala::Data::Setup
   8
   9 This module is currently under construction.
  10
  11 =cut
  12
  13 use Exporter;
  14 use Carp qw#carp cluck croak confess#;
  15 use Yaala::Config qw#get_config#;
  16 use Yaala::Data::Persistent qw#init#;
  17
  18 import Yaala::Parser qw#%DATAFIELDS#;
  19
  20 @Yaala::Data::Setup::ISA = ('Exporter');
  21 @Yaala::Data::Setup::EXPORT_OK = qw#$USED_FIELDS $USED_AGGREGATIONS $SELECTS %DATAFIELDS#;
  22 import Yaala::Parser qw#%DATAFIELDS#;
  23
  24 $USED_FIELDS = init ('$USED_FIELDS', 'hash');
  25 $USED_AGGREGATIONS = init ('$USED_AGGREGATIONS', 'hash');
  26 $SELECTS = init ('$SELECTS', 'array');
  27
  28 my $VERSION = '$Id: Setup.pm,v 1.14 2003/12/07 14:52:22 octo Exp $';
  29 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  30
  31 if ($::DEBUG & 0x20)
  32 {
  33         require Data::Dumper;
  34         import Data::Dumper qw#Dumper#;
  35 }
  36
  37 read_config ();
  38
  39 return (1);
  40
  41 =head1 Routines
  42
  43 =head2 Yaala::Data::Setup::read_config
  44
  45 Parses the select-statements in the config file and returns configuration
  46 data. To be called by Yaala::Data::Core.
  47
  48 =cut
  49 sub read_config
  50 {
  51         print STDERR $/, __FILE__, ': ',
  52         Data::Dumper->Dump ([\%DATAFIELDS], ['DATAFIELDS']) if ($::DEBUG & 0x20);
  53
  54         unless (get_config ('select'))
  55         {
  56                 print STDERR $/, __FILE__, ": Please edit the config file first!\n";
  57                 exit (1);
  58         }
  59
  60         for (get_config ('select'))
  61         {
  62                 print STDERR $/, __FILE__, ": Select statement from config file: '$_'" if ($::DEBUG & 0x20);
  63                 my $select = parse_select ($_);
  64
  65                 next unless (defined ($select));
  66
  67                 push (@$SELECTS, $select);
  68
  69                 $USED_AGGREGATIONS->{$_}++ for (@{$select->[0]});
  70                 $USED_FIELDS->{$_}++ for (@{$select->[1]});
  71                 $USED_FIELDS->{$_->[0]}++ for (@{$select->[2]});
  72
  73                 print STDERR $/, __FILE__, ': New selection: ',
  74                 Data::Dumper->Dump ([$select], ['select']) if ($::DEBUG & 0x20);
  75         }
  76
  77         if (!scalar (@$SELECTS))
  78         {
  79                 print STDERR $/, __FILE__, ": No valid select-statements found. Exiting.\n";
  80                 exit (1);
  81         }
  82 }
  83
  84 # select: agg   from fld1 [, fld2] [where fld3   = "value"    ];
  85 # select: bytes from date [, time] [where client = "leeloo.ff"];
  86 sub parse_select
  87 {
  88         my $line = shift;
  89         my $retval;
  90
  91         $line =~ s/\s\s+/ /g;
  92
  93         if (grep { $line eq $_->[3] } (@$SELECTS))
  94         {
  95                 print STDERR $/, __FILE__, ": Found duplicated selection ``$line''.",
  96                 $/, __FILE__, ": This is probably coming from Yaala::Data::Persistent and is nothing to worry about."
  97                 if ($::DEBUG);
  98
  99                 return (undef);
 100         }
 101
 102         #if ($line =~ m/^(\w+) BY (\w+(?:,\s?\w+)*)(?: WHERE (.+))?$/i)
 103         if ($line =~ m/^(\w+(?:\s*,\s*\w+)*)\s+BY\s+(\w+(?:\s*,\s*\w+)*)(?:\s+WHERE\s+(.+))?$/i)
 104         {
 105                 my ($agg_exp, $fld_exp, $where_exp) = ($1, $2, $3);
 106
 107                 my @aggs = ();
 108                 for (split (m/\s*,\s*/, $agg_exp))
 109                 {
 110                         my $agg = lc ($_);
 111
 112                         if (!defined ($DATAFIELDS{$agg}))
 113                         {
 114                                 print STDERR $/, __FILE__, ": Aggregation ``$agg'' not provided by parser. ",
 115                                 "Ignoring this aggregation.";
 116                                 next;
 117                         }
 118                         elsif ($DATAFIELDS{$agg} !~ m/^agg/i)
 119                         {
 120                                 print STDERR $/, __FILE__, ": ``$agg'' is not an aggregation. Ignoring it.";
 121                                 next;
 122                         }
 123
 124                         push (@aggs, $agg);
 125                 }
 126                 if (!scalar (@aggs))
 127                 {
 128                         print STDERR $/, __FILE__, ": No valid aggregation found. Ignoring this select-statement.";
 129                         return (undef);
 130                 }
 131
 132                 my @fields = ();
 133                 for (split (m/\s*,\s*/, $fld_exp))
 134                 {
 135                         my $fld = lc ($_);
 136
 137                         if (!defined ($DATAFIELDS{$fld}))
 138                         {
 139                                 print STDERR $/, __FILE__, ": Field '$fld' not provided by parser. Ignoring it.";
 140                                 next;
 141                         }
 142
 143                         push (@fields, $fld);
 144                 }
 145                 if (!scalar (@fields))
 146                 {
 147                         print STDERR $/, __FILE__, ": No valid fields found. Ignoring this select-statement.";
 148                         return (undef);
 149                 }
 150
 151                 my @wheres = parse_where ($where_exp);
 152
 153                 $retval = [\@aggs, \@fields, \@wheres, $line];
 154         }
 155         else
 156         {
 157                 print STDERR $/, __FILE__, ": Unable to parse select statement:",
 158                 $/, __FILE__, ":     $line",
 159                 $/, __FILE__, ": Ignoring it.";
 160         }
 161
 162         return ($retval);
 163 }
 164
 165 # where ...
 166 # key = "val"
 167 # key =~ "regex"
 168 # key < val
 169 # key > val
 170 # key == val
 171 sub parse_where
 172 {
 173         my $where_exp = shift;
 174         my @where = ();
 175
 176         if (!defined ($where_exp))
 177         {
 178                 return (@where);
 179         }
 180
 181         for (split (m/\s?,\s?/, $where_exp))
 182         {
 183                 my $exp = $_;
 184                 if ($exp =~ m/(\w+)\s?([<>=~!]+)\s?(.+)/)
 185                 {
 186                         my ($fld, $op, $val) = ($1, $2, $3);
 187                         if (!defined ($DATAFIELDS{$fld}))
 188                         {
 189                                 print STDERR $/, __FILE__, ": Error in where-clause: Field '$fld' ",
 190                                 "is unknown. Ignoring it.";
 191                                 next;
 192                         }
 193
 194                         my $type = '';
 195                         if ($DATAFIELDS{$fld} =~ m/:/)
 196                         {
 197                                 $type = (split (m/:/, $DATAFIELDS{$fld}))[1];
 198                         }
 199
 200                         unless ($op =~ m/^[<>=!]=$/
 201                                         or $op eq '=~'
 202                                         or $op eq '!~'
 203                                         or $op eq '<' or $op eq '>')
 204                         {
 205                                 print STDERR $/, __FILE__, ": Error in where-clause: Operator '$op' ",
 206                                 "is unknown. Ignoring it.";
 207                                 next;
 208                         }
 209
 210                         $val =~ s/^['"]|['"]$//g;
 211
 212                         if ($type ne 'numeric')
 213                         {
 214                                 $op = 'eq' if ($op eq '==');
 215                                 $op = 'ne' if ($op eq '!=');
 216                                 $op = 'gt' if ($op eq '>');
 217                                 $op = 'ge' if ($op eq '>=');
 218                                 $op = 'lt' if ($op eq '<');
 219                                 $op = 'le' if ($op eq '<=');
 220                         }
 221                         elsif ($type eq 'numeric' and
 222                                 ($op eq '=~' or $op eq '!~'))
 223                         {
 224                                 print STDERR $/, __FILE__, ": Error in where clause: Can't use regex ",
 225                                 "with numeric field $fld. Ignoring this clause.";
 226                                 next;
 227                         }
 228
 229                         print STDERR $/, __FILE__, ":     New where-statement: [$fld, $op, $val]" if ($::DEBUG & 0x20);
 230
 231                         push (@where, [$fld, $op, $val]);
 232                 }
 233                 else
 234                 {
 235                         print STDERR $/, __FILE__, ": Error in where-clause: Unable to parse '$exp'. ",
 236                         "Ignoring it.";
 237                 }
 238         }
 239
 240         return (@where);
 241 }