File Coverage

blib/lib/Mysql/PrettyPrinter.pm

Criterion	Covered	Total	%
statement	6	163	3.6
branch	0	108	0.0
condition	0	40	0.0
subroutine	2	19	10.5
pod	9	9	100.0
total	17	339	5.0

package Mysql::PrettyPrinter;

use strict;
use warnings;

our $VERSION = 0.10;

# Knowledge of MySQL keywords is stored in class variables to aid efficiency in
# persistent environments (eg mod_perl)
my $Keywords = [];
# First-level keywords; outdent
$Keywords->[0] = [ qw(
    ALTER CHANGE CREATE DELETE DROP FROM GRANT GROUP HAVING INSERT LIMIT MODIFY
    ORDER SELECT SET SHOW UNION UPDATE WHERE
) ];
# Second-level keywords; prepend a linebreak
$Keywords->[1] = [ qw(
    CROSS INNER JOIN LEFT OUTER RIGHT
    ELSE ELSEIF THEN WHEN
) ];
# Third-level keywords; prepend a linebreak if within a join
$Keywords->[2] = [ qw(
    AND OR
) ];
# Other keywords; no intention to treat specially
$Keywords->[3] = [ qw(
    ACCESSIBLE ADD ALL ANALYZE AS ASC ASENSITIVE BEFORE BETWEEN BIGINT BINARY
    BLOB BOTH BY CALL CASCADE CASE CHAR CHARACTER CHECK COLLATE COLUMN
    CONDITION CONNECTION CONSTRAINT CONTINUE CONVERT CURRENT_DATE CURRENT_TIME
    CURRENT_TIMESTAMP CURRENT_USER CURSOR DATABASE DATABASES DAY_HOUR
    DAY_MICROSECOND DAY_MINUTE DAY_SECOND DEC DECIMAL DECLARE DEFAULT DELAYED
    DESC DESCRIBE DETERMINISTIC DISTINCT DISTINCTROW DIV DOUBLE DUAL EACH
    ELSEIF ENCLOSED ESCAPED EXISTS EXIT EXPLAIN FALSE FETCH FLOAT FLOAT4 FLOAT8
    FOR FORCE FOREIGN FULLTEXT GOTO HIGH_PRIORITY HOUR_MICROSECOND HOUR_MINUTE
    HOUR_SECOND IF IGNORE IN INDEX INFILE INOUT INSENSITIVE INT INT1 INT2 INT3
    INT4 INT8 INTEGER INTERVAL INTO IS ITERATE KEY KEYS KILL LABEL LEADING
    LEAVE LIKE LIMIT LINEAR LINES LOAD LOCALTIME LOCALTIMESTAMP LOCK LONG
    LONGBLOB LONGTEXT LOOP LOW_PRIORITY MASTER_SSL_VERIFY_SERVER_CERT MATCH
    MEDIUMBLOB MEDIUMINT MEDIUMTEXT MIDDLEINT MINUTE_MICROSECOND MINUTE_SECOND
    MOD MODIFIES NATURAL NOT NO_WRITE_TO_BINLOG NULL NUMERIC ON OPTIMIZE OPTION
    OPTIONALLY OUT OUTFILE PRECISION PRIMARY PROCEDURE PURGE RANGE READ
    READ_ONLY READS READ_WRITE REAL REFERENCES REGEXP RELEASE RENAME REPEAT
    REPLACE REQUIRE RESTRICT RETURN REVOKE RLIKE SCHEMA SCHEMAS
    SECOND_MICROSECOND SENSITIVE SEPARATOR SHOW SMALLINT SPATIAL SPECIFIC SQL
    SQL_BIG_RESULT SQL_CALC_FOUND_ROWS SQLEXCEPTION SQL_SMALL_RESULT SQLSTATE
    SQLWARNING SSL STARTING STRAIGHT_JOIN TABLE TABLES TEMPORARY TERMINATED
    TINYBLOB TINYINT TINYTEXT TO TRAILING TRIGGER TRUE UNDO UNIQUE UNLOCK
    UNSIGNED UPGRADE USAGE USE USING UTC_DATE UTC_TIME UTC_TIMESTAMP VALUES
    VARBINARY VARCHAR VARCHARACTER VARYING WHILE WITH WRITE XOR YEAR_MONTH
    ZEROFILL
) ];
my $Keyword = { map { $_ => 4 } @{$Keywords->[3]} };
foreach my $n (1..3) {
    %$Keyword = (%$Keyword, map { $_ => $n } @{$Keywords->[$n - 1]});
}

sub new {
    my ($class, %param) = @_;
    return bless {
        space => ' ',
        break => "\n",
        indent => '    ',
        wrap => undef,
        sql => '',
        tokens => [],
        _level => 0,
        _pending => 1,
        %param
    }, $class;
}

sub sql {
    my ($self, $sql) = @_;
    if (defined($sql)) {
        # Setter
        $self->{sql} = $sql;
        $self->{_pending} = 1;
        return $self;
    }
    else {
        # Getter
        return $self->{sql};
    }
}

