File Coverage

blib/lib/SQL/QueryBuilder/Pretty.pm

Criterion	Covered	Total	%
statement	18	40	45.0
branch	0	12	0.0
condition	0	3	0.0
subroutine	6	8	75.0
pod	2	2	100.0
total	26	65	40.0

#!/usr/bin/perl
package SQL::QueryBuilder::Pretty;

use strict;
use warnings;

our $VERSION = '0.01';

use Carp qw(croak);
use Data::Dumper;

use Module::Pluggable
    'search_path' => [
        'SQL::QueryBuilder::Pretty::Database::ANSI',
    ],
    'instantiate' => 'new',
    'sub_name'    => 'rules'
;
use SQL::QueryBuilder::Pretty::Print;

sub new {
    my $class = shift;
    my %self  = @_;

    if ( my $database = delete $self{'-database'} ) {
        $class = CORE::join( q{::}, $class, 'Database', $database );
        eval "use $class; 1" or croak $@;
        return $class->new( %self );
    }
    elsif ( my $handler = delete $self{'-handler'} ) {
        $class = CORE::join( q{::}, $class, 'Handler', ref $handler );
        eval "use $class; 1" or croak $@;
        return $class->new( %self, 'handler' => $handler );
    }
    else {
        return bless { %self }, ref $class || $class;
    }
}

sub print {
    my $self  = shift;
    my $query = shift;

    # Initializes the print object
    my $print = SQL::QueryBuilder::Pretty::Print->new( %{ $self } );

    # Get rules in the correct order
    # TODO: load unique rules by name
    my @rules = sort { $a->order <=> $b->order } $self->rules();

    while ( $query ) {
        for my $rule ( @rules ) {
            my $match = $rule->match;

            if ( $query =~ s/^($match)//smx ) {
                # A rule can exit in error, in that case continue trying
                last if $rule->action($print, $1);
            }
        }
    }

    return $print->query;
}

1;
__END__