File Coverage

blib/lib/DataTables.pm

Criterion	Covered	Total	%
statement	27	233	11.5
branch	0	84	0.0
condition	0	18	0.0
subroutine	9	26	34.6
pod	15	15	100.0
total	51	376	13.5

package DataTables;

use 5.008008;
use strict;
use warnings;

use AutoLoader qw(AUTOLOAD);

use Carp;
use CGI;
use DBI;
use JSON::XS;

our $VERSION = '0.03';

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

sub new {
    my $invocant = shift;
    my $class   = ref($invocant) || $invocant;
    my $self = {
        tables  => undef,
        columns   => undef,
        user  => undef,
        pass  => undef,
        db  => undef,
        host  => "localhost",
        port  => "3306",
        patterns  => {},
        join_clause  => '',
        where_clause  => '',
        index_col  => "id",
        index_cols => undef,
        @_,                 # Override previous attributes
    };
    return bless $self, $class;
}

sub tables {
    my $self = shift;

    if (@_) {
        my $a_ref = shift;
        croak "tables must be an array ref" unless UNIVERSAL::isa($a_ref,'ARRAY');
        $self->{tables} = $a_ref;
    }
    return $self->{tables};
}

sub columns {
    my $self = shift;

    if (@_) {
        my $ref = shift;
        croak "columns_a must be an array or hash ref" unless UNIVERSAL::isa($ref,'ARRAY') or UNIVERSAL::isa($ref,'HASH');
        $self->{columns} = $ref;
    }
    return $self->{columns};
}

sub index_cols {
    my $self = shift;

    if (@_) {
        my $h_ref = shift;
        croak "index_cols must be a hash ref" unless UNIVERSAL::isa($h_ref,'HASH');
        $self->{index_cols} = $h_ref;
    }
    return $self->{index_cols};
}

sub patterns {
    my $self = shift;

    if (@_) {
        my $h_ref = shift;
        croak "patterns must be a hash ref" unless UNIVERSAL::isa($h_ref,'HASH');
        $self->{patterns} = $h_ref;
    }
    return $self->{patterns};
}

sub user {
    my $self = shift;

    if (@_) {
        $self->{user} = shift;
    }
    return $self->{user};
}

sub pass {
    my $self = shift;

    if (@_) {
        $self->{pass} = shift;
    }
    return $self->{pass};
}

sub db {
    my $self = shift;

    if (@_) {
        $self->{db} = shift;
    }
    return $self->{db};
}

sub host {
    my $self = shift;

    if (@_) {
        $self->{host} = shift;
    }
    return $self->{host};
}

sub port {
    my $self = shift;

    if (@_) {
        $self->{port} = shift;
    }
    return $self->{port};
}

sub join_clause {
    my $self = shift;

    if (@_) {
        $self->{join_clause} = shift;
    }
    return $self->{join_clause};
}

sub where_clause {
    my $self = shift;

    if (@_) {
        $self->{where_clause} = shift;
    }
    return $self->{where_clause};
}

sub index_col {
    my $self = shift;

    if (@_) {
        $self->{index_col} = shift;
    }
    return $self->{index_col};
}

#for some values in the query we build we can't use
#placeholders because they add quotes when they shouldn't.
#So here we use $dbh->quote() to escape these string then we remove
# the ''. Not as good as placeholders, but we need something
sub _special_quote {
    my ($dbh,$string) = (@_);
    my $ns = $dbh->quote($string);
    $ns = substr $ns, 1;
    $ns= substr $ns, 0,-1;
    return $ns;
}