sub add_sql {
    my ($self, $sql) = @_;
    $sql =~ s/^\s*/ / if length $self->{sql};
    $self->{sql} .= $sql;
    $self->{_pending} = 1;
    return $self;
}

sub make_tokens {
    my ($self, %param) = @_;
    if (%param) {
        %$self = ( %$self, %param );
    }
    if (exists $param{sql}) {
        $self->{_pending} = 1;
    }
    if ($self->{_pending} and length $self->{sql}) {
        @{ $self->{tokens} } = $self->lexicals($self->{sql}, 1);
        $self->{_pending} = 0;
    }
    return $self;
}

sub tokens {
    my ($self, @toks) = @_;
    if (scalar @toks) {
        # Setter
        @{ $self->{sql} } = @toks;
        $self->{_pending} = 0;
        return $self;
    }
    else {
        # Getter
        if ($self->{_pending}) {
            warn "Probable data conflict; suspicious invocation sequence";
        }
        return wantarray ? @{$self->{tokens}} : $self->{tokens};
    }
}

sub add_tokens {
    my ($self, @toks) = @_;
    if ($self->{_pending}) {
        warn "Probable data conflict; suspicious invocation sequence";
    }
    push(@{$self->{tokens}}, @toks);
    $self->{_pending} = 0;
    return $self;
}

sub format {
    my $self = shift;
    unless (ref $self) {
        # Shortcut used; need to start from scratch
        $self = $self->new(@_);
        $self->make_tokens;
    }
    elsif ($self->{_pending}) {
        # SQL waiting to be tokenised
        $self->make_tokens(@_);
    }

    $self->{_output} = '';  # Ultimate output
    $self->{_levels} = [];  # Nested levels
    $self->{_blank_line} = 1;  # Whether in a blank line
    $self->{_previous} = '';  # Previous token
    $self->{_joining} = 0;  # Whether in a compound join
    $self->{_conditioning} = 0;  # Whether in a conditional

    while (defined(my $token = shift @{$self->{tokens}} )) {
        # Some preprocessing of token
        if ($self->_is_keyword(uc $token)) {
            # Keyword => uppercase
            $token = uc $token;
        }
        elsif ($token =~ /^[,.;\(\)]$/) {
            # Punctuation
            ;  # nothing
        }
        elsif ($self->{_pending_nl}) {
            # Non-keyword/punctuation
            $self->_new_line;
            $self->{_pending_nl} = 0;
        }

        # Build output
        if ($token eq '(') {
            push @{ $self->{_levels} }, $self->{_level};
            $self->_add_token($token)->_new_line->_over;
        }
        elsif ($token eq ')') {
            $self->{_level} = pop(@{ $self->{_levels} }) || 0;
            $self->_new_line->_add_token($token);
            $self->_new_line
                unless uc($self->_next_token) eq 'AS'
                    || $self->_next_token eq ',';
        }
        elsif ($token eq ',') {
            $self->_add_token($token)->_new_line;
        }
        elsif ($token eq ';') {
            $self->_add_token($token)->_new_line;
            # End of statement; remove all indentation
            @{ $self->{_levels} } = ();
            $self->{_level} = 0;
        }
        elsif ($token eq 'UNION') {
            # End of statement; remove all indentation
            @{ $self->{_levels} } = ();
            $self->{_level} = 0;
            $self->_new_line->_add_token($token, 'K')->_new_line;
        }
        elsif ($token eq 'JOIN') {
            unless ($self->_is_keyword($self->{_previous})) {
                $self->_new_line;
            }
            $self->_add_token($token, 'K');
        }
        elsif ($token eq 'ON') {
            $self->_add_token($token, 'K');
            if ($self->_is_keyword($self->_next_keyword) == 3) {
                $self->_new_line->_over;
                $self->{_joining} = 1;
            }
        }
        elsif ($token eq 'CASE') {
            $self->_add_token($token, 'K')->_over;
            $self->{_conditioning} = 1;
        }
        elsif ($token eq 'END' and $self->{_conditioning}) {
            $self->_back->_new_line->_add_token($token, 'K');
            $self->{_conditioning} = 0;
        }
        elsif ($self->_is_keyword($token) == 1) {
            # First-level keyword
            $self->_back unless $self->{_previous} eq '(';
            if ($self->{_joining}) {
                $self->_back;
                $self->{_joining} = 0;
            }
            $self->_new_line->_add_token($token, 'K')->_over;
            $self->{_pending_nl} = 1;
        }
        elsif ($self->_is_keyword($token) == 2) {
            # Second-level keyword
            if ($self->{_joining}) {
                $self->_back;
                $self->{_joining} = 0;
            }
            $self->_new_line->_add_token($token, 'K');
        }
        elsif ($self->_is_keyword($token) == 3) {
            # Third-level keyword
            $self->_new_line->_add_token($token, 'K');
        }
        elsif ($self->_is_keyword($token)) {
            # Other keyword
            $self->_add_token($token, 'K');
        }
        elsif ($token =~ /^"[^"']*"$/) {
            # Quoted string
            $token =~ s/"/'/g;
            $self->_add_token($token, 'L');
        }
        elsif ($token =~ /^'.*'$/) {
            # Quoted string
            $self->_add_token($token, 'L');
        }
        elsif ($token =~ /^\d+$/) {
            # Number
            $self->_add_token($token, 'L');
        }
        elsif ($self->_next_token eq '(') {
            $token = lc $token;
            $self->_add_token($token, 'F');
        }
        else {
            $self->_add_token($token);
        }
#TODO: Identify comments

        $self->{_previous} = $token;
    }

    $self->_new_line;
    return $self->{_output};
}

