File Coverage

blib/lib/ORMesque.pm

Criterion	Covered	Total	%
statement	30	305	9.8
branch	0	122	0.0
condition	0	48	0.0
subroutine	10	52	19.2
pod	38	38	100.0
total	78	565	13.8

#ABSTRACT: Lightweight To-The-Point ORM

package ORMesque;

use strict;
use warnings;
use ORMesque::DBIxSimpleHack;    # mod'd dbix-simple to use S::A::L
use base 'DBIx::Simple';

use ORMesque::SchemaLoader;

use SQL::Abstract;
use SQL::Interp;

use Data::Page;

our $Cache = undef;

our $VERSION = 1.110422;# VERSION


sub new {
    my $class = shift;

    return $Cache if $Cache;

    my @dsn = @_;
    my $nsp = undef;

    # check if a namespace has been defined
    if (ref $dsn[$#dsn]) {
        if (defined $dsn[$#dsn]->{NameSpace}) {
            $nsp = $dsn[$#dsn]->{NameSpace};
            delete $dsn[$#dsn]->{NameSpace};
        }
    }

    my $dbh = ORMesque->connect(@dsn) or die $DBI::errstr;
    my $cfg = {driver => $dbh->{dbh}->get_info(17)};

    die "Can't make out your database driver" unless $cfg->{driver};

    my $self = {};
    my $this = {};

    bless $self, $class;

    # explicitly set the namespace
    defined $nsp ? $self->namespace($nsp) : $self->namespace($class);

    warn "Error connecting to the database..." unless $dbh;
    warn "No database driver specified in the configuration file"
      unless $cfg->{driver};

    # POSTGRESQL CONFIGURATION
    $this = ORMesque::SchemaLoader->new($dbh->{dbh})->mysql
      if lc($cfg->{driver}) =~ '^postgre(s)?(ql)?$';

    # MYSQL CONFIGURATION
    $this = ORMesque::SchemaLoader->new($dbh->{dbh})->mysql
      if lc($cfg->{driver}) eq 'mysql';

    # SQLite CONFIGURATION
    $this = ORMesque::SchemaLoader->new($dbh->{dbh})->sqlite
      if lc($cfg->{driver}) eq 'sqlite';

    $self->{schema} = $this->{schema};
    die "Could not read the specified database $cfg->{driver}"
      unless @{$self->{schema}->{tables}};

    # setup reuseable connection using DBIx::Simple
    $self->{dbh} = DBIx::Simple->connect($dbh->{dbh}) or die DBIx::Simple->error;
    $self->{dbh}->result_class = 'DBIx::Simple::Result';
    $self->{dsn} = [@dsn];

    # define defaults
    $self->{target} = '';

    # create base accessors
    no warnings 'redefine';
    no strict 'refs';

    foreach my $table (@{$self->{schema}->{tables}}) {

        my $class        = $self->namespace;
        my $method       = $class . "::" . lc $table;
        my $classtable   = $table;

           if ($classtable =~ /[\-\_]/) {
                $classtable = join '', map { ucfirst lc $_ }
                    split /[\-\_]/, $classtable;
           }
           else {
                $classtable = ucfirst lc $classtable;
           }

        my $package_name = $class . "::" . $classtable;
        my $package      = "package $package_name;" . q|

            use base '| . $class . q|';

            sub new {
                my ($class, $base, $table) = @_;
                my $self            = {};
                bless $self, $class;
                $self->{table}      = $table;
                $self->{columns}    = $base->{schema}->{table}->{$table}->{columns};
                $self->{where}      = {};
                $self->{order}      = [];
                $self->{key}        = $base->{schema}->{table}->{$table}->{primary_key};
                $self->{collection} = [];
                $self->{cursor}     = 0;
                $self->{current}    = {};
                $self->{namespace}  = $base->{namespace};
                $self->{schema}     = $base->{schema};
                $self->{dbh}        = $base->dbix();
                $self->{dsn}        = $base->{dsn};

                # build database objects
                $self->{configuration} = $cfg;

                foreach my $column (@{$self->{schema}->{table}->{$table}->{columns}}) {
                    $self->{current}->{$column} = '';
                    my $attribute = $class . "::" . $column;
                    *{$attribute} = sub {
                        my ($self, $data) = @_;
                        if (defined $data) {
                            $self->{current}->{$column} = $data;
                            return $data;
                        }
                        else {
                            return
                                $self->{current}->{$column};
                        }
                    };
                }

                return $self;
            }
            1;
            |;
        eval $package;
        die print $@ if $@;    # debugging
        *{$method} = sub {
            return $package_name->new($self, $table);
        };

        # build dbo table

    }

    $Cache = $self;
    return $self;
}

sub _protect_sql {
    my ($dbo, @sql) = @_;

    return @_ unless $dbo->{schema}->{escape_string};

    # set field delimiters
    my ($stag, $etag) =
      length($dbo->{schema}->{escape_string}) == 1
      ? ($dbo->{schema}->{escape_string}, $dbo->{schema}->{escape_string})
      : split //, $dbo->{schema}->{escape_string};

    my $params = {};

    if ("HASH" eq ref $sql[0]) {
        $params = {
            map {
                if ($_ =~ /[^a-zA-Z\_0-9\s]/) {
                    ( $_ => $sql[0]->{$_} )
                }
                else {
                    ( "$stag$_$etag" => $sql[0]->{$_} )
                }
            }   keys %{$sql[0]}
        };
    }
    else {
        $params = [ map {
            if ($_ =~ /[^a-zA-Z\_0-9\s]/) {
                ($_)
            }
            else {
                "$stag$_$etag"
            }
        }   @sql ];
    }

    return "ARRAY" eq ref $params ? ( @{ $params } ) : $params;
}


sub namespace {
    my ($dbo, $namespace) = @_;
    $dbo->{namespace} = $namespace if defined $namespace;
    return $dbo->{namespace};
}


sub reset {
    $Cache = undef;
}


sub next {
    my $dbo = shift;

    $dbo->{collection} ||= [];

    my $next =
    $dbo->{cursor} <= (scalar(@{$dbo->{collection}}) - 1) ? $dbo : undef;
    $dbo->{current} = $dbo->{collection}->[$dbo->{cursor}] || {};
    $dbo->{cursor}++;

    return $next;
}


sub first {
    my $dbo = shift;

    $dbo->{cursor} = 0;
    $dbo->{current} = $dbo->{collection}->[0] || {};

    return $dbo->current;
}


sub last {
    my $dbo = shift;

    $dbo->{cursor} = (scalar(@{$dbo->{collection}}) - 1);
    $dbo->{current} = $dbo->{collection}->[$dbo->{cursor}] || {};

    return $dbo->current;
}


sub collection {
    return shift->{collection};
}


sub current {
    return shift->{current};
}


sub clear {
    my $dbo = shift;

    foreach my $column (keys %{$dbo->{current}}) {
        $dbo->{current}->{$column} = '';
    }

    $dbo->{collection} = [];

    return $dbo;
}


sub key {
    shift->{key};
}


sub select {
    my $dbo = shift;

    $dbo->{select} = [@_] if @_;

    return $dbo;
}


sub return {
    my $dbo   = shift;
    my %where = %{$dbo->current};

    delete $where{$dbo->key} if $dbo->key;

    $dbo->read(\%where)->last;

    return $dbo;
}


sub count {
    my $dbo = shift;
    my $whr = shift;

    if (defined $whr) {
        my @columns = $dbo->_protect_sql($dbo->key || '*');
        my $counter = 'COUNT('. $columns[0] .')';
        $dbo->select($counter)->read($whr);
        return scalar $dbo->list;
    }

    return scalar @{$dbo->{collection}};
}


sub create {
    my $dbo     = shift;
    my $input   = shift || {};
    my @columns = $dbo->_protect_sql(@{$dbo->{columns}});

    die
      "Cannot create an entry in table ($dbo->{table}) without any input parameters."
      unless keys %{$input};

    # add where clause to current for
    # $dbo->create(..); $dbo->return; operations
    if ($input) {
        foreach my $i (keys %{$input}) {
            if (defined $dbo->{current}->{$i}) {
                $dbo->{current}->{$i} = $input->{$i};
            }
        }
    }

    # insert
    $dbo->dbix
      ->insert($dbo->_protect_sql($dbo->{table}), $dbo->_protect_sql($input));

    return $dbo->error ? 0 : 1;
}


sub read {
    my $dbo = shift;

    my $tables = [];

    if ("ARRAY" eq ref $_[0]) {
        $tables = shift;
    }

    my $where = shift || {};
    my $order = shift || [];
    my $table = $dbo->{table};
    my @columns = ();

    my ($limit, $offset) = @_;

    if (defined $dbo->{select}) {
        @columns = $dbo->_protect_sql(@{$dbo->{select}});
    }
    else {
        @columns = $dbo->_protect_sql(@{$dbo->{columns}});
    }

    # generate a where primary_key = ? clause
    if ($where && ref($where) ne "HASH") {
        $where = {$dbo->key => $where};
    }

    if ($limit || $offset || $dbo->{ispaged}) {

        if ($dbo->{ispaged}) {
            $dbo->{ispaged} = 0;
            $dbo->pager->total_entries($dbo->dbix
                  ->select($table, 'COUNT(*)', $dbo->_protect_sql($where))
                  ->array->[0]);
            ($offset, $limit) =
              ($dbo->pager->skipped, $dbo->pager->entries_per_page);
        }

        $dbo->{resultset} = sub {
            return $dbo->dbix->select(
                join(',',
                    $dbo->_protect_sql($table),
                    map { $dbo->_protect_sql($_) } @{$tables}),
                \@columns,
                $dbo->_protect_sql($where),
                $order, $limit, $offset
            );
        };
    }
    else {
        $dbo->{resultset} = sub {
            return $dbo->dbix->select(
                join(',',
                    $dbo->_protect_sql($table),
                    map { $dbo->_protect_sql($_) } @{$tables}),
                \@columns,
                $dbo->_protect_sql($where),
                $order
            );
        };
    }

    if (defined $dbo->{select}) {

        # create a fiticious collection :/

        $dbo->{collection} = [

            map {
                foreach my $i (keys %{$dbo->{current}})
                {
                    unless (defined $_->{$i}) {
                        $_->{$i} = '';
                    }
                }

                $_
              }

              @{$dbo->{resultset}->()->hashes}
        ];

    }
    else {
        $dbo->{collection} = $dbo->{resultset}->()->hashes;
    }

    $dbo->{cursor} = 0;
    $dbo->next;

    $dbo->{select} = undef if defined $dbo->{select};

    return $dbo->error ? 0 : $dbo;
}


sub update {
    my $dbo     = shift;
    my $input   = shift || {};
    my $where   = shift || {};
    my $table   = $dbo->{table};
    my @columns = $dbo->_protect_sql(@{$dbo->{columns}});

    # process direct input
    die
      "Attempting to update an entry in table ($dbo->$table) without any input."
      unless keys %{$input};

    # generate a where primary_key = ? clause
    if ($where && ref($where) ne "HASH") {
        $where = {$dbo->key => $where};
    }

    $dbo->dbix->update(
        $dbo->_protect_sql($table),
        $dbo->_protect_sql($input),
        $dbo->_protect_sql($where)
    ) if keys %{$input};

    return $dbo->error ? 0 : 1;
}


sub delete {
    my $dbo   = shift;
    my $where = shift || {};
    my $table = $dbo->{table};

    # process where clause
    if (ref($where) eq "HASH") { }
    elsif ($where && $dbo->key && ref($where) ne "HASH") {
        $where = {$dbo->key => $where};
    }
    else {
        die "Cannot delete without a proper where clause, "
          . "use delete_all to purge the entire database table";
    }

    $dbo->dbix
      ->delete($dbo->_protect_sql($table), $dbo->_protect_sql($where));

    return $dbo->error ? 0 : 1;
}


sub delete_all {
    my $dbo   = shift;
    my $table = $dbo->{table};

    $dbo->dbix->delete($dbo->_protect_sql($table));

    return $dbo->error ? 0 : 1;
}


sub join {
    my $dbo = shift;

    die 'Join is meant to be called on ORMesque objects with table definitions'
      unless $dbo->{table};

    my @objs = @_;
    my $rs   = [];
    my $q    = 0;

    unshift @objs, $dbo;

    my @tmps = ();

    for (my $i = 0; $i < @objs; $i++) {
        if ("HASH" eq ref $objs[$i]) {
            $tmps[$#tmps]->{join_configuration} = $objs[$i];
        }
        else {
            $objs[$i]->{join_configuration} = {};
            push @tmps, $objs[$i];
        }
    }

    @objs = @tmps;

    if (@objs > 1) {
        foreach my $obj (@objs) {
            die 'Invalid ORMesque object passed to join'
              unless $obj->{table} && $obj->{collection};
        }

        # use the first object to set the length of the aggregator
        for (my $i = 0; $i < scalar(@{$objs[0]->{collection}}); $i++) {
            my $aggregate = {};
            for (my $y = 0; $y < @objs; $y++) {
                my $cfg = $objs[$y]->{join_configuration};
                my $rec = $objs[$y]->{collection}->[$i];
                if (keys %{$objs[$y]->{join_configuration}}) {
                    if ($cfg->{persist}) {
                        $rec = $objs[$y]->{collection}->[0];
                    }
                }
                my $new = {
                    map { $objs[$y]->{table} . "_" . $_ => $rec->{$_} }
                      keys %{($rec || $objs[$y]->{current})}
                };
                if ($cfg->{columns}) {
                    my $xchg = {};
                    foreach (keys %{$cfg->{columns}}) {
                        $xchg->{$cfg->{columns}->{$_}} = $new->{$_};
                    }
                    $new = $xchg;
                }
                $aggregate = {%{$aggregate}, %{$new}};
            }
            $rs->[$q++] = $aggregate;
        }
        return $rs;
    }
    else {
        die 'Please supply two or more ORMesque objects which may include the '
          . 'invoking object (self) before performing a join';
    }
}


sub page {
    my $dbo = shift;
    die 'The page method requires a page number and number of rows to return'
      unless @_ == 2;

    $dbo->{ispaged} = 1;

    $dbo->pager->current_page($_[0]);
    $dbo->pager->entries_per_page($_[1]);

    return $dbo;
}


sub pager {
    my $dbo = shift;
    $dbo->{pager} ||= Data::Page->new(@_);
}



sub columns {
    shift->{resultset}->()->columns(@_);
}


sub into {
    return shift->{resultset}->()->into(@_);
}


sub list {
    return shift->{resultset}->()->list(@_);
}


sub array {
    return shift->{resultset}->()->array(@_);
}


sub hash {
    return shift->{resultset}->()->hash(@_);
}


sub flat {
    return shift->{resultset}->()->flat(@_);
}


sub arrays {
    return shift->{resultset}->()->arrays(@_);
}


sub hashes {
    return shift->{resultset}->()->hashes(@_);
}


sub map_hashes {
    return shift->{resultset}->()->map_hashes(@_);
}


sub map_arrays {
    return shift->{resultset}->()->map_arrays(@_);
}


sub rows {
    return shift->{resultset}->()->rows(@_);
}


sub error {
    my $dbo = shift;
    my $err = $dbo->{dbh}->error(@_);
       $err =~ s/^DBI error\:\s+//;
       $err =~ s/\n+/\, /g;
    return $err;
}


sub query {
    return shift->dbix->query(@_);
}


sub iquery {
    return shift->dbix->iquery(@_);
}


sub dbix {
    my $dbo = shift;

    $dbo->{last_chk} ||= 0;

    if ((time - $dbo->{last_chk}) < 10) {
        return $dbo->{dbh};
    }
    else {
        if ($dbo->connected) {
            return $dbo->{dbh};
        }
        else {
            $dbo->{dbh} = DBIx::Simple->connect(@{$dbo->{dsn}})
              or die DBIx::Simple->error;
            $dbo->{last_chk} = time;
        }
    }

    return $dbo->{dbh};
}


sub dbi {
    return shift->dbix->{dbh};
}


sub connected {
    my $dbo = shift;
    return unless $dbo->{dbh}->{dbh};
    if (int($dbo->{dbh}->{dbh}->ping)) {
        return 1;
    }
    else {
        my $ok = 0;
        eval { $ok = $dbo->{dbh}->{dbh}->do('select 1') };
        return $ok;
    }
    return 0;
}

1;

__END__