sub _columns_arr {
    my $self = shift;
    my $aColumns;
    my $regular_columns;
    my $as_hash;
    my $tables_hash;

    if(UNIVERSAL::isa($self->columns,'HASH')) {
        my $columns = $self->columns;

        for my $key (sort {$a <=> $b} keys %{$columns}) { #here we sort by key so columns show in the same order as they on the page
            my $as_exists = undef;

            #if two keys, we assume user passed in AS as a key. We could check for as below in loop, but that limits users from having a column named AS
            if(scalar(keys %{$columns->{$key}} == 2) and exists $columns->{$key}->{'AS'}) {
                $as_exists = $columns->{$key}->{'AS'};
                delete $columns->{$key}->{'AS'};
            }

            while(my ($column,$table) = each %{$columns->{$key}}) {
                my $column_name = "$table.$column";
                push @{$aColumns}, $column_name;

                if($as_exists) {
                    $as_hash->{$column_name} = $as_exists if $as_exists; #add 'AS' value for this column if one exists
                    $column = $as_exists; # we want to change the column name to what it will be selected as out of database so we can do correct pattern matching
                }

                $tables_hash->{$table} = 1;
                push @{$regular_columns}, $column;
            }
        }

        my @tables = keys %$tables_hash;
        $self->tables(\@tables);
    }
    elsif(UNIVERSAL::isa($self->columns,'ARRAY')) {
        $aColumns = $self->columns;
        $regular_columns = $aColumns;
    }
    else {
        croak "columns must be a hash or an array ref";
    }

    return ($aColumns,$regular_columns,$as_hash);
}

sub print_json {
    my $self = shift;
    my $json = $self->json;

    print "Content-type: application/json\n\n";
    print $json;
}