# Add a token to the formatted string.
sub _add_token {
    my ($self, $token, $type) = @_;
    $type ||= '';

    if ($self->{wrap}) {
        # Format wrapping of keywords, etc
        if ($type eq 'K' and exists $self->{wrap}->{keyword}) {
            # Keyword
            $token = $self->{wrap}->{keyword}->[0]
                . $token
                . $self->{wrap}->{keyword}->[1];
        }
        elsif ($type eq 'F' and exists $self->{wrap}->{function}) {
            # Function
            $token = $self->{wrap}->{function}->[0]
                . $token
                . $self->{wrap}->{function}->[1];
        }
        elsif ($type eq 'L' and exists $self->{wrap}->{literal}) {
            # Literal
            $token = $self->{wrap}->{literal}->[0]
                . $token
                . $self->{wrap}->{literal}->[1];
        }
        elsif ($type eq 'C' and exists $self->{wrap}->{comment}) {
            # Comment
            $token = $self->{wrap}->{comment}->[0]
                . $token
                . $self->{wrap}->{comment}->[1];
        }
    }

    if ($token =~ /^[,.;]$/ or $self->{_previous} eq '.') {
        # Punctuation => no indent
        ;
    }
    elsif ($token eq '('
            and not $self->_is_keyword($self->{_previous})
            and not $self->{_previous} eq ',') {
        # Function => no indent
        ;
    }
    else {
        $self->{_output} .= $self->_indent;
    }

    $self->{_output} .= $token;

    # This can't be the beginning of a new line anymore.
    $self->{_blank_line} = 0;
    return $self;
}

# Increase the indentation level.
sub _over {
    my ($self) = @_;
    ++$self->{_level};
    return $self;
}

# Decrease the indentation level.
sub _back {
    my ($self) = @_;
    --$self->{_level} if $self->{_level} > 0;
    return $self;
}

# Return a string of spaces according to the current indentation level and the
# spaces setting for indenting.
sub _indent {
    my ($self) = @_;
    if ($self->{_blank_line}) {
        return $self->{indent} x $self->{_level};
    }
    else {
        return $self->{space};
    }
}

# Add a line break, but make sure there are no empty lines.
sub _new_line {
    my ($self) = @_;
    $self->{_output} .= $self->{break} unless $self->{_blank_line};
    $self->{_blank_line} = 1;
    return $self;
}

sub _next_token { scalar @{ $_[0]->{tokens} } ? $_[0]->{tokens}->[0] : '' }

sub _next_keyword {
    my ($self) = @_;
    my $len = scalar @{ $self->{tokens} };
    for (my $i = 0; $i < $len; $i++) {
        if ($self->_is_keyword(uc $self->{tokens}->[$i])) {
            return(uc $self->{tokens}->[$i]);
        }
    }
    return '';
}

sub _is_keyword { defined $_[1] && exists $Keyword->{$_[1]} ? $Keyword->{$_[1]} : 0 }

sub lexicals {
    my ($proto, $sql, $omit_whitespace_tokens) = @_;
    my @tokens = $sql =~ m{
        (?:--|\#)[\ \t\S]*      # single line comments
        |
        (?:<>|<=>|>=|<=|==|=|!=|!|<<|>>|<|>|\|\||\||&&|&|-|\+|\*(?!/)|/(?!\*)|\%|~|\^|\?)
                                # operators and tests
        |
        [\[\]\(\),;.]            # punctuation (parenthesis, comma)
        |
        \'\'(?!\')              # empty single quoted string
        |
        \"\"(?!\"")             # empty double quoted string
        |
        ".*?(?:(?:""){1,}"|(?
                                # anything inside double quotes, ungreedy
		|
        `.*?(?:(?:``){1,}`|(?
                                # anything inside backticks quotes, ungreedy
        |
        '.*?(?:(?:''){1,}'|(?
                                # anything inside single quotes, ungreedy.
        |
        /\*[\ \t\n\S]*?\*/      # C style comments
        |
        (?:[\w:@]+(?:\.(?:\w+|\*)?)*)
                                # words, standard named placeholders, db.table.*, db.*
        |
        (?:\${1,2})             # dollars
        |
        [\t\ ]+                 # any kind of white spaces
    }mxg;

    @tokens = grep(!/^[\s\n\r]*$/, @tokens) if $omit_whitespace_tokens;
    return wantarray ? @tokens : \@tokens;
}

sub passthrough {
    my ($class, @args) = @_;
    my %param;
    if (ref($class)) {
        die "'passthrough' is a class method";
    }
    eval {
        %param = @args || ();
    };
    if ($@) {
        die "Options should be passed in hash style\n". $@;
    }
    local($/) = '';
    print $class->format(sql => <>);
}

1;
__END__