Open-ILS/src/perlmods/OpenILS/Reporter/SQLBuilder.pm

   1 package OpenILS::Reporter::SQLBuilder;
   2
   3 sub new {
   4         my $class = shift;
   5         $class = ref($class) || $class;
   6
   7         return bless { _sql => undef } => $class;
   8 }
   9
  10 sub register_params {
  11         my $self  = shift;
  12         my $p = shift;
  13         $self->{_params} = $p;
  14 }
  15
  16 sub get_param {
  17         my $self = shift;
  18         my $p = shift;
  19         return $self->{_builder}->{_params}->{$p};
  20 }
  21
  22 sub set_builder {
  23         my $self = shift;
  24         $self->{_builder} = shift;
  25         return $self;
  26 }
  27
  28 sub resolve_param {
  29         my $self = shift;
  30         my $val = shift;
  31
  32         if ($val =~ /^::(.+)$/o) {
  33                 return $self->get_param($1);
  34         }
  35
  36         return $val;
  37 }
  38
  39 sub parse_report {
  40         my $self = shift;
  41         my $report = shift;
  42
  43         $self->set_select( $report->{select} );
  44         $self->set_from( $report->{from} );
  45         $self->set_where( $report->{where} );
  46
  47         return $self;
  48 }
  49
  50 sub set_select {
  51         my $self = shift;
  52         my @cols = @_;
  53
  54         $self->{_select} = [];
  55
  56         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
  57
  58         push @{ $self->{_select} }, map { OpenILS::Reporter::SQLBuilder::Column::Select->new( $_ )->set_builder( $self ) } @cols;
  59
  60         return $self;
  61 }
  62
  63 sub set_from {
  64         my $self = shift;
  65         my $f = shift;
  66
  67         $self->{_from} = OpenILS::Reporter::SQLBuilder::Relation->parse( $f );
  68
  69         return $self;
  70 }
  71
  72 sub set_where {
  73         my $self = shift;
  74         my @cols = @_;
  75
  76         $self->{_where} = [];
  77
  78         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
  79
  80         push @{ $self->{_where} }, map { OpenILS::Reporter::SQLBuilder::Column::Where->new( $_ )->set_builder( $self ) } @cols;
  81
  82         return $self;
  83 }
  84
  85 sub toSQL {
  86         my $self = shift;
  87
  88         my $sql = "SELECT\t" . join(",\n\t", map { $_->toSQL } @{ $self->{_select} }) . "\n";
  89
  90         $sql .= "  FROM\t" . $self->{_from}->toSQL . "\n";
  91
  92         $sql .= "  WHERE\t" . join("\n\tAND ", map { $_->toSQL } @{ $self->{_where} }) . "\n";
  93
  94         my $gcount = 1;
  95         my @group_by;
  96         for my $c ( @{ $self->{_select} } ) {
  97                 push @group_by, $gcount if (!$c->is_aggregate);
  98                 $gcount++;
  99         }
 100
 101         $sql .= '  GROUP BY ' . join(', ', @group_by) . "\n" if (@group_by);
 102         $sql .= '  ORDER BY ' . join(', ', 1 .. scalar(@{ $self->{_select} })) . "\n";
 103
 104         return $sql;
 105 }
 106
 107
 108 package OpenILS::Reporter::SQLBuilder::Column;
 109 use base qw/OpenILS::Reporter::SQLBuilder/;
 110
 111 sub new {
 112         my $class = shift;
 113         my $self = $class->SUPER::new;
 114
 115         my $col_data = shift;
 116         $self->{_relation} = $col_data->{relation};
 117         $self->{_column} = $col_data->{column};
 118
 119         return $self;
 120 }
 121
 122 sub name {
 123         my $self = shift;
 124         if (ref($self->{_column})) {
 125                 my ($k) = keys %{$self->{_column}};
 126                 if (ref($self->{_column}->{$k})) {
 127                         return $self->resolve_param( $self->{_column}->{$k}->[0] );
 128                 } else {
 129                         return $self->resolve_param( $self->{_column}->{$k} );
 130                 }
 131         } else {
 132                 return $self->resolve_param( $self->{_column} );
 133         }
 134 }
 135
 136
 137 package OpenILS::Reporter::SQLBuilder::Column::Select;
 138 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 139
 140 sub new {
 141         my $class = shift;
 142         my $self = $class->SUPER::new(@_);
 143
 144         my $col_data = shift;
 145         $self->{_alias} = $col_data->{alias};
 146         $self->{_aggregate} = $col_data->{aggregate};
 147
 148         if (ref($self->{_column})) {
 149                 my $pkg = 'OpenILS::Reporter::SQLBuilder::Column::Select::Transform::' . (keys %{ $self->{_column} })[0];
 150                 if (UNIVERSAL::can($pkg => 'toSQL')) {
 151                         bless $self => $pkg;
 152                 } else {
 153                         bless $self => 'OpenILS::Reporter::SQLBuilder::Column::Select::GenericTransform';
 154                 }
 155         } else {
 156                 bless $self => 'OpenILS::Reporter::SQLBuilder::Column::Select::Bare';
 157         }
 158
 159         return $self;
 160 }
 161
 162
 163 package OpenILS::Reporter::SQLBuilder::Column::Select::GenericTransform;
 164 use base qw/OpenILS::Reporter::SQLBuilder::Column::Select/;
 165
 166 sub toSQL {
 167         my $self = shift;
 168         my $name = $self->name;
 169         my ($func) = keys %{ $self->{_column} };
 170
 171         my @params;
 172         @params = @{ $self->{_column}->{$func} } if (ref($self->{_column}->{$func}));
 173
 174         my $sql = $func . '("' . $self->{_relation} . '"."' . $self->name;
 175
 176         $sql .= ',' . join(',', @params) if (@params);
 177
 178         $sql .= '") AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 179
 180         return $sql;
 181 }
 182
 183 sub is_aggregate { return $self->{_aggregate} }
 184
 185
 186 package OpenILS::Reporter::SQLBuilder::Column::Select::Bare;
 187 use base qw/OpenILS::Reporter::SQLBuilder::Column::Select/;
 188
 189 sub toSQL {
 190         my $self = shift;
 191         return '"' . $self->{_relation} . '"."' . $self->name .
 192                 '" AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 193 }
 194
 195 sub is_aggregate { return 0 }
 196
 197
 198 package OpenILS::Reporter::SQLBuilder::Column::Select::Transform::count;
 199 use base qw/OpenILS::Reporter::SQLBuilder::Column::Select/;
 200
 201 sub toSQL {
 202         my $self = shift;
 203         return 'COUNT("' . $self->{_relation} . '"."' . $self->name .
 204                 '") AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 205 }
 206
 207 sub is_aggregate { return 1 }
 208
 209
 210 package OpenILS::Reporter::SQLBuilder::Column::Select::Transform::count_distinct;
 211 use base qw/OpenILS::Reporter::SQLBuilder::Column::Select/;
 212
 213 sub toSQL {
 214         my $self = shift;
 215         return 'COUNT(DISTINCT "' . $self->{_relation} . '"."' . $self->name .
 216                 '") AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 217 }
 218
 219 sub is_aggregate { return 1 }
 220
 221
 222 package OpenILS::Reporter::SQLBuilder::Column::Select::Transform::sum;
 223 use base qw/OpenILS::Reporter::SQLBuilder::Column::Select/;
 224
 225 sub toSQL {
 226         my $self = shift;
 227         return 'SUM("' . $self->{_relation} . '"."' . $self->name .
 228                 '") AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 229 }
 230
 231 sub is_aggregate { return 1 }
 232
 233
 234 package OpenILS::Reporter::SQLBuilder::Column::Select::Transform::average;
 235 use base qw/OpenILS::Reporter::SQLBuilder::Column::Select/;
 236
 237 sub toSQL {
 238         my $self = shift;
 239         return 'AVG("' . $self->{_relation} . '"."' . $self->name .
 240                 '") AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 241 }
 242
 243 sub is_aggregate { return 1 }
 244
 245
 246 package OpenILS::Reporter::SQLBuilder::Column::Where;
 247 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 248
 249 sub new {
 250         my $class = shift;
 251         my $self = $class->SUPER::new(@_);
 252
 253         my $col_data = shift;
 254         $self->{_condition} = $col_data->{condition};
 255
 256         return $self;
 257 }
 258
 259 sub toSQL {
 260         my $self = shift;
 261
 262         my $sql = '"' . $self->{_relation} . '"."' . $self->name . '"';
 263         my ($op) = keys %{ $self->{_condition} };
 264         my $val = $self->resolve_param( values %{ $self->{_condition} } );
 265
 266         if (lc($op) eq 'in') {
 267                 $val = [$val] unless (ref($val));
 268                 $sql .= " IN ('". join("','", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."')";
 269         } elsif (lc($op) eq 'not in') {
 270                 $val = [$val] unless (ref($val));
 271                 $sql .= " NOT IN ('". join("','", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."')";
 272         } elsif (lc($op) eq 'between') {
 273                 $val = [$val] unless (ref($val));
 274                 $sql .= " BETWEEN '". join("' AND '", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."'";
 275         } elsif (lc($op) eq 'not between') {
 276                 $val = [$val] unless (ref($val));
 277                 $sql .= " NOT BETWEEN '". join("' AND '", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."'";
 278         } else {
 279                 $val =~ s/'/\\'/go; $val =~ s/\\/\\\\/go;
 280                 $sql .= " $op '$val'";
 281         }
 282
 283         return $sql;
 284 }
 285
 286
 287 package OpenILS::Reporter::SQLBuilder::Relation;
 288 use base qw/OpenILS::Reporter::SQLBuilder/;
 289
 290 sub parse {
 291         my $self = shift;
 292         $self = $self->SUPER::new if (!ref($self));
 293
 294         my $rel_data = shift;
 295
 296         $self->{_table} = $rel_data->{table};
 297         $self->{_alias} = $rel_data->{alias};
 298         $self->{_join} = [];
 299         $self->{_columns} = [];
 300
 301         if ($rel_data->{join}) {
 302                 $self->add_join(
 303                         $_ => OpenILS::Reporter::SQLBuilder::Relation->parse( $rel_data->{join}->{$_} ) => $rel_data->{join}->{$_}->{key}
 304                 ) for ( keys %{ $rel_data->{join} } );
 305         }
 306
 307         return $self;
 308 }
 309
 310 sub add_column {
 311         my $self = shift;
 312         my $col = shift;
 313
 314         push @{ $self->{_columns} }, $col;
 315 }
 316
 317 sub find_column {
 318         my $self = shift;
 319         my $col = shift;
 320         return (grep { $_->name eq $col} @{ $self->{_columns} })[0];
 321 }
 322
 323 sub add_join {
 324         my $self = shift;
 325         my $col = shift;
 326         my $frel = shift;
 327         my $fkey = shift;
 328
 329         if (ref($col) eq 'OpenILS::Reporter::SQLBuilder::Join') {
 330                 push @{ $self->{_join} }, $col;
 331         } else {
 332                 push @{ $self->{_join} }, OpenILS::Reporter::SQLBuilder::Join->build( $self => $col, $frel => $fkey );
 333         }
 334
 335         return $self;
 336 }
 337
 338 sub is_join {
 339         my $self = shift;
 340         my $j = shift;
 341         $self->{_is_join} = $j if ($j);
 342         return $self->{_is_join};
 343 }
 344
 345 sub toSQL {
 346         my $self = shift;
 347         my $sql = $self->{_table} .' AS "'. $self->{_alias} .'"';
 348
 349         if (!$self->is_join) {
 350                 for my $j ( @{ $self->{_join} } ) {
 351                         $sql .= $j->toSQL;
 352                 }
 353         }
 354
 355         return $sql;
 356 }
 357
 358 package OpenILS::Reporter::SQLBuilder::Join;
 359 use base qw/OpenILS::Reporter::SQLBuilder/;
 360
 361 sub build {
 362         my $self = shift;
 363         $self = $self->SUPER::new if (!ref($self));
 364
 365         $self->{_left_rel} = shift;
 366         $self->{_left_col} = shift;
 367
 368         $self->{_right_rel} = shift;
 369         $self->{_right_col} = shift;
 370
 371         $self->{_right_rel}->is_join(1);
 372
 373         return $self;
 374 }
 375
 376 sub toSQL {
 377         my $self = shift;
 378         my $sql = "\n\tJOIN " . $self->{_right_rel}->toSQL .
 379                 ' ON ("' . $self->{_left_rel}->{_alias} . '"."' . $self->{_left_col} .
 380                 '" = "' . $self->{_right_rel}->{_alias} . '"."' . $self->{_right_col} . '")';
 381
 382         $sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
 383
 384         return $sql;
 385 }
 386
 387 1;