sub json {
    use strict;
    my $self = shift;

    # CGI OBJECT
    my $q = new CGI;

    # DB CONFIG VARIABLES
    my $platform = "mysql";
    my $database = $self->{db};
    my $host = $self->{host};
    my $port = $self->{port};
    my $user = $self->{user};
    my $pw = $self->{pass};

    #DATA SOURCE NAME
    my $dsn = "dbi:mysql:$database:$host:3306";

    # get database handle
    my $dbh = DBI->connect($dsn, $user, $pw) or croak "couldn't connect to database: $!";

    #columns to use
    my ($aColumns,$regular_columns,$as_hash) = $self->_columns_arr;

    #this bind array is used for secure database queries
    #in an effort to help prevent sql injection
    my @bind = ();

    croak "Tables must be provided for the FROM clause" unless $self->tables;
    my $sTable = join ",",@{$self->tables};

    #filtering
    my $sWhere = "";
    if ($q->param('sSearch') ne '') {
        $sWhere = "WHERE (";

        for(my $i = 0; $i < @$aColumns; $i++) {
            my $search = $q->param('sSearch');
            $search = _special_quote($dbh,$search);
            $sWhere .= "" . $aColumns->[$i] . " LIKE '%$search%' OR ";
        }

        $sWhere = substr $sWhere,0,-3;
        $sWhere .= ')';
    }

    #individual column filtering
    for (my $i = 0; $i < @$aColumns; $i++) {
        if($q->param('bSearchable_' . $i) ne '' and $q->param('bSearchable_' . $i) eq "true" and $q->param('sSearch_' . $i) ne '') {
            if($sWhere eq "") {
                $sWhere = "WHERE ";
            }
            else {
                $sWhere .= " AND ";
            }
            my $search = $q->param('sSearch_' . $i);
            $search = _special_quote($dbh,$search);
            $sWhere .= "" . $aColumns->[$i] . " LIKE '%$search%' ";
        }
    }

    # add user where if given
    if($self->where_clause ne '') {
        if($sWhere eq "") {
            $sWhere = "WHERE ";
        }
        else {
            $sWhere .= " AND ";
        }
        $sWhere .= " " . $self->where_clause . " ";
    }

    #ordering
    my $sOrder = "";
    if($q->param('iSortCol_0') ne '') {
        $sOrder = "ORDER BY  ";

        for(my $i = 0; $i < $q->param('iSortingCols'); $i++) {
            if($q->param('bSortable_' . $q->param('iSortCol_'.$i)) eq "true") {
                  my $sort_col = $aColumns->[$q->param('iSortCol_' . $i)];
                  my $sort_dir = $q->param('sSortDir_' . $i);

                # cannot use bind because bind puts '' around values.
                # backslash out quotes
                $sort_col = _special_quote($dbh,$sort_col);
                $sort_dir = _special_quote($dbh,$sort_dir);

                $sOrder .= "" . $sort_col . " " . $sort_dir . ", ";
            }
        }

        $sOrder = substr $sOrder,0,-2;
        if( $sOrder eq "ORDER BY" ) {
            $sOrder = "";
        }
    }

    #paging
    my $sLimit = "";
    if ($q->param('iDisplayStart') ne '' and $q->param('iDisplayLength') ne '-1') {
        $sLimit = "LIMIT ?,? ";
        push @bind,$q->param('iDisplayStart');
        push @bind,$q->param('iDisplayLength');
    }

    #join
    my $sJoin = '';
    if($self->join_clause ne '') {
        if($sWhere ne '') {
            $sJoin .= ' AND ';
        }
        elsif($sWhere eq '') {
            $sWhere = ' WHERE ';
        }
        $sJoin .= ' ' . $self->join_clause . ' ';
    }

    #SQL queries
    #get data to display
    my $cols = join ", ", @{$aColumns};
    my $sQuery = "SELECT SQL_CALC_FOUND_ROWS " . $cols . " FROM $sTable $sWhere $sJoin $sOrder $sLimit ";

    #get columns out of db with query we created
    my $result_sth = $dbh->prepare($sQuery);
    $result_sth->execute(@bind) or croak "error in mysql query: $!\n$sQuery";

    # Data set length after filtering
    $sQuery = " SELECT FOUND_ROWS() ";

    my $sth = $dbh->prepare($sQuery);
    $sth->execute() or croak "mysql error: $!";

    my @aResultFilterTotal = $sth->fetchrow_array();
    my $iFilteredTotal = $aResultFilterTotal[0];

    my $iTotal = 0;

    my $num_tables = scalar(@{$self->tables});
    my $index_h = $self->index_cols;

    for my $table(@{$self->tables}) {
        my $sIndexColumn = '';
        if($num_tables == 1) {
            $sIndexColumn = $self->index_col;
        }
        else {
            $sIndexColumn = $index_h->{$table};
            $sIndexColumn = "id" unless $sIndexColumn;
        }
        # Total data set length
        $sQuery = " SELECT COUNT(`" . $sIndexColumn . "`) FROM   $table ";

        $sth = $dbh->prepare($sQuery);
        $sth->execute() or croak "error in query: $!\n$sQuery\nMost likely related to index columns passed in";

        my @aResultTotal = $sth->fetchrow_array;
        $iTotal += $aResultTotal[0];
    }

    # output hash
    my %output = (
                 "sEcho" => $q->param('sEcho'),
                 "iTotalRecords" => $iTotal,
                    "iTotalDisplayRecords" => $iFilteredTotal,
                 "aaData" => ()
                   );

    my $count = 0;
    my $patterns = $self->patterns;
    while(my @aRow = $result_sth->fetchrow_array) {
        my @row = ();
        for (my $i = 0; $i < @$aColumns; $i++) {
            my $pat_name = $regular_columns->[$i]; #get out the name that would be used in the pattern
            my $val = $aRow[$i];

            # apply user specified pattern for this column if one exists
            if(exists $patterns->{$pat_name}) {
                my $pattern = $patterns->{$pat_name};
                $pattern =~ s/\[\%\s$pat_name\s\%\]/$val/g;
                $val = $pattern;
            }

            push @row, $val;
        }
        @{$output{'aaData'}}[$count] = [@row];
        $count++;
    }

    unless($count) {
        $output{'aaData'} = ''; #we don't want to have 'null'. will break js
    }

    return encode_json \%output;
}

1;
__END__