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

   1 #-------------------------------------------------------------------------------------------------
   2 package OpenILS::Reporter::SQLBuilder;
   3
   4 sub new {
   5         my $class = shift;
   6         $class = ref($class) || $class;
   7
   8         return bless { _sql => undef } => $class;
   9 }
  10
  11 sub register_params {
  12         my $self  = shift;
  13         my $p = shift;
  14         $self->{_params} = $p;
  15 }
  16
  17 sub get_param {
  18         my $self = shift;
  19         my $p = shift;
  20         return $self->{_builder}->{_params}->{$p};
  21 }
  22
  23 sub set_builder {
  24         my $self = shift;
  25         $self->{_builder} = shift;
  26         return $self;
  27 }
  28
  29 sub resolve_param {
  30         my $self = shift;
  31         my $val = shift;
  32
  33         if ($val =~ /^::(.+)$/o) {
  34                 $val = $self->get_param($1);
  35         }
  36
  37         $val =~ s/\\/\\\\/go;
  38         $val =~ s/"/\\"/go;
  39         return $val;
  40 }
  41
  42 sub parse_report {
  43         my $self = shift;
  44         my $report = shift;
  45
  46         $self->set_select( $report->{select} );
  47         $self->set_from( $report->{from} );
  48         $self->set_where( $report->{where} );
  49         $self->set_having( $report->{having} );
  50         $self->set_order_by( $report->{order_by} );
  51
  52         return $self;
  53 }
  54
  55 sub set_select {
  56         my $self = shift;
  57         my @cols = @_;
  58
  59         $self->{_select} = [];
  60
  61         return $self unless (@cols && defined($cols[0]));
  62         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
  63
  64         push @{ $self->{_select} }, map { OpenILS::Reporter::SQLBuilder::Column::Select->new( $_ )->set_builder( $self ) } @cols;
  65
  66         return $self;
  67 }
  68
  69 sub set_from {
  70         my $self = shift;
  71         my $f = shift;
  72
  73         $self->{_from} = OpenILS::Reporter::SQLBuilder::Relation->parse( $f );
  74
  75         return $self;
  76 }
  77
  78 sub set_where {
  79         my $self = shift;
  80         my @cols = @_;
  81
  82         $self->{_where} = [];
  83
  84         return $self unless (@cols && defined($cols[0]));
  85         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
  86
  87         push @{ $self->{_where} }, map { OpenILS::Reporter::SQLBuilder::Column::Where->new( $_ )->set_builder( $self ) } @cols;
  88
  89         return $self;
  90 }
  91
  92 sub set_having {
  93         my $self = shift;
  94         my @cols = @_;
  95
  96         $self->{_having} = [];
  97
  98         return $self unless (@cols && defined($cols[0]));
  99         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
 100
 101         push @{ $self->{_having} }, map { OpenILS::Reporter::SQLBuilder::Column::Having->new( $_ )->set_builder( $self ) } @cols;
 102
 103         return $self;
 104 }
 105
 106 sub set_order_by {
 107         my $self = shift;
 108         my @cols = @_;
 109
 110         $self->{_order_by} = [];
 111
 112         return $self unless (@cols && defined($cols[0]));
 113         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
 114
 115         push @{ $self->{_order_by} }, map { OpenILS::Reporter::SQLBuilder::Column::OrderBy->new( $_ )->set_builder( $self ) } @cols;
 116
 117         return $self;
 118 }
 119
 120 sub toSQL {
 121         my $self = shift;
 122
 123         my $sql = "SELECT\t" . join(",\n\t", map { $_->toSQL } @{ $self->{_select} }) . "\n" if (@{ $self->{_select} });
 124
 125         $sql .= "  FROM\t" . $self->{_from}->toSQL . "\n" if ($self->{_from});
 126
 127         $sql .= "  WHERE\t" . join("\n\tAND ", map { $_->toSQL } @{ $self->{_where} }) . "\n" if (@{ $self->{_where} });
 128
 129         my $gcount = 1;
 130         my @group_by;
 131         for my $c ( @{ $self->{_select} } ) {
 132                 push @group_by, $gcount if (!$c->is_aggregate);
 133                 $gcount++;
 134         }
 135
 136         $sql .= '  GROUP BY ' . join(', ', @group_by) . "\n" if (@group_by);
 137         $sql .= "  HAVING " . join("\n\tAND ", map { $_->toSQL } @{ $self->{_having} }) . "\n" if (@{ $self->{_having} });
 138         $sql .= '  ORDER BY ' . join(', ', map { $_->toSQL } @{ $self->{_order_by} }) . "\n" if (@{ $self->{_order_by} });
 139
 140         return $sql;
 141 }
 142
 143
 144 #-------------------------------------------------------------------------------------------------
 145 package OpenILS::Reporter::SQLBuilder::Column;
 146 use base qw/OpenILS::Reporter::SQLBuilder/;
 147
 148 sub new {
 149         my $class = shift;
 150         my $self = $class->SUPER::new;
 151
 152         my $col_data = shift;
 153         $self->{_relation} = $col_data->{relation};
 154         $self->{_column} = $col_data->{column};
 155
 156         $self->{_aggregate} = $col_data->{aggregate};
 157
 158         if (ref($self->{_column})) {
 159                 my ($trans) = keys %{ $self->{_column} };
 160                 my $pkg = "OpenILS::Reporter::SQLBuilder::Column::Transform::$trans";
 161                 if (UNIVERSAL::can($pkg => 'toSQL')) {
 162                         $self->{_transform} = $trans;
 163                 } else {
 164                         $self->{_transform} = 'GenericTransform';
 165                 }
 166         } else {
 167                 $self->{_transform} = 'Bare';
 168         }
 169
 170
 171         return $self;
 172 }
 173
 174 sub name {
 175         my $self = shift;
 176         if (ref($self->{_column})) {
 177                 my ($k) = keys %{$self->{_column}};
 178                 if (ref($self->{_column}->{$k})) {
 179                         return $self->resolve_param( $self->{_column}->{$k}->[0] );
 180                 } else {
 181                         return $self->resolve_param( $self->{_column}->{$k} );
 182                 }
 183         } else {
 184                 return $self->resolve_param( $self->{_column} );
 185         }
 186 }
 187
 188 sub toSQL {
 189         my $self = shift;
 190         my $type = $self->{_transform};
 191         my $toSQL = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::toSQL";
 192         return $self->$toSQL;
 193 }
 194
 195 sub is_aggregate {
 196         my $self = shift;
 197         my $type = $self->{_transform};
 198         my $is_agg = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::is_aggregate";
 199         return $self->$is_agg;
 200 }
 201
 202
 203 #-------------------------------------------------------------------------------------------------
 204 package OpenILS::Reporter::SQLBuilder::Column::OrderBy;
 205 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 206
 207 sub new {
 208         my $class = shift;
 209         my $self = $class->SUPER::new(@_);
 210
 211         my $col_data = shift;
 212         $self->{_direction} = $col_data->{direction} || 'ascending';
 213         return $self;
 214 }
 215
 216 sub toSQL {
 217         my $self = shift;
 218         my $dir = ($self->{_direction} =~ /^d/oi) ? 'DESC' : 'ASC';
 219         return $self->SUPER::toSQL .  " $dir";
 220 }
 221
 222
 223 #-------------------------------------------------------------------------------------------------
 224 package OpenILS::Reporter::SQLBuilder::Column::Select;
 225 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 226
 227 sub new {
 228         my $class = shift;
 229         my $self = $class->SUPER::new(@_);
 230
 231         my $col_data = shift;
 232         $self->{_alias} = $col_data->{alias};
 233         return $self;
 234 }
 235
 236 sub toSQL {
 237         my $self = shift;
 238         return $self->SUPER::toSQL .  ' AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 239 }
 240
 241
 242 #-------------------------------------------------------------------------------------------------
 243 package OpenILS::Reporter::SQLBuilder::Column::Transform::GenericTransform;
 244
 245 sub toSQL {
 246         my $self = shift;
 247         my $name = $self->name;
 248         my ($func) = keys %{ $self->{_column} };
 249
 250         my @params;
 251         @params = @{ $self->{_column}->{$func} } if (ref($self->{_column}->{$func}));
 252         shift @params if (@params);
 253
 254         my $sql = $func . '("' . $self->{_relation} . '"."' . $self->name . '"';
 255         $sql .= ",'" . join("','", @params) . "'" if (@params);
 256         $sql .= ')';
 257
 258         return $sql;
 259 }
 260
 261 sub is_aggregate { return $self->{_aggregate} }
 262
 263 #-------------------------------------------------------------------------------------------------
 264 package OpenILS::Reporter::SQLBuilder::Column::Transform::Bare;
 265
 266 sub toSQL {
 267         my $self = shift;
 268         return '"' . $self->{_relation} . '"."' . $self->name . '"';
 269 }
 270
 271 sub is_aggregate { return 0 }
 272
 273 #-------------------------------------------------------------------------------------------------
 274 package OpenILS::Reporter::SQLBuilder::Column::Transform::substring;
 275
 276 sub toSQL {
 277         my $self = shift;
 278         my ($params) = values %{ $self->{_column} };
 279         my $start = $$params[1];
 280         my $len = $$params[2];
 281         return 'SUBSTRING("' . $self->{_relation} . '"."' . $self->name . "\",$start,$len)";
 282 }
 283
 284 sub is_aggregate { return 0 }
 285
 286
 287 #-------------------------------------------------------------------------------------------------
 288 package OpenILS::Reporter::SQLBuilder::Column::Transform::day_name;
 289
 290 sub toSQL {
 291         my $self = shift;
 292         return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Day\')';
 293 }
 294
 295 sub is_aggregate { return 0 }
 296
 297
 298 #-------------------------------------------------------------------------------------------------
 299 package OpenILS::Reporter::SQLBuilder::Column::Transform::month_name;
 300
 301 sub toSQL {
 302         my $self = shift;
 303         return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Month\')';
 304 }
 305
 306 sub is_aggregate { return 0 }
 307
 308
 309 #-------------------------------------------------------------------------------------------------
 310 package OpenILS::Reporter::SQLBuilder::Column::Transform::doy;
 311
 312 sub toSQL {
 313         my $self = shift;
 314         return 'EXTRACT(DOY FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 315 }
 316
 317 sub is_aggregate { return 0 }
 318
 319
 320 #-------------------------------------------------------------------------------------------------
 321 package OpenILS::Reporter::SQLBuilder::Column::Transform::woy;
 322
 323 sub toSQL {
 324         my $self = shift;
 325         return 'EXTRACT(WEEK FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 326 }
 327
 328 sub is_aggregate { return 0 }
 329
 330
 331 #-------------------------------------------------------------------------------------------------
 332 package OpenILS::Reporter::SQLBuilder::Column::Transform::moy;
 333
 334 sub toSQL {
 335         my $self = shift;
 336         return 'EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 337 }
 338
 339 sub is_aggregate { return 0 }
 340
 341
 342 #-------------------------------------------------------------------------------------------------
 343 package OpenILS::Reporter::SQLBuilder::Column::Transform::qoy;
 344
 345 sub toSQL {
 346         my $self = shift;
 347         return 'EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 348 }
 349
 350 sub is_aggregate { return 0 }
 351
 352
 353 #-------------------------------------------------------------------------------------------------
 354 package OpenILS::Reporter::SQLBuilder::Column::Transform::dom;
 355
 356 sub toSQL {
 357         my $self = shift;
 358         return 'EXTRACT(DAY FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 359 }
 360
 361 sub is_aggregate { return 0 }
 362
 363
 364 #-------------------------------------------------------------------------------------------------
 365 package OpenILS::Reporter::SQLBuilder::Column::Transform::dow;
 366
 367 sub toSQL {
 368         my $self = shift;
 369         return 'EXTRACT(DOW FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 370 }
 371
 372 sub is_aggregate { return 0 }
 373
 374
 375 #-------------------------------------------------------------------------------------------------
 376 package OpenILS::Reporter::SQLBuilder::Column::Transform::year_trunc;
 377
 378 sub toSQL {
 379         my $self = shift;
 380         return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 381 }
 382
 383 sub is_aggregate { return 0 }
 384
 385
 386 #-------------------------------------------------------------------------------------------------
 387 package OpenILS::Reporter::SQLBuilder::Column::Transform::month_trunc;
 388
 389 sub toSQL {
 390         my $self = shift;
 391         return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' .
 392                 ' || \'-\' || LPAD(EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '"),2,\'0\')';
 393 }
 394
 395 sub is_aggregate { return 0 }
 396
 397
 398 #-------------------------------------------------------------------------------------------------
 399 package OpenILS::Reporter::SQLBuilder::Column::Transform::quarter;
 400
 401 sub toSQL {
 402         my $self = shift;
 403         return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' .
 404                 ' || \'-Q\' || EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 405 }
 406
 407 sub is_aggregate { return 0 }
 408
 409
 410 #-------------------------------------------------------------------------------------------------
 411 package OpenILS::Reporter::SQLBuilder::Column::Transform::months_ago;
 412
 413 sub toSQL {
 414         my $self = shift;
 415         return 'EXTRACT(MONTH FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))';
 416 }
 417
 418 sub is_aggregate { return 0 }
 419
 420
 421 #-------------------------------------------------------------------------------------------------
 422 package OpenILS::Reporter::SQLBuilder::Column::Transform::quarters_ago;
 423
 424 sub toSQL {
 425         my $self = shift;
 426         return 'EXTRACT(QUARTER FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))';
 427 }
 428
 429 sub is_aggregate { return 0 }
 430
 431
 432 #-------------------------------------------------------------------------------------------------
 433 package OpenILS::Reporter::SQLBuilder::Column::Transform::age;
 434
 435 sub toSQL {
 436         my $self = shift;
 437         return 'AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '")';
 438 }
 439
 440 sub is_aggregate { return 0 }
 441
 442
 443 #-------------------------------------------------------------------------------------------------
 444 package OpenILS::Reporter::SQLBuilder::Column::Transform::min;
 445
 446 sub toSQL {
 447         my $self = shift;
 448         return 'MIN("' . $self->{_relation} . '"."' . $self->name . '")';
 449 }
 450
 451 sub is_aggregate { return 1 }
 452
 453
 454 #-------------------------------------------------------------------------------------------------
 455 package OpenILS::Reporter::SQLBuilder::Column::Transform::max;
 456
 457 sub toSQL {
 458         my $self = shift;
 459         return 'MAX("' . $self->{_relation} . '"."' . $self->name . '")';
 460 }
 461
 462 sub is_aggregate { return 1 }
 463
 464
 465 #-------------------------------------------------------------------------------------------------
 466 package OpenILS::Reporter::SQLBuilder::Column::Transform::count;
 467
 468 sub toSQL {
 469         my $self = shift;
 470         return 'COUNT("' . $self->{_relation} . '"."' . $self->name . '")';
 471 }
 472
 473 sub is_aggregate { return 1 }
 474
 475
 476 #-------------------------------------------------------------------------------------------------
 477 package OpenILS::Reporter::SQLBuilder::Column::Transform::count_distinct;
 478
 479 sub toSQL {
 480         my $self = shift;
 481         return 'COUNT(DISTINCT "' . $self->{_relation} . '"."' . $self->name . '")';
 482 }
 483
 484 sub is_aggregate { return 1 }
 485
 486
 487 #-------------------------------------------------------------------------------------------------
 488 package OpenILS::Reporter::SQLBuilder::Column::Transform::sum;
 489
 490 sub toSQL {
 491         my $self = shift;
 492         return 'SUM("' . $self->{_relation} . '"."' . $self->name . '")';
 493 }
 494
 495 sub is_aggregate { return 1 }
 496
 497
 498 #-------------------------------------------------------------------------------------------------
 499 package OpenILS::Reporter::SQLBuilder::Column::Transform::average;
 500
 501 sub toSQL {
 502         my $self = shift;
 503         return 'AVG("' . $self->{_relation} . '"."' . $self->name .  '")';
 504 }
 505
 506 sub is_aggregate { return 1 }
 507
 508
 509 #-------------------------------------------------------------------------------------------------
 510 package OpenILS::Reporter::SQLBuilder::Column::Having;
 511 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 512
 513 sub new {
 514         my $class = shift;
 515         my $self = $class->SUPER::new(@_);
 516
 517         my $col_data = shift;
 518         $self->{_condition} = $col_data->{condition};
 519
 520         return $self;
 521 }
 522
 523 sub toSQL {
 524         my $self = shift;
 525
 526         my $sql = $self->SUPER::toSQL;
 527
 528         my ($op) = keys %{ $self->{_condition} };
 529         my $val = $self->resolve_param( values %{ $self->{_condition} } );
 530
 531         $val =~ s/'/\\'/go; $val =~ s/\\/\\\\/go;
 532         $sql .= " $op '$val'";
 533
 534         return $sql;
 535 }
 536
 537
 538 #-------------------------------------------------------------------------------------------------
 539 package OpenILS::Reporter::SQLBuilder::Column::Where;
 540 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 541
 542 sub new {
 543         my $class = shift;
 544         my $self = $class->SUPER::new(@_);
 545
 546         my $col_data = shift;
 547         $self->{_condition} = $col_data->{condition};
 548
 549         return $self;
 550 }
 551
 552 sub toSQL {
 553         my $self = shift;
 554
 555         my $sql = $self->SUPER::toSQL;
 556
 557         my ($op) = keys %{ $self->{_condition} };
 558         my $val = $self->resolve_param( values %{ $self->{_condition} } );
 559
 560         if (lc($op) eq 'in') {
 561                 $val = [$val] unless (ref($val));
 562                 $sql .= " IN ('". join("','", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."')";
 563         } elsif (lc($op) eq 'not in') {
 564                 $val = [$val] unless (ref($val));
 565                 $sql .= " NOT IN ('". join("','", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."')";
 566         } elsif (lc($op) eq 'between') {
 567                 $val = [$val] unless (ref($val));
 568                 $sql .= " BETWEEN '". join("' AND '", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."'";
 569         } elsif (lc($op) eq 'not between') {
 570                 $val = [$val] unless (ref($val));
 571                 $sql .= " NOT BETWEEN '". join("' AND '", map { $_ =~ s/'/\\'/go; $_ =~ s/\\/\\\\/go; $_ } @$val)."'";
 572         } else {
 573                 $val =~ s/'/\\'/go; $val =~ s/\\/\\\\/go;
 574                 $sql .= " $op '$val'";
 575         }
 576
 577         return $sql;
 578 }
 579
 580
 581 #-------------------------------------------------------------------------------------------------
 582 package OpenILS::Reporter::SQLBuilder::Relation;
 583 use base qw/OpenILS::Reporter::SQLBuilder/;
 584
 585 sub parse {
 586         my $self = shift;
 587         $self = $self->SUPER::new if (!ref($self));
 588
 589         my $rel_data = shift;
 590
 591         $self->{_table} = $rel_data->{table};
 592         $self->{_alias} = $rel_data->{alias};
 593         $self->{_join} = [];
 594         $self->{_columns} = [];
 595
 596         if ($rel_data->{join}) {
 597                 $self->add_join(
 598                         $_ => OpenILS::Reporter::SQLBuilder::Relation->parse( $rel_data->{join}->{$_} ) => $rel_data->{join}->{$_}->{key}
 599                 ) for ( keys %{ $rel_data->{join} } );
 600         }
 601
 602         return $self;
 603 }
 604
 605 sub add_column {
 606         my $self = shift;
 607         my $col = shift;
 608
 609         push @{ $self->{_columns} }, $col;
 610 }
 611
 612 sub find_column {
 613         my $self = shift;
 614         my $col = shift;
 615         return (grep { $_->name eq $col} @{ $self->{_columns} })[0];
 616 }
 617
 618 sub add_join {
 619         my $self = shift;
 620         my $col = shift;
 621         my $frel = shift;
 622         my $fkey = shift;
 623
 624         if (ref($col) eq 'OpenILS::Reporter::SQLBuilder::Join') {
 625                 push @{ $self->{_join} }, $col;
 626         } else {
 627                 push @{ $self->{_join} }, OpenILS::Reporter::SQLBuilder::Join->build( $self => $col, $frel => $fkey );
 628         }
 629
 630         return $self;
 631 }
 632
 633 sub is_join {
 634         my $self = shift;
 635         my $j = shift;
 636         $self->{_is_join} = $j if ($j);
 637         return $self->{_is_join};
 638 }
 639
 640 sub toSQL {
 641         my $self = shift;
 642         my $sql = $self->{_table} .' AS "'. $self->{_alias} .'"';
 643
 644         if (!$self->is_join) {
 645                 for my $j ( @{ $self->{_join} } ) {
 646                         $sql .= $j->toSQL;
 647                 }
 648         }
 649
 650         return $sql;
 651 }
 652
 653 #-------------------------------------------------------------------------------------------------
 654 package OpenILS::Reporter::SQLBuilder::Join;
 655 use base qw/OpenILS::Reporter::SQLBuilder/;
 656
 657 sub build {
 658         my $self = shift;
 659         $self = $self->SUPER::new if (!ref($self));
 660
 661         $self->{_left_rel} = shift;
 662         $self->{_left_col} = shift;
 663
 664         $self->{_right_rel} = shift;
 665         $self->{_right_col} = shift;
 666
 667         $self->{_right_rel}->is_join(1);
 668
 669         return $self;
 670 }
 671
 672 sub toSQL {
 673         my $self = shift;
 674         my $sql = "\n\tJOIN " . $self->{_right_rel}->toSQL .
 675                 ' ON ("' . $self->{_left_rel}->{_alias} . '"."' . $self->{_left_col} .
 676                 '" = "' . $self->{_right_rel}->{_alias} . '"."' . $self->{_right_col} . '")';
 677
 678         $sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
 679
 680         return $sql;
 681 }
 682
 683 1;