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 builder {
  30         my $self = shift;
  31         return $self->{_builder};
  32 }
  33
  34 sub relative_time {
  35         my $self = shift;
  36         my $t = shift;
  37         $self->builder->{_relative_time} = $t if (defined $t);
  38         return $self->builder->{_relative_time};
  39 }
  40
  41 sub resolve_param {
  42         my $self = shift;
  43         my $val = shift;
  44
  45         if (defined($val) && $val =~ /^::(.+)$/o) {
  46                 $val = $self->get_param($1);
  47         }
  48
  49         if (defined($val) && !ref($val)) {
  50                 $val =~ s/\\/\\\\/go;
  51                 $val =~ s/"/\\"/go;
  52         }
  53
  54         return $val;
  55 }
  56
  57 sub parse_report {
  58         my $self = shift;
  59         my $report = shift;
  60
  61         my $rs = OpenILS::Reporter::SQLBuilder::ResultSet->new;
  62
  63         if (!$report->{order_by} || @{$report->{order_by}} == 0) {
  64                 $report->{order_by} = $report->{select};
  65         }
  66
  67         $rs->is_subquery( 1 ) if ( $report->{alias} );
  68
  69         $rs     ->set_builder( $self )
  70                 ->set_subquery_alias( $report->{alias} )
  71                 ->set_select( $report->{select} )
  72                 ->set_from( $report->{from} )
  73                 ->set_where( $report->{where} )
  74                 ->set_having( $report->{having} )
  75                 ->set_order_by( $report->{order_by} )
  76                 ->set_pivot_data( $report->{pivot_data} )
  77                 ->set_pivot_label( $report->{pivot_label} )
  78                 ->set_pivot_default( $report->{pivot_default} );
  79
  80         return $rs;
  81 }
  82
  83
  84 #-------------------------------------------------------------------------------------------------
  85 package OpenILS::Reporter::SQLBuilder::ResultSet;
  86 use base qw/OpenILS::Reporter::SQLBuilder/;
  87
  88 sub is_subquery {
  89         my $self = shift;
  90         my $flag = shift;
  91         $self->{_is_subquery} = $flag if (defined $flag);
  92         return $self->{_is_subquery};
  93 }
  94
  95 sub pivot_data {
  96         my $self = shift;
  97         return $self->builder->{_pivot_data};
  98 }
  99
 100 sub pivot_label {
 101         my $self = shift;
 102         return $self->builder->{_pivot_label};
 103 }
 104
 105 sub pivot_default {
 106         my $self = shift;
 107         return $self->builder->{_pivot_default};
 108 }
 109
 110 sub set_pivot_default {
 111         my $self = shift;
 112         my $p = shift;
 113         $self->builder->{_pivot_default} = $p if (defined $p);
 114         return $self;
 115 }
 116
 117 sub set_pivot_data {
 118         my $self = shift;
 119         my $p = shift;
 120         $self->builder->{_pivot_data} = $p if (defined $p);
 121         return $self;
 122 }
 123
 124 sub set_pivot_label {
 125         my $self = shift;
 126         my $p = shift;
 127         $self->builder->{_pivot_label} = $p if (defined $p);
 128         return $self;
 129 }
 130
 131 sub set_subquery_alias {
 132         my $self = shift;
 133         my $alias = shift;
 134         $self->{_alias} = $alias if (defined $alias);
 135         return $self;
 136 }
 137
 138 sub set_select {
 139         my $self = shift;
 140         my @cols = @_;
 141
 142         $self->{_select} = [];
 143
 144         return $self unless (@cols && defined($cols[0]));
 145         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
 146
 147         push @{ $self->{_select} }, map { OpenILS::Reporter::SQLBuilder::Column::Select->new( $_ )->set_builder( $self->builder ) } @cols;
 148
 149         return $self;
 150 }
 151
 152 sub set_from {
 153         my $self = shift;
 154         my $f = shift;
 155
 156         $self->{_from} = OpenILS::Reporter::SQLBuilder::Relation->parse( $f, $self );
 157
 158         return $self;
 159 }
 160
 161 sub set_where {
 162         my $self = shift;
 163         my @cols = @_;
 164
 165         $self->{_where} = [];
 166
 167         return $self unless (@cols && defined($cols[0]));
 168         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
 169
 170         push @{ $self->{_where} }, map { OpenILS::Reporter::SQLBuilder::Column::Where->new( $_, $self->{_from}->builder->{_rels} )->set_builder( $self->builder ) } @cols;
 171
 172         return $self;
 173 }
 174
 175 sub set_having {
 176         my $self = shift;
 177         my @cols = @_;
 178
 179         $self->{_having} = [];
 180
 181         return $self unless (@cols && defined($cols[0]));
 182         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
 183
 184         push @{ $self->{_having} }, map { OpenILS::Reporter::SQLBuilder::Column::Having->new( $_ )->set_builder( $self->builder ) } @cols;
 185
 186         return $self;
 187 }
 188
 189 sub set_order_by {
 190         my $self = shift;
 191         my @cols = @_;
 192
 193         $self->{_order_by} = [];
 194
 195         return $self unless (@cols && defined($cols[0]));
 196         @cols = @{ $cols[0] } if (@cols == 1 && ref($cols[0]) eq 'ARRAY');
 197
 198         push @{ $self->{_order_by} }, map { OpenILS::Reporter::SQLBuilder::Column::OrderBy->new( $_ )->set_builder( $self->builder ) } @cols;
 199
 200         return $self;
 201 }
 202
 203 sub column_label_list {
 204         my $self = shift;
 205
 206         my @labels;
 207         push @labels, $self->resolve_param( $_->{_alias} ) for ( @{ $self->{_select} } );
 208         return @labels;
 209 }
 210
 211 sub group_by_list {
 212         my $self = shift;
 213         my $base = shift;
 214         $base = 1 unless (defined $base);
 215
 216         my $seen_label = 0;
 217         my $gcount = $base;
 218         my @group_by;
 219         for my $c ( @{ $self->{_select} } ) {
 220                 if ($base == 0 && !$seen_label  && defined($self->pivot_label) && $gcount == $self->pivot_label - 1) {
 221                         $seen_label++;
 222                         next;
 223                 }
 224                 push @group_by, $gcount if (!$c->is_aggregate);
 225                 $gcount++;
 226         }
 227
 228         return @group_by;
 229 }
 230
 231 sub toSQL {
 232         my $self = shift;
 233
 234         return $self->{_sql} if ($self->{_sql});
 235
 236         my $sql = '';
 237
 238         if ($self->is_subquery) {
 239                 $sql = '(';
 240         }
 241
 242         $sql .= "SELECT\t" . join(",\n\t", map { $_->toSQL } @{ $self->{_select} }) . "\n" if (@{ $self->{_select} });
 243         $sql .= "  FROM\t" . $self->{_from}->toSQL . "\n" if ($self->{_from});
 244         $sql .= "  WHERE\t" . join("\n\tAND ", map { $_->toSQL } @{ $self->{_where} }) . "\n" if (@{ $self->{_where} });
 245
 246         my @group_by = $self->group_by_list;
 247
 248         $sql .= '  GROUP BY ' . join(', ', @group_by) . "\n" if (@group_by);
 249         $sql .= "  HAVING " . join("\n\tAND ", map { $_->toSQL } @{ $self->{_having} }) . "\n" if (@{ $self->{_having} });
 250         $sql .= '  ORDER BY ' . join(', ', map { $_->toSQL } @{ $self->{_order_by} }) . "\n" if (@{ $self->{_order_by} });
 251
 252         if ($self->is_subquery) {
 253                 $sql .= ') '. $self->{_alias} . "\n";
 254         }
 255
 256         return $self->{_sql} = $sql;
 257 }
 258
 259
 260 #-------------------------------------------------------------------------------------------------
 261 package OpenILS::Reporter::SQLBuilder::Input;
 262 use base qw/OpenILS::Reporter::SQLBuilder/;
 263
 264 sub new {
 265         my $class = shift;
 266         my $self = $class->SUPER::new;
 267
 268         my $col_data = shift;
 269
 270         if (ref($col_data)) {
 271                 $self->{params} = $col_data->{params};
 272                 my $trans = $col_data->{transform} || 'Bare';
 273                 my $pkg = "OpenILS::Reporter::SQLBuilder::Input::Transform::$trans";
 274                 if (UNIVERSAL::can($pkg => 'toSQL')) {
 275                         $self->{_transform} = $trans;
 276                 } else {
 277                         $self->{_transform} = 'GenericTransform';
 278                 }
 279         } elsif( defined($col_data) ) {
 280                 $self->{_transform} = 'Bare';
 281                 $self->{params} = $col_data;
 282         } else {
 283                 $self->{_transform} = 'NULL';
 284         }
 285
 286
 287
 288         return $self;
 289 }
 290
 291 sub toSQL {
 292         my $self = shift;
 293         my $type = $self->{_transform};
 294         return $self->{_sql} if ($self->{_sql});
 295         my $toSQL = "OpenILS::Reporter::SQLBuilder::Input::Transform::${type}::toSQL";
 296         return $self->{_sql} = $self->$toSQL;
 297 }
 298
 299 #-------------------------------------------------------------------------------------------------
 300 package OpenILS::Reporter::SQLBuilder::Input::Transform::GenericTransform;
 301
 302 sub toSQL {
 303         my $self = shift;
 304         my $func = $self->{transform};
 305
 306         my @params;
 307         @params = @{ $self->{params} } if ($self->{params});
 308
 309         my $sql = $func . '(\'';
 310         $sql .= join("','", @params) if (@params);
 311         $sql .= '\')';
 312
 313         return $sql;
 314 }
 315
 316
 317 #-------------------------------------------------------------------------------------------------
 318 package OpenILS::Reporter::SQLBuilder::Input::Transform::NULL;
 319
 320 sub toSQL {
 321         return "NULL";
 322 }
 323
 324
 325 #-------------------------------------------------------------------------------------------------
 326 package OpenILS::Reporter::SQLBuilder::Input::Transform::Bare;
 327
 328 sub toSQL {
 329         my $self = shift;
 330
 331         my $val = $self->{params};
 332         $val = $$val[0] if (ref($val));
 333
 334         $val =~ s/\\/\\\\/go;
 335         $val =~ s/'/\\'/go;
 336
 337         return "'$val'";
 338 }
 339
 340
 341 #-------------------------------------------------------------------------------------------------
 342 package OpenILS::Reporter::SQLBuilder::Input::Transform::age;
 343
 344 sub toSQL {
 345         my $self = shift;
 346
 347         my $val = $self->{params};
 348         $val = $$val[0] if (ref($val));
 349
 350         $val =~ s/\\/\\\\/go;
 351         $val =~ s/'/\\'/go;
 352
 353         return "AGE(NOW(),'" . $val . "'::TIMESTAMPTZ)";
 354 }
 355
 356 sub is_aggregate { return 0 }
 357
 358
 359 #-------------------------------------------------------------------------------------------------
 360 package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_year;
 361
 362 sub toSQL {
 363         my $self = shift;
 364
 365         my $rtime = $self->relative_time || 'now';
 366
 367         $rtime =~ s/\\/\\\\/go;
 368         $rtime =~ s/'/\\'/go;
 369
 370         my $val = $self->{params};
 371         $val = $$val[0] if (ref($val));
 372
 373         $val =~ s/\\/\\\\/go;
 374         $val =~ s/'/\\'/go;
 375
 376         return "EXTRACT(YEAR FROM '$rtime'::TIMESTAMPTZ + '$val years')";
 377 }
 378
 379
 380 #-------------------------------------------------------------------------------------------------
 381 package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_month;
 382
 383 sub toSQL {
 384         my $self = shift;
 385
 386         my $rtime = $self->relative_time || 'now';
 387
 388         $rtime =~ s/\\/\\\\/go;
 389         $rtime =~ s/'/\\'/go;
 390
 391         my $val = $self->{params};
 392         $val = $$val[0] if (ref($val));
 393
 394         $val =~ s/\\/\\\\/go;
 395         $val =~ s/'/\\'/go;
 396
 397         return "EXTRACT(YEAR FROM '$rtime'::TIMESTAMPTZ + '$val months')" .
 398                 " || '-' || LPAD(EXTRACT(MONTH FROM '$rtime'::TIMESTAMPTZ + '$val months'),2,'0')";
 399 }
 400
 401
 402 #-------------------------------------------------------------------------------------------------
 403 package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_date;
 404
 405 sub toSQL {
 406         my $self = shift;
 407
 408         my $rtime = $self->relative_time || 'now';
 409
 410         $rtime =~ s/\\/\\\\/go;
 411         $rtime =~ s/'/\\'/go;
 412
 413         my $val = $self->{params};
 414         $val = $$val[0] if (ref($val));
 415
 416         $val =~ s/\\/\\\\/go;
 417         $val =~ s/'/\\'/go;
 418
 419         return "DATE('$rtime'::TIMESTAMPTZ + '$val days')";
 420 }
 421
 422
 423 #-------------------------------------------------------------------------------------------------
 424 package OpenILS::Reporter::SQLBuilder::Input::Transform::relative_week;
 425
 426 sub toSQL {
 427         my $self = shift;
 428
 429         my $rtime = $self->relative_time || 'now';
 430
 431         $rtime =~ s/\\/\\\\/go;
 432         $rtime =~ s/'/\\'/go;
 433
 434         my $val = $self->{params};
 435         $val = $$val[0] if (ref($val));
 436
 437         $val =~ s/\\/\\\\/go;
 438         $val =~ s/'/\\'/go;
 439
 440         return "EXTRACT(WEEK FROM '$rtime'::TIMESTAMPTZ + '$val weeks')";
 441 }
 442
 443
 444 #-------------------------------------------------------------------------------------------------
 445 package OpenILS::Reporter::SQLBuilder::Column;
 446 use base qw/OpenILS::Reporter::SQLBuilder/;
 447
 448 sub new {
 449         my $class = shift;
 450         my $self = $class->SUPER::new;
 451
 452         my $col_data = shift;
 453         $self->{_relation} = $col_data->{relation};
 454         $self->{_column} = $col_data->{column};
 455
 456         $self->{_aggregate} = $col_data->{aggregate};
 457
 458         $self->{_rels} = shift;
 459
 460         if (ref($self->{_column})) {
 461                 my $trans = $self->{_column}->{transform} || 'Bare';
 462                 my $pkg = "OpenILS::Reporter::SQLBuilder::Column::Transform::$trans";
 463                 if (UNIVERSAL::can($pkg => 'toSQL')) {
 464                         $self->{_transform} = $trans;
 465                 } else {
 466                         $self->{_transform} = 'GenericTransform';
 467                 }
 468         } elsif( defined($self->{_column}) ) {
 469                 $self->{_transform} = 'Bare';
 470         } else {
 471                 $self->{_transform} = 'NULL';
 472         }
 473
 474
 475         return $self;
 476 }
 477
 478 sub find_relation {
 479         my $self = shift;
 480         return $self->{_rels}->{$self->{_relation}};
 481 }
 482
 483 sub name {
 484         my $self = shift;
 485         if (ref($self->{_column})) {
 486                  return $self->{_column}->{colname};
 487         } else {
 488                 return $self->{_column};
 489         }
 490 }
 491
 492 sub toSQL {
 493         my $self = shift;
 494         my $type = $self->{_transform};
 495         return $self->{_sql} if ($self->{_sql});
 496         my $toSQL = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::toSQL";
 497         return $self->{_sql} = $self->$toSQL;
 498 }
 499
 500 sub is_aggregate {
 501         my $self = shift;
 502         my $type = $self->{_transform};
 503         my $is_agg = "OpenILS::Reporter::SQLBuilder::Column::Transform::${type}::is_aggregate";
 504         return $self->$is_agg;
 505 }
 506
 507
 508 #-------------------------------------------------------------------------------------------------
 509 package OpenILS::Reporter::SQLBuilder::Column::OrderBy;
 510 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 511
 512 sub new {
 513         my $class = shift;
 514         my $self = $class->SUPER::new(@_);
 515
 516         my $col_data = shift;
 517         $self->{_direction} = $col_data->{direction} || 'ascending';
 518         return $self;
 519 }
 520
 521 sub toSQL {
 522         my $self = shift;
 523         my $dir = ($self->{_direction} =~ /^d/oi) ? 'DESC' : 'ASC';
 524         return $self->{_sql} if ($self->{_sql});
 525         return $self->{_sql} = $self->SUPER::toSQL .  " $dir";
 526 }
 527
 528
 529 #-------------------------------------------------------------------------------------------------
 530 package OpenILS::Reporter::SQLBuilder::Column::Select;
 531 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 532
 533 sub new {
 534         my $class = shift;
 535         my $self = $class->SUPER::new(@_);
 536
 537         my $col_data = shift;
 538         $self->{_alias} = $col_data->{alias} || $self->name;
 539         return $self;
 540 }
 541
 542 sub toSQL {
 543         my $self = shift;
 544         return $self->{_sql} if ($self->{_sql});
 545         return $self->{_sql} = $self->SUPER::toSQL .  ' AS "' . $self->resolve_param( $self->{_alias} ) . '"';
 546 }
 547
 548
 549 #-------------------------------------------------------------------------------------------------
 550 package OpenILS::Reporter::SQLBuilder::Column::Transform::GenericTransform;
 551
 552 sub toSQL {
 553         my $self = shift;
 554         my $name = $self->name;
 555         my $func = $self->{_column}->{transform};
 556
 557         my @params;
 558         @params = @{ $self->resolve_param( $self->{_column}->{params} ) } if ($self->{_column}->{params});
 559
 560         my $sql = $func . '("' . $self->{_relation} . '"."' . $self->name . '"';
 561         $sql .= ",'" . join("','", @params) . "'" if (@params);
 562         $sql .= ')';
 563
 564         return $sql;
 565 }
 566
 567 sub is_aggregate { return $self->{_aggregate} }
 568
 569 #-------------------------------------------------------------------------------------------------
 570 package OpenILS::Reporter::SQLBuilder::Column::Transform::Bare;
 571
 572 sub toSQL {
 573         my $self = shift;
 574         return '"' . $self->{_relation} . '"."' . $self->name . '"';
 575 }
 576
 577 sub is_aggregate { return 0 }
 578
 579 #-------------------------------------------------------------------------------------------------
 580 package OpenILS::Reporter::SQLBuilder::Column::Transform::upper;
 581
 582 sub toSQL {
 583         my $self = shift;
 584         my $params = $self->resolve_param( $self->{_column}->{params} );
 585         my $start = $$params[0];
 586         my $len = $$params[1];
 587         return 'UPPER("' . $self->{_relation} . '"."' . $self->name . '")';
 588 }
 589
 590 sub is_aggregate { return 0 }
 591
 592
 593 #-------------------------------------------------------------------------------------------------
 594 package OpenILS::Reporter::SQLBuilder::Column::Transform::lower;
 595
 596 sub toSQL {
 597         my $self = shift;
 598         my $params = $self->resolve_param( $self->{_column}->{params} );
 599         my $start = $$params[0];
 600         my $len = $$params[1];
 601         return 'LOWER("' . $self->{_relation} . '"."' . $self->name . '")';
 602 }
 603
 604 sub is_aggregate { return 0 }
 605
 606
 607 #-------------------------------------------------------------------------------------------------
 608 package OpenILS::Reporter::SQLBuilder::Column::Transform::substring;
 609
 610 sub toSQL {
 611         my $self = shift;
 612         my $params = $self->resolve_param( $self->{_column}->{params} );
 613         my $start = $$params[0];
 614         my $len = $$params[1];
 615         return 'SUBSTRING("' . $self->{_relation} . '"."' . $self->name . "\",$start,$len)";
 616 }
 617
 618 sub is_aggregate { return 0 }
 619
 620
 621 #-------------------------------------------------------------------------------------------------
 622 package OpenILS::Reporter::SQLBuilder::Column::Transform::day_name;
 623
 624 sub toSQL {
 625         my $self = shift;
 626         return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Day\')';
 627 }
 628
 629 sub is_aggregate { return 0 }
 630
 631
 632 #-------------------------------------------------------------------------------------------------
 633 package OpenILS::Reporter::SQLBuilder::Column::Transform::month_name;
 634
 635 sub toSQL {
 636         my $self = shift;
 637         return 'TO_CHAR("' . $self->{_relation} . '"."' . $self->name . '", \'Month\')';
 638 }
 639
 640 sub is_aggregate { return 0 }
 641
 642
 643 #-------------------------------------------------------------------------------------------------
 644 package OpenILS::Reporter::SQLBuilder::Column::Transform::doy;
 645
 646 sub toSQL {
 647         my $self = shift;
 648         return 'EXTRACT(DOY FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 649 }
 650
 651 sub is_aggregate { return 0 }
 652
 653
 654 #-------------------------------------------------------------------------------------------------
 655 package OpenILS::Reporter::SQLBuilder::Column::Transform::woy;
 656
 657 sub toSQL {
 658         my $self = shift;
 659         return 'EXTRACT(WEEK FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 660 }
 661
 662 sub is_aggregate { return 0 }
 663
 664
 665 #-------------------------------------------------------------------------------------------------
 666 package OpenILS::Reporter::SQLBuilder::Column::Transform::moy;
 667
 668 sub toSQL {
 669         my $self = shift;
 670         return 'EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 671 }
 672
 673 sub is_aggregate { return 0 }
 674
 675
 676 #-------------------------------------------------------------------------------------------------
 677 package OpenILS::Reporter::SQLBuilder::Column::Transform::qoy;
 678
 679 sub toSQL {
 680         my $self = shift;
 681         return 'EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 682 }
 683
 684 sub is_aggregate { return 0 }
 685
 686
 687 #-------------------------------------------------------------------------------------------------
 688 package OpenILS::Reporter::SQLBuilder::Column::Transform::dom;
 689
 690 sub toSQL {
 691         my $self = shift;
 692         return 'EXTRACT(DAY FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 693 }
 694
 695 sub is_aggregate { return 0 }
 696
 697
 698 #-------------------------------------------------------------------------------------------------
 699 package OpenILS::Reporter::SQLBuilder::Column::Transform::dow;
 700
 701 sub toSQL {
 702         my $self = shift;
 703         return 'EXTRACT(DOW FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 704 }
 705
 706 sub is_aggregate { return 0 }
 707
 708
 709 #-------------------------------------------------------------------------------------------------
 710 package OpenILS::Reporter::SQLBuilder::Column::Transform::year_trunc;
 711
 712 sub toSQL {
 713         my $self = shift;
 714         return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 715 }
 716
 717 sub is_aggregate { return 0 }
 718
 719
 720 #-------------------------------------------------------------------------------------------------
 721 package OpenILS::Reporter::SQLBuilder::Column::Transform::month_trunc;
 722
 723 sub toSQL {
 724         my $self = shift;
 725         return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' .
 726                 ' || \'-\' || LPAD(EXTRACT(MONTH FROM "' . $self->{_relation} . '"."' . $self->name . '"),2,\'0\')';
 727 }
 728
 729 sub is_aggregate { return 0 }
 730
 731
 732 #-------------------------------------------------------------------------------------------------
 733 package OpenILS::Reporter::SQLBuilder::Column::Transform::date_trunc;
 734
 735 sub toSQL {
 736         my $self = shift;
 737         return 'DATE("' . $self->{_relation} . '"."' . $self->name . '")';
 738 }
 739
 740 sub is_aggregate { return 0 }
 741
 742
 743 #-------------------------------------------------------------------------------------------------
 744 package OpenILS::Reporter::SQLBuilder::Column::Transform::hour_trunc;
 745
 746 sub toSQL {
 747         my $self = shift;
 748         return 'EXTRACT(HOUR FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 749 }
 750
 751 sub is_aggregate { return 0 }
 752
 753
 754 #-------------------------------------------------------------------------------------------------
 755 package OpenILS::Reporter::SQLBuilder::Column::Transform::quarter;
 756
 757 sub toSQL {
 758         my $self = shift;
 759         return 'EXTRACT(YEAR FROM "' . $self->{_relation} . '"."' . $self->name . '")' .
 760                 ' || \'-Q\' || EXTRACT(QUARTER FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 761 }
 762
 763 sub is_aggregate { return 0 }
 764
 765
 766 #-------------------------------------------------------------------------------------------------
 767 package OpenILS::Reporter::SQLBuilder::Column::Transform::months_ago;
 768
 769 sub toSQL {
 770         my $self = shift;
 771         return 'EXTRACT(MONTH FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))';
 772 }
 773
 774 sub is_aggregate { return 0 }
 775
 776
 777 #-------------------------------------------------------------------------------------------------
 778 package OpenILS::Reporter::SQLBuilder::Column::Transform::hod;
 779
 780 sub toSQL {
 781         my $self = shift;
 782         return 'EXTRACT(HOUR FROM "' . $self->{_relation} . '"."' . $self->name . '")';
 783 }
 784
 785 sub is_aggregate { return 0 }
 786
 787
 788 #-------------------------------------------------------------------------------------------------
 789 package OpenILS::Reporter::SQLBuilder::Column::Transform::quarters_ago;
 790
 791 sub toSQL {
 792         my $self = shift;
 793         return 'EXTRACT(QUARTER FROM AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '"))';
 794 }
 795
 796 sub is_aggregate { return 0 }
 797
 798
 799 #-------------------------------------------------------------------------------------------------
 800 package OpenILS::Reporter::SQLBuilder::Column::Transform::age;
 801
 802 sub toSQL {
 803         my $self = shift;
 804         return 'AGE(NOW(),"' . $self->{_relation} . '"."' . $self->name . '")';
 805 }
 806
 807 sub is_aggregate { return 0 }
 808
 809
 810 #-------------------------------------------------------------------------------------------------
 811 package OpenILS::Reporter::SQLBuilder::Column::Transform::first;
 812
 813 sub toSQL {
 814         my $self = shift;
 815         return 'FIRST("' . $self->{_relation} . '"."' . $self->name . '")';
 816 }
 817
 818 sub is_aggregate { return 1 }
 819
 820
 821 #-------------------------------------------------------------------------------------------------
 822 package OpenILS::Reporter::SQLBuilder::Column::Transform::last;
 823
 824 sub toSQL {
 825         my $self = shift;
 826         return 'LAST("' . $self->{_relation} . '"."' . $self->name . '")';
 827 }
 828
 829 sub is_aggregate { return 1 }
 830
 831
 832 #-------------------------------------------------------------------------------------------------
 833 package OpenILS::Reporter::SQLBuilder::Column::Transform::min;
 834
 835 sub toSQL {
 836         my $self = shift;
 837         return 'MIN("' . $self->{_relation} . '"."' . $self->name . '")';
 838 }
 839
 840 sub is_aggregate { return 1 }
 841
 842
 843 #-------------------------------------------------------------------------------------------------
 844 package OpenILS::Reporter::SQLBuilder::Column::Transform::max;
 845
 846 sub toSQL {
 847         my $self = shift;
 848         return 'MAX("' . $self->{_relation} . '"."' . $self->name . '")';
 849 }
 850
 851 sub is_aggregate { return 1 }
 852
 853
 854 #-------------------------------------------------------------------------------------------------
 855 package OpenILS::Reporter::SQLBuilder::Column::Transform::count;
 856
 857 sub toSQL {
 858         my $self = shift;
 859         return 'COUNT("' . $self->{_relation} . '"."' . $self->name . '")';
 860 }
 861
 862 sub is_aggregate { return 1 }
 863
 864
 865 #-------------------------------------------------------------------------------------------------
 866 package OpenILS::Reporter::SQLBuilder::Column::Transform::count_distinct;
 867
 868 sub toSQL {
 869         my $self = shift;
 870         return 'COUNT(DISTINCT "' . $self->{_relation} . '"."' . $self->name . '")';
 871 }
 872
 873 sub is_aggregate { return 1 }
 874
 875
 876 #-------------------------------------------------------------------------------------------------
 877 package OpenILS::Reporter::SQLBuilder::Column::Transform::sum;
 878
 879 sub toSQL {
 880         my $self = shift;
 881         return 'SUM("' . $self->{_relation} . '"."' . $self->name . '")';
 882 }
 883
 884 sub is_aggregate { return 1 }
 885
 886
 887 #-------------------------------------------------------------------------------------------------
 888 package OpenILS::Reporter::SQLBuilder::Column::Transform::average;
 889
 890 sub toSQL {
 891         my $self = shift;
 892         return 'AVG("' . $self->{_relation} . '"."' . $self->name .  '")';
 893 }
 894
 895 sub is_aggregate { return 1 }
 896
 897
 898 #-------------------------------------------------------------------------------------------------
 899 package OpenILS::Reporter::SQLBuilder::Column::Where;
 900 use base qw/OpenILS::Reporter::SQLBuilder::Column/;
 901
 902 sub new {
 903         my $class = shift;
 904         my $self = $class->SUPER::new(@_);
 905
 906         my $col_data = shift;
 907         $self->{_condition} = $col_data->{condition};
 908
 909         return $self;
 910 }
 911
 912 sub _flesh_conditions {
 913         my $cond = shift;
 914         my $builder = shift;
 915         $cond = [$cond] unless (ref($cond) eq 'ARRAY');
 916
 917         my @out;
 918         for my $c (@$cond) {
 919                 push @out, OpenILS::Reporter::SQLBuilder::Input->new( $c )->set_builder( $builder );
 920         }
 921
 922         return \@out;
 923 }
 924
 925 sub toSQL {
 926         my $self = shift;
 927
 928         return $self->{_sql} if ($self->{_sql});
 929
 930         my $sql = '';
 931
 932         my $rel = $self->find_relation();
 933         if ($rel && $rel->is_nullable) {
 934                 $sql = "((". $self->SUPER::toSQL .") IS NULL OR ";
 935         }
 936
 937         $sql .= $self->SUPER::toSQL;
 938
 939         my ($op) = keys %{ $self->{_condition} };
 940         my $val = _flesh_conditions( $self->resolve_param( $self->{_condition}->{$op} ), $self->builder );
 941
 942         if (lc($op) eq 'in') {
 943                 $sql .= " IN (". join(",", map { $_->toSQL } @$val).")";
 944
 945         } elsif (lc($op) eq 'not in') {
 946                 $sql .= " NOT IN (". join(",", map { $_->toSQL } @$val).")";
 947
 948         } elsif (lc($op) eq 'is blank') {
 949                 $sql = '('. $self->SUPER::toSQL ." IS NULL OR ". $self->SUPER::toSQL ." = '')";
 950
 951         } elsif (lc($op) eq 'is not blank') {
 952                 $sql = '('. $self->SUPER::toSQL ." IS NOT NULL AND ". $self->SUPER::toSQL ." <> '')";
 953
 954         } elsif (lc($op) eq 'between') {
 955                 $sql .= " BETWEEN ". join(" AND ", map { $_->toSQL } @$val);
 956
 957         } elsif (lc($op) eq 'not between') {
 958                 $sql .= " NOT BETWEEN ". join(" AND ", map { $_->toSQL } @$val);
 959
 960         } elsif (lc($op) eq 'like') {
 961                 $val = $$val[0] if (ref($val) eq 'ARRAY');
 962                 $val = $val->toSQL;
 963                 $val =~ s/^'(.*)'$/$1/o;
 964                 $val =~ s/%/\\\\%/o;
 965                 $val =~ s/_/\\\\_/o;
 966                 $sql .= " LIKE '\%$val\%'";
 967
 968         } elsif (lc($op) eq 'ilike') {
 969                 $val = $$val[0] if (ref($val) eq 'ARRAY');
 970                 $val = $val->toSQL;
 971                 $val =~ s/^'(.*)'$/$1/o;
 972                 $val =~ s/%/\\\\%/o;
 973                 $val =~ s/_/\\\\_/o;
 974                 $sql .= " ILIKE '\%$val\%'";
 975
 976         } else {
 977                 $val = $$val[0] if (ref($val) eq 'ARRAY');
 978                 $sql .= " $op " . $val->toSQL;
 979         }
 980
 981         if ($rel && $rel->is_nullable) {
 982                 $sql .= ")";
 983         }
 984
 985         return $self->{_sql} = $sql;
 986 }
 987
 988
 989 #-------------------------------------------------------------------------------------------------
 990 package OpenILS::Reporter::SQLBuilder::Column::Having;
 991 use base qw/OpenILS::Reporter::SQLBuilder::Column::Where/;
 992
 993 #-------------------------------------------------------------------------------------------------
 994 package OpenILS::Reporter::SQLBuilder::Relation;
 995 use base qw/OpenILS::Reporter::SQLBuilder/;
 996
 997 sub parse {
 998         my $self = shift;
 999         $self = $self->SUPER::new if (!ref($self));
1000
1001         my $rel_data = shift;
1002         my $b = shift;
1003         $self->set_builder($b);
1004
1005         $self->{_table} = $rel_data->{table};
1006         $self->{_alias} = $rel_data->{alias} || $self->{_table};
1007         $self->{_join} = [];
1008         $self->{_columns} = [];
1009
1010         $self->builder->{_rels}{$self->{_alias}} = $self;
1011
1012         if ($rel_data->{join}) {
1013                 $self->add_join(
1014                         $_ => OpenILS::Reporter::SQLBuilder::Relation->parse( $rel_data->{join}->{$_}, $b ) => $rel_data->{join}->{$_}->{key} => $rel_data->{join}->{$_}->{type}
1015                 ) for ( keys %{ $rel_data->{join} } );
1016         }
1017
1018         return $self;
1019 }
1020
1021 sub add_column {
1022         my $self = shift;
1023         my $col = shift;
1024
1025         push @{ $self->{_columns} }, $col;
1026 }
1027
1028 sub find_column {
1029         my $self = shift;
1030         my $col = shift;
1031         return (grep { $_->name eq $col} @{ $self->{_columns} })[0];
1032 }
1033
1034 sub add_join {
1035         my $self = shift;
1036         my $col = shift;
1037         my $frel = shift;
1038         my $fkey = shift;
1039         my $type = lc(shift()) || 'inner';
1040
1041         if (UNIVERSAL::isa($col,'OpenILS::Reporter::SQLBuilder::Join')) {
1042                 push @{ $self->{_join} }, $col;
1043         } else {
1044                 push @{ $self->{_join} }, OpenILS::Reporter::SQLBuilder::Join->build( $self => $col, $frel => $fkey, $type );
1045         }
1046
1047         return $self;
1048 }
1049
1050 sub is_nullable {
1051         my $self = shift;
1052         return $self->{_nullable};
1053 }
1054
1055 sub is_join {
1056         my $self = shift;
1057         my $j = shift;
1058         $self->{_is_join} = $j if ($j);
1059         return $self->{_is_join};
1060 }
1061
1062 sub join_type {
1063         my $self = shift;
1064         my $j = shift;
1065         $self->{_join_type} = $j if ($j);
1066         return $self->{_join_type};
1067 }
1068
1069 sub toSQL {
1070         my $self = shift;
1071         return $self->{_sql} if ($self->{_sql});
1072
1073         my $sql = $self->{_table} .' AS "'. $self->{_alias} .'"';
1074
1075         if (!$self->is_join) {
1076                 for my $j ( @{ $self->{_join} } ) {
1077                         $sql .= $j->toSQL;
1078                 }
1079         }
1080
1081         return $self->{_sql} = $sql;
1082 }
1083
1084 #-------------------------------------------------------------------------------------------------
1085 package OpenILS::Reporter::SQLBuilder::Join;
1086 use base qw/OpenILS::Reporter::SQLBuilder/;
1087
1088 sub build {
1089         my $class = shift;
1090         my $self = $class->SUPER::new if (!ref($class));
1091
1092         $self->{_left_rel} = shift;
1093         ($self->{_left_col}) = split(/-/,shift());
1094
1095         $self->{_right_rel} = shift;
1096         $self->{_right_col} = shift;
1097
1098         $self->{_join_type} = shift;
1099
1100         $self->{_right_rel}->set_builder($self->{_left_rel}->builder);
1101
1102         $self->{_right_rel}->is_join(1);
1103         $self->{_right_rel}->join_type($self->{_join_type});
1104
1105         bless $self => "OpenILS::Reporter::SQLBuilder::Join::$self->{_join_type}";
1106
1107         return $self;
1108 }
1109
1110 sub toSQL {
1111         my $self = shift;
1112         my $dir = shift;
1113
1114         my $sql = "JOIN " . $self->{_right_rel}->toSQL .
1115                 ' ON ("' . $self->{_left_rel}->{_alias} . '"."' . $self->{_left_col} .
1116                 '" = "' . $self->{_right_rel}->{_alias} . '"."' . $self->{_right_col} . '")';
1117
1118         $sql .= $_->toSQL($dir) for (@{ $self->{_right_rel}->{_join} });
1119
1120         return $sql;
1121 }
1122
1123 #-------------------------------------------------------------------------------------------------
1124 package OpenILS::Reporter::SQLBuilder::Join::left;
1125 use base qw/OpenILS::Reporter::SQLBuilder::Join/;
1126
1127 sub toSQL {
1128         my $self = shift;
1129         my $dir = shift;
1130         #return $self->{_sql} if ($self->{_sql});
1131
1132         my $_nullable_rel = $dir && $dir eq 'r' ? '_left_rel' : '_right_rel';
1133         $self->{_right_rel}->{_nullable} = 'l';
1134         $self->{$_nullable_rel}->{_nullable} = $dir;
1135
1136         my $j = $dir && $dir eq 'r' ? 'FULL OUTER' : 'LEFT OUTER';
1137
1138         my $sql = "\n\t$j ". $self->SUPER::toSQL('l');
1139
1140         #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
1141
1142         return $self->{_sql} = $sql;
1143 }
1144
1145 #-------------------------------------------------------------------------------------------------
1146 package OpenILS::Reporter::SQLBuilder::Join::right;
1147 use base qw/OpenILS::Reporter::SQLBuilder::Join/;
1148
1149 sub toSQL {
1150         my $self = shift;
1151         my $dir = shift;
1152         #return $self->{_sql} if ($self->{_sql});
1153
1154         my $_nullable_rel = $dir && $dir eq 'l' ? '_right_rel' : '_left_rel';
1155         $self->{_left_rel}->{_nullable} = 'r';
1156         $self->{$_nullable_rel}->{_nullable} = $dir;
1157
1158         my $j = $dir && $dir eq 'l' ? 'FULL OUTER' : 'RIGHT OUTER';
1159
1160         my $sql = "\n\t$j ". $self->SUPER::toSQL('r');
1161
1162         #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
1163
1164         return $self->{_sql} = $sql;
1165 }
1166
1167 #-------------------------------------------------------------------------------------------------
1168 package OpenILS::Reporter::SQLBuilder::Join::inner;
1169 use base qw/OpenILS::Reporter::SQLBuilder::Join/;
1170
1171 sub toSQL {
1172         my $self = shift;
1173         my $dir = shift;
1174         #return $self->{_sql} if ($self->{_sql});
1175
1176         my $_nullable_rel = $dir && $dir eq 'l' ? '_right_rel' : '_left_rel';
1177         $self->{$_nullable_rel}->{_nullable} = $dir;
1178
1179         my $j = $dir ? ( $dir eq 'l' ? 'LEFT OUTER' : ( $dir eq 'r' ? 'RIGHT OUTER' : 'FULL OUTER' ) ) : 'INNER';
1180
1181         my $sql = "\n\t$j ". $self->SUPER::toSQL;
1182
1183         #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
1184
1185         return $self->{_sql} = $sql;
1186 }
1187
1188 #-------------------------------------------------------------------------------------------------
1189 package OpenILS::Reporter::SQLBuilder::Join::cross;
1190 use base qw/OpenILS::Reporter::SQLBuilder::Join/;
1191
1192 sub toSQL {
1193         my $self = shift;
1194         #return $self->{_sql} if ($self->{_sql});
1195
1196         $self->{_right_rel}->{_nullable} = 'f';
1197         $self->{_left_rel}->{_nullable} = 'f';
1198
1199         my $sql = "\n\tFULL OUTER ". $self->SUPER::toSQL('f');
1200
1201         #$sql .= $_->toSQL for (@{ $self->{_right_rel}->{_join} });
1202
1203         return $self->{_sql} = $sql;
1204 }
1205
1206 1;