ActiveRecord-Simple
view release on metacpan or search on metacpan
Revision history for Perl module ActiveRecord::Simple
0.21 2013-01-16
First public release.
0.25 2013-02-10
* Many bug fixes
* Improved relations
+ Added test suite (see sandbox)
+ Added relation type many-to-many
0.30 2013-07-10
* Minor bug bixes
+ Added ordering methods "order_by", "asc" and "desc"
0.31 2013-07-11
* Fixes
0.32 2013-07-12
* Fixed typos
0.33 2013-07-12
+ [EXPERIMENTAL] Added a new method "use_smart_saving".
0.34 2013-08-21
+ Added tracing queries
+ Added some tests
* Minor fixes
0.35 2013-08-26
+ Added new "update-on-destroy" feature.
0.40 2013-10-23
+ Added methods: limit, offset
+ Method "find" now works with no arguments
(returns all records from db)
- Deleted method "get_all"
* Bugfixes
* Method find() with primary key goes to be named get()
* Tests fixes
* Improved documentation
0.41 2013-10-24
* Code cleanup
* Bux fixes
* Typo fixes
0.50 2013-11-02
+ Added ability to change relation instance into object
+ Added some tests
* Fixed "save" method
* Many fixes and huge code improvements
* Typo fixes
0.51 2013-11-11
+ Added method's "last" & "first"
+ Added new class ActiveRecord::Simple::Tutorial with pod-documentation
+ Implemented schema-loader script called "mars"
+ Added method "count"
+ Added method "exists"
+ Added possibility to creating read-only objects: fetch({ read_only => 1 })
+ Added new syntax to method "fetch"
+ Added possibility to select only specific fields ("only")
* Improved tests
* Improved documentation
* Fixed bugs
0.52 2013-11-26
* Fixed the `fetch` behavior
* Fixed tests
0.53 2014-05-12
+ Added method "increment" (thnx @lifeofguenter)
+ Added method "decrement" (thnx @lifeofguenter)
0.60.0 2014-05-19
+ Added new relationships aliases
+ Added generic relations
* Improved increment/decrement methods
* Migrated to semver
0.61.0 2014-09-17
+ Added schema builder (with method "fields")
+ Added fields validation (only when "fields" method is used)
+ Added class method "as_sql"
+ Added PACKAGE method "index"
0.64 2014-09-19
+ Improved method "columns"
+ Improved relationship framework
* Fixed bugs
0.65 2014-09-26
+ Dependancy on SQL::Translator now is optional (thanks to @kberov)
+ Added Credits - list of contributors (see README)
* Fixed bugs
* Improved tests
0.70 2015-08-14
+ Added ARS_TRACE
+ Created method "update" for quick objects update
+ New mars command "--upload"
* Improved `find` and `count` methods, now you can use find({ id => [1, 2, 3] }) as '.. where id in (1, 2, 3)'
* Improved error handling
* Method `new` now takes simple hashes (not only hashrefs)
* Improved documentation
0.80 2016-01-05
+ Added method "abstract"
+ Added method "select"
+ Added method "update"
+ Added method "abstract"
+ Added method "next"
+ Added "where in ... " condition to find
+ Added method "connect"
* Improved error handling
* Improved "new" method
+ Added LEFT JOIN
* Optimization of data fetch
* Improved documentation
+ Added package method "load_info"
+ "Smart accessors"
+ Added cookbook
* Improved tests
0.84 2016-07-13
+ Added scalarref as an argument of accessor to set not-quoted data (e.g. to send database-specific functions)
+ Now multiobject accessor is a "ARS::Find" object too, you can use such method as "order_by", "desc" etc.
* Small bugfixes
0.90 2016-07-16
+ Added "smart accessors" to methods "new", "find", "count".
* Small fixes
* Improved documentation
0.91 2017-08-19
+ New behavior of method "fetch"
+ Use DBIx::Connector if it's in the system
+ Added "group_by" method (thanks to @reindeer)
* Imrpoved many-to-many objects manipulations
* "asc", "desc" in every columns (thanks to @reindeer)
* New API for "count" method (thanks to @reindeer)
* New API for "last", "first" methods
* Fixed connection bug
* Renamed method "load_info" to "autoload"
* Renamed "use_smart_saving" to "autosave"
* Fixed typos
0.92 2017-08-20
* Improve "next" method in favor less memory usage
* Fixes
0.93 2017-08-21
+ Method "next" not takes a number of given objects. Default is 1
* Fixed auto_load error
* Fixed error messages
* Different fixes
0.95 2017-09-22
+ Method "sql_fetch_all"
+ Method "sql_fetch_row"
0.96 2017-09-25
+ Method "all"
+ Mixins now can get $class
+ Added class Meta.pm, access via method "META" in ARS::Model
* Improved relations
* Fixed "auto_load" behavior
0.97 2017-10-13
- Method "fields"
- Classes
- SQL::Traslator things
1.00 2018-01-02
* New faster accessors
* Improved tests
* Updated sandbox
+ New option "make_columns_accessors"
- script/mars
- "abstract" method
- "select" method
* Improved documentation
1.10 2018-01-13
* Fixed bugs
+ new class ActiveRecord::Simple::QueryManager
+ new "objects" method
- method "find" [DEPRECATED]
- method "all" [DEPRECATED]
- method "get" [DEPRECATED]
1.11 2018-01-17
* Improvement of module loading
Changes
lib/ActiveRecord/Simple.pm
lib/ActiveRecord/Simple/Connect.pm
lib/ActiveRecord/Simple/Find.pm
lib/ActiveRecord/Simple/Utils.pm
lib/ActiveRecord/Simple/QueryManager.pm
Makefile.PL
MANIFEST This list of files
README.md
README
t/00-load.t
t/01-boilerplate.t
t/02-pod.t
t/03-pod-coverage.t
t/04-manifest.t
t/05-accessors.t
t/06-no-accessors.t
t/07-auto_load.t
t/08-basic.t
t/09-find.t
t/10-relations.t
t/11-crud-methods.t
t/12-connect.t
t/13-init.t
t/14-smart-accessors.t
t/15-sql-row.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
{
"abstract" : "unknown",
"author" : [
"shootnix <shootnix@cpan.org>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "ActiveRecord-Simple",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0",
"Test::More" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"DBD::SQLite" : "0",
"DBI" : "0",
"Module::Load" : "0",
"Scalar::Util" : "0",
"perl" : "5.010"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"url" : "https://github.com/shootnix/activerecord-simple"
}
},
"version" : "1.11",
"x_serialization_backend" : "JSON::PP version 2.97000"
}
---
abstract: unknown
author:
- 'shootnix <shootnix@cpan.org>'
build_requires:
ExtUtils::MakeMaker: '0'
Test::More: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: ActiveRecord-Simple
no_index:
directory:
- t
- inc
requires:
DBD::SQLite: '0'
DBI: '0'
Module::Load: '0'
Scalar::Util: '0'
perl: '5.010'
resources:
repository: https://github.com/shootnix/activerecord-simple
version: '1.11'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Makefile.PL view on Meta::CPAN
use 5.006;
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile1(
NAME => 'ActiveRecord::Simple',
AUTHOR => q{shootnix <shootnix@cpan.org>},
VERSION_FROM => 'lib/ActiveRecord/Simple.pm',
LICENSE => 'perl',
PL_FILES => {},
PREREQ_PM => {
'Module::Load' => 0,
'DBI' => 0,
'DBD::SQLite' => 0,
'Scalar::Util' => 0,
},
MIN_PERL_VERSION => '5.010',
META_MERGE => {
resources => {
repository => 'https://github.com/shootnix/activerecord-simple',
},
},
TEST_REQUIRES => {
'Test::More' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'ActiveRecord::Simple-*' },
);
sub WriteMakefile1 { #Compatibility code for old versions of EU::MM. Written by Alexandr Ciornii, version 0.23. Added by eumm-upgrade.
my %params=@_;
my $eumm_version=$ExtUtils::MakeMaker::VERSION;
$eumm_version=eval $eumm_version;
die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
die "License not specified" if not exists $params{LICENSE};
if ($params{AUTHOR} and ref($params{AUTHOR}) eq 'ARRAY' and $eumm_version < 6.5705) {
$params{META_ADD}->{author}=$params{AUTHOR};
$params{AUTHOR}=join(', ',@{$params{AUTHOR}});
}
if ($params{TEST_REQUIRES} and $eumm_version < 6.64) {
$params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} };
delete $params{TEST_REQUIRES};
}
if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
#EUMM 6.5502 has problems with BUILD_REQUIRES
$params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };
delete $params{BUILD_REQUIRES};
}
delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
delete $params{META_MERGE} if $eumm_version < 6.46;
delete $params{META_ADD} if $eumm_version < 6.46;
delete $params{LICENSE} if $eumm_version < 6.31;
delete $params{AUTHOR} if $] < 5.005;
delete $params{ABSTRACT_FROM} if $] < 5.005;
delete $params{BINARY_LOCATION} if $] < 5.005;
WriteMakefile(%params);
}
ActiveRecord::Simple
====================
ActiveRecord::Simple - Simple to use lightweight implementation of ActiveRecord pattern.
It is fast, don't have any dependencies and realy easy to use.
The basic setup of your package should be:
package Model::Foo;
use base 'ActiveRecord::Simple';
__PACKAGE__->table_name('foo');
__PACKAGE__->columns('id', 'bar', 'baz');
__PACKAGE__->primary_key('id');
1;
And then, you can use your package in a program:
use Foo;
my $foo = Foo->new({ bar => 'value', baz => 'value' });
$foo->save();
# or
my $foo = Foo->get(1);
print $foo->bar;
# or
$foo->bar('new value')->save();
print $foo->bar;
See pod documentation of the module for more information about using
ActiveRecord::Simple.
What we've got?
===============
Flexible search
Person->find(1); # by ID
Person->find([1, 2, 3]); # by several ID's
Person->find({ name => 'Foo' }); # by parameters
Person->find({ city => City->find({name => 'Paris'})->fetch }); # parameters as an objects
Person->find('name = ? OR lastname = ?', 'Foo', 'Bar'); # by condition
Person->last; # last object in the database
Person->first; # first object
Easy fetch
# Just one object:
my $bill = Person->find({ name => 'Bill' })->fetch;
# Only 3 objects:
my @list = Person->find('age > ?', 21)->fetch(3);
# All objects:
my @list = Person->find->fetch;
# Even more:
while (my $person = Person->find->fetch) {
print $person->name, "\n";
}
Simple ordering:
Person->find->order_by('name');
Person->find->order_by('name', 'last_name');
Person->find->order_by('name')->desc;
Limit, Offset:
Person->find->limit(3);
Person->find->offset(10);
Person->find->limit(3)->offset(12);
Left joins:
my $person = Person->find->with('misc_info')->fetch;
print $person->name;
print $person->misc_info->zip;
And, of course, all of this together:
my $new_customer =
Person->find
->only('name')
->order_by('date_register')
->desc
->limit(1)
->with('misc_info', 'payment_info')
->fetch;
print $new_customer->name;
print $new_customer->misc_info->zip;
print $new_customer->payment_info->last_payment;
Also one-to-one, one-to-many, many-to-one and many-to-many relations, smart_saving and even more.
And, of course, you don't need use "table_name", "primary_key" etc. Just use this:
__PACKAGE__->load_info(); ### All info will be loaded from database automatically.
Check it out!
INSTALLATION
============
To install this module, run the following commands:
$ perl Makefile.PL
$ make
$ make test
$ make install
or:
$ sudo cpan ActiveRecord::Simple
SUPPORT AND DOCUMENTATION
=========================
After installing, you can find documentation for this module with the
perldoc command.
perldoc ActiveRecord::Simple
Feel free to join us at google groups:
https://groups.google.com/forum/#!forum/activerecord-simple
Also the github page:
http://shootnix.github.io/activerecord-simple/
LICENSE AND COPYRIGHT
=====================
Copyright (C) 2013-2018 shootnix
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
CREDITS
=======
@shootnix
@kberov
@chorny
@lifeofguenter
@neilbowers
@dsteinbrunner
@reindeer
@grinya007
ActiveRecord::Simple
====================
ActiveRecord::Simple - Simple to use lightweight implementation of ActiveRecord pattern.
It is fast, don't have any dependencies and realy easy to use.
The basic setup of your package should be:
package Model::Foo;
use base 'ActiveRecord::Simple';
__PACKAGE__->table_name('foo');
__PACKAGE__->columns('id', 'bar', 'baz');
__PACKAGE__->primary_key('id');
1;
And then, you can use your package in a program:
use Foo;
my $foo = Foo->new({ bar => 'value', baz => 'value' });
$foo->save();
# or
my $foo = Foo->get(1);
print $foo->bar;
# or
$foo->bar('new value')->save();
print $foo->bar;
See pod documentation of the module for more information about using
ActiveRecord::Simple.
What we've got?
===============
Flexible search
Person->find(1); # by ID
Person->find([1, 2, 3]); # by several ID's
Person->find({ name => 'Foo' }); # by parameters
Person->find({ city => City->find({name => 'Paris'})->fetch }); # parameters as an objects
Person->find('name = ? OR lastname = ?', 'Foo', 'Bar'); # by condition
Person->last; # last object in the database
Person->first; # first object
Easy fetch
# Just one object:
my $bill = Person->find({ name => 'Bill' })->fetch;
# Only 3 objects:
my @list = Person->find('age > ?', 21)->fetch(3);
# All objects:
my @list = Person->find->fetch;
# Even more:
while (my $person = Person->find->fetch) {
print $person->name, "\n";
}
Simple ordering:
Person->find->order_by('name');
Person->find->order_by('name', 'last_name');
Person->find->order_by('name')->desc;
Limit, Offset:
Person->find->limit(3);
Person->find->offset(10);
Person->find->limit(3)->offset(12);
Left joins:
my $person = Person->find->with('misc_info')->fetch;
print $person->name;
print $person->misc_info->zip;
And, of course, all of this together:
my $new_customer =
Person->find
->only('name')
->order_by('date_register')
->desc
->limit(1)
->with('misc_info', 'payment_info')
->fetch;
print $new_customer->name;
print $new_customer->misc_info->zip;
print $new_customer->payment_info->last_payment;
Also one-to-one, one-to-many, many-to-one and many-to-many relations, smart_saving and even more.
And, of course, you don't need use "table_name", "primary_key" etc. Just use this:
__PACKAGE__->load_info(); ### All info will be loaded from database automatically.
Check it out!
INSTALLATION
============
To install this module, run the following commands:
$ perl Makefile.PL
$ make
$ make test
$ make install
or:
$ sudo cpan ActiveRecord::Simple
SUPPORT AND DOCUMENTATION
=========================
After installing, you can find documentation for this module with the
perldoc command.
perldoc ActiveRecord::Simple
Feel free to join us at google groups:
https://groups.google.com/forum/#!forum/activerecord-simple
Also the github page:
http://shootnix.github.io/activerecord-simple/
LICENSE AND COPYRIGHT
=====================
Copyright (C) 2013-2018 shootnix
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
CREDITS
=======
@shootnix
@kberov
@chorny
@lifeofguenter
@neilbowers
@dsteinbrunner
@reindeer
@grinya007
@manwar
lib/ActiveRecord/Simple.pm view on Meta::CPAN
package ActiveRecord::Simple;
use 5.010;
use strict;
use warnings;
our $VERSION = '1.11';
use utf8;
use Carp;
use Scalar::Util qw/blessed/;
use ActiveRecord::Simple::QueryManager;
use ActiveRecord::Simple::Utils qw/all_blessed class_to_table_name load_module/;
use ActiveRecord::Simple::Connect;
our $connector;
my $qm = ActiveRecord::Simple::QueryManager->new();
sub new {
my $class = shift;
my $params = (scalar @_ > 1) ? {@_} : $_[0];
# relations
$class->_init_relations if $class->can('_get_relations');
return bless $params || {}, $class;
}
sub auto_load {
my ($class) = @_;
my $table_name = class_to_table_name($class);
# 0. check the name
my $table_info_sth = $class->dbh->table_info('', '%', $table_name, 'TABLE');
$table_info_sth->fetchrow_hashref or croak "Can't find table '$table_name' in the database";
# 1. columns list
my $column_info_sth = $class->dbh->column_info(undef, undef, $table_name, undef);
my $cols = $column_info_sth->fetchall_arrayref({});
my @columns = ();
push @columns, $_->{COLUMN_NAME} for @$cols;
# 2. Primary key
my $primary_key_sth = $class->dbh->primary_key_info(undef, undef, $table_name);
my $primary_key_data = $primary_key_sth->fetchrow_hashref;
my $primary_key = ($primary_key_data) ? $primary_key_data->{COLUMN_NAME} : undef;
$class->table_name($table_name) if $table_name;
$class->primary_key($primary_key) if $primary_key;
$class->columns(@columns) if @columns;
}
sub connect {
my ($class, $dsn, $username, $password, $options) = @_;
eval { require DBIx::Connector };
$options->{HandleError} = sub {
my ($error_message, $DBI_st) = @_;
$error_message or return;
croak $error_message;
} if ! exists $options->{HandleError};
if ($@) {
$connector = ActiveRecord::Simple::Connect->new($dsn, $username, $password, $options);
$connector->db_connect;
}
else {
$connector = DBIx::Connector->new($dsn, $username, $password, $options);
}
return 1;
}
sub belongs_to {
my ($class, $rel_name, $rel_class, $params) = @_;
my $new_relation = {
class => $rel_class,
type => 'one',
};
my $primary_key = $params->{pk} ||
$params->{primary_key} ||
_guess(primary_key => $class);
my $foreign_key = $params->{fk} ||
$params->{foreign_key} ||
_guess(foreign_key => $rel_class);
$new_relation->{params} = {
pk => $primary_key,
fk => $foreign_key,
};
$class->_append_relation($rel_name => $new_relation);
#$class->_mk_relations_accessors;
}
sub has_many {
my ($class, $rel_name, $rel_class, $params) = @_;
my $new_relation = {
class => $rel_class,
type => 'many',
};
$params ||= {};
my $primary_key = $params->{pk} ||
$params->{primary_key} ||
_guess(primary_key => $class);
my $foreign_key = $params->{fk} ||
$params->{foreign_key} ||
_guess(foreign_key => $class);
$new_relation->{params} = {
pk => $primary_key,
fk => $foreign_key,
};
$new_relation->{via_table} = $params->{via} if $params->{via};
$class->_append_relation($rel_name => $new_relation);
#$class->_mk_relations_accessors;
}
sub has_one {
my ($class, $rel_name, $rel_class, $params) = @_;
my $new_relation = {
class => $rel_class,
type => 'only',
};
$params ||= {};
#my ($primary_key, $foreign_key);
my $primary_key = $params->{pk} ||
$params->{primary_key} ||
_guess(primary_key => $class);
my $foreign_key = $params->{fk} ||
$params->{foreign_key} ||
_guess(foreign_key => $class);
$new_relation->{params} = {
pk => $primary_key,
fk => $foreign_key,
};
$class->_append_relation($rel_name => $new_relation);
#$class->_mk_relations_accessors;
}
sub generic {
my ($class, $rel_name, $rel_class, $key) = @_;
my $new_relation = {
class => $rel_class,
type => 'generic',
key => $key
};
return $class->_append_relation($rel_name => $new_relation);
$class->_mk_relations_accessors;
}
sub columns {
my ($class, @columns_list) = @_;
croak "Error: array-ref no longer supported for 'columns' method, sorry"
if scalar @columns_list == 1 && ref $columns_list[0] eq 'ARRAY';
$class->_mk_attribute_getter('_get_columns', \@columns_list);
$class->_mk_rw_accessors(\@columns_list) unless $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
}
sub make_columns_accessors {
my ($class, $flag) = @_;
$flag //= 1; # default value
$class->_mk_attribute_getter('_make_columns_accessors', $flag);
}
sub mixins {
my ($class, %mixins) = @_;
$class->_mk_attribute_getter('_get_mixins', \%mixins);
$class->_mk_ro_accessors([keys %mixins]);
}
sub primary_key {
my ($class, $primary_key) = @_;
$class->_mk_attribute_getter('_get_primary_key', $primary_key);
}
sub secondary_key {
my ($class, $key) = @_;
$class->_mk_attribute_getter('_get_secondary_key', $key);
}
sub table_name {
my ($class, $table_name) = @_;
$class->_mk_attribute_getter('_get_table_name', $table_name);
}
sub relations {
my ($class, $relations) = @_;
$class->_mk_attribute_getter('_get_relations', $relations);
}
sub dbh {
my ($self, $dbh) = @_;
if ($dbh) {
if ($connector) {
$connector->dbh($dbh);
}
else {
$connector = ActiveRecord::Simple::Connect->new();
$connector->dbh($dbh);
}
}
return $connector->dbh;
}
sub objects {
$qm->{caller} = shift;
return $qm;
}
sub save {
my ($self) = @_;
#return unless $self->dbh;
croak "Undefined database handler" unless $self->dbh;
croak 'Object is read-only'
if exists $self->{read_only} && $self->{read_only} == 1;
my $save_param = {};
my $fields = $self->_get_columns;
my $pkey = ($self->can('_get_primary_key')) ? $self->_get_primary_key : undef;
FIELD:
for my $field (@$fields) {
next FIELD if defined $pkey && $field eq $pkey && !$self->{$pkey};
next FIELD if ref $field && ref $field eq 'HASH';
$save_param->{$field} = $self->{$field};
}
### Get additional fields from related objects:
for my $field (keys %$self) {
next unless ref $self->{$field};
next unless $self->can('_get_relations');
next unless grep { $_ eq $field } keys %{ $self->_get_relations };
my $relation = $self->_get_relations->{$field} or next;
next unless $relation->{type} && $relation->{type} eq 'one';
my $fk = $relation->{params}{fk};
my $pk = $relation->{params}{pk};
$save_param->{$fk} = $self->{$field}->$pk;
}
my $result;
if ($self->{isin_database}) {
$result = $self->_update($save_param);
}
else {
$result = $self->_insert($save_param);
}
$self->{need_to_save} = 0 if $result;
delete $self->{SQL} if $result;
return (defined $result) ? $self : undef;
}
sub update {
my ($self, $params) = @_;
my $fields = $self->_get_columns();
FIELD:
for my $field (@$fields) {
next FIELD if ! exists $params->{$field};
next FIELD if ! $params->{$field};
$self->{$field} = $params->{$field};
}
return $self;
}
# param:
# cascade => 1
sub delete {
my ($self, $param) = @_;
return unless $self->dbh;
#my $table_name = $self->_table_name;
my $table_name = _what_is_the_table_name($self);
my $pkey = $self->_get_primary_key;
return unless $self->{$pkey};
my $sql = qq{
DELETE FROM "$table_name" WHERE $pkey = ?
};
$sql .= ' CASCADE ' if $param && $param->{cascade};
my $res = undef;
$sql = ActiveRecord::Simple::Utils::quote_sql_stmt($sql, $self->dbh->{Driver}{Name});
if ( $self->dbh->do($sql, undef, $self->{$pkey}) ) {
$self->{isin_database} = undef;
delete $self->{$pkey};
$res = 1;
}
return $res;
}
sub is_defined {
my ($self) = @_;
return grep { defined $self->{$_} } @{ $self->_get_columns };
}
# param:
# only_defined_fields => 1
### TODO: refactor this
sub to_hash {
my ($self, $param) = @_;
my $field_names = $self->_get_columns;
push @$field_names, keys %{ $self->_get_mixins } if $self->can('_get_mixins');
my $attrs = {};
for my $field (@$field_names) {
next if ref $field;
if ( $param && $param->{only_defined_fields} ) {
$attrs->{$field} = $self->{$field} if defined $self->{$field};
}
else {
$attrs->{$field} = $self->{$field};
}
}
return $attrs;
}
sub increment {
my ($self, @fields) = @_;
FIELD:
for my $field (@fields) {
next FIELD if not exists $self->{$field};
$self->{$field} += 1;
}
return $self;
}
sub decrement {
my ($self, @fields) = @_;
FIELD:
for my $field (@fields) {
next FIELD if not exists $self->{$field};
$self->{$field} -= 1;
}
return $self;
}
#### Find ####
sub find {
$qm->{caller} = shift;
carp
q/[DEPRECATED] This method is DEPRECATED since version 1.10. '/ .
q/Please, use "find" via "objects" method: / . $qm->{caller} . q/->objects->find/;
$qm->find(@_);
}
sub all {
$qm->{caller} = shift;
carp
q/[DEPRECATED] This method is DEPRECATED since version 1.10. '/ .
q/Please, use "all" via "objects" method: / . $qm->{caller} . q/->objects->all/;
$qm->all();
}
sub get {
$qm->{caller} = shift;
carp
q/[DEPRECATED] This method is DEPRECATED since version 1.10. '/ .
q/Please, use "get" via "objects" method: / . $qm->{caller} . q/->objects->get/;
$qm->get(@_);
}
sub exists {
my $first_arg = shift;
my ($class, @search_criteria);
if (ref $first_arg) {
# FIXME: Ugly solution, need some beautifulness =)
# object method
$class = ref $first_arg;
if ($class eq 'ActiveRecord::Simple::Find') {
return $first_arg->exists;
}
else {
return ActiveRecord::Simple::Find->new($class, $first_arg->to_hash({ only_defined_fields => 1 }))->exists;
}
}
else {
carp '[DEPRECATED] This way of using method "exists" is deprecated. Please, see documentation to know how does it work now.';
$class = $first_arg;
@search_criteria = @_;
return (defined $class->find(@search_criteria)->fetch) ? 1 : 0;
}
}
sub _find_many_to_many { ActiveRecord::Simple::Find->_find_many_to_many(shift, @_) }
sub DESTROY {}
### Private
sub _get_primary_key_value {
my ($self) = @_;
croak "Sory, you can call method '_get_primary_key_value' on unblessed scalar."
unless blessed $self;
my $pk = $self->_get_primary_key;
return $self->$pk;
}
sub _get_relation_type {
my ($class, $relation) = @_;
my $type = $relation->{type};
$type .= '_to_';
my $related_class = _get_related_class($relation);
#eval { load $related_class }; ### TODO: check module is loaded
#load $related_class;
#load $related_class unless is_loaded $related_class;
#mark_as_loaded $related_class;
load_module $related_class;
my $rel_type = undef;
while (my ($rel_key, $rel_opts) = each %{ $related_class->_get_relations }) {
next if $class ne _get_related_class($rel_opts);
$rel_type = $rel_opts->{type};
}
croak 'Oops! Looks like related class ' . $related_class . ' has no relations with ' . $class unless $rel_type;
$type .= $rel_type;
return $type;
}
sub _get_related_subclass {
my ($relation) = @_;
return undef if !ref $relation->{class};
my $subclass;
if (ref $relation->{class} eq 'HASH') {
$subclass = (keys %{ $relation->{class} })[0];
}
elsif (ref $relation->{class} eq 'ARRAY') {
$subclass = $relation->{class}[0];
}
return $subclass;
}
sub _get_related_class {
my ($relation) = @_;
return $relation->{class} if !ref $relation->{class};
my $related_class;
if (ref $relation->{class} eq 'HASH') {
$related_class = ( %{ $relation->{class} } )[1]
}
elsif (ref $relation->{class} eq 'ARRAY') {
$related_class = $relation->{class}[1];
}
return $related_class;
}
sub _insert {
my ($self, $param) = @_;
return unless $self->dbh && $param;
#my $table_name = $self->_table_name;
my $table_name = _what_is_the_table_name($self);
my @field_names = grep { defined $param->{$_} } sort keys %$param;
my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
my $field_names_str = join q/, /, map { q/"/ . $_ . q/"/ } @field_names;
my (@bind, @values_list);
for (@field_names) {
if (ref $param->{$_} eq 'SCALAR') {
push @values_list, ${ $param->{$_} };
}
else {
push @values_list, '?';
push @bind, $param->{$_};
}
}
my $values = join q/, /, @values_list;
my $pkey_val;
my $sql_stm = qq{
INSERT INTO "$table_name" ($field_names_str)
VALUES ($values)
};
if ( $self->dbh->{Driver}{Name} eq 'Pg' ) {
if ($primary_key) {
$sql_stm .= ' RETURINIG ' . $primary_key if $primary_key;
$sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name});
$pkey_val = $self->dbh->selectrow_array($sql_stm, undef, @bind);
}
else {
my $sth = $self->dbh->prepare(
ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
);
$sth->execute(@bind);
}
}
else {
my $sth = $self->dbh->prepare(
ActiveRecord::Simple::Utils::quote_sql_stmt($sql_stm, $self->dbh->{Driver}{Name})
);
$sth->execute(@bind);
if ( $primary_key && defined $self->{$primary_key} ) {
$pkey_val = $self->{$primary_key};
}
else {
$pkey_val =
exists $sth->{mysql_insertid} # mysql only
? $sth->{mysql_insertid}
: $self->dbh->last_insert_id(undef, undef, $table_name, undef);
}
}
if (defined $primary_key && $self->can($primary_key) && $pkey_val) {
#$self->$primary_key($pkey_val);
$self->{$primary_key} = $pkey_val;
}
$self->{isin_database} = 1;
return $pkey_val;
}
sub _update {
my ($self, $param) = @_;
return unless $self->dbh && $param;
#my $table_name = $self->_table_name;
my $table_name = _what_is_the_table_name($self);
my @field_names = sort keys %$param;
my $primary_key = ($self->can('_get_primary_key')) ? $self->_get_primary_key :
($self->can('_get_secondary_key')) ? $self->_get_secondary_key : undef;
my (@set_list, @bind);
for (@field_names) {
if (ref $param->{$_} eq 'SCALAR') {
push @set_list, $_ . ' = ' . ${ $param->{$_} };
}
else {
push @set_list, "$_ = ?";
push @bind, $param->{$_};
}
}
my $setstring = join q/, /, @set_list;
push @bind, $self->{$primary_key};
my $sql_stm = ActiveRecord::Simple::Utils::quote_sql_stmt(
qq{
UPDATE "$table_name" SET $setstring
WHERE
$primary_key = ?
},
$self->dbh->{Driver}{Name}
);
return $self->dbh->do($sql_stm, undef, @bind);
}
sub _mk_rw_accessors {
my ($class, $fields) = @_;
return unless $fields;
return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
$class->_mk_accessors($fields, 'rw');
}
sub _mk_ro_accessors {
my ($class, $fields) = @_;
return unless $fields;
return if $class->can('_make_columns_accessors') && $class->_make_columns_accessors == 0;
$class->_mk_accessors($fields, 'ro');
}
sub _mk_accessors {
my ($class, $fields, $type) = @_;
$type ||= 'rw';
my $code_string = q//;
METHOD_NAME:
for my $method_name (@$fields) {
next METHOD_NAME if $class->can($method_name);
$code_string .= "sub $method_name {\n";
if ($type eq 'rw') {
$code_string .= "if (\@_ > 1) { \$_[0]->{$method_name} = \$_[1]; return \$_[0] }\n";
}
elsif ($type eq 'ro') {
$code_string .= "die 'Object is read-only, sorry' if \@_ > 1;\n";
}
$code_string .= "return \$_[0]->{$method_name};\n }\n";
}
eval "package $class;\n $code_string" if $code_string;
say $@ if $@;
}
sub _guess {
my ($what_key, $class) = @_;
return 'id' if $what_key eq 'primary_key';
#eval { load $class }; ### TODO: check class has been loaded
#load $class unless is_loaded $class;
#mark_as_loaded $class;
load_module $class;
my $table_name = _what_is_the_table_name($class);
$table_name =~ s/s$// if $what_key eq 'foreign_key';
return ($what_key eq 'foreign_key') ? "$table_name\_id" : undef;
}
sub _delete_keys {
my ($self, $rx) = @_;
map { delete $self->{$_} if $_ =~ $rx } keys %$self;
}
sub _append_relation {
my ($class, $rel_name, $rel_hashref) = @_;
if ($class->can('_get_relations')) {
my $relations = $class->_get_relations();
$relations->{$rel_name} = $rel_hashref;
$class->relations($relations);
}
else {
$class->relations({ $rel_name => $rel_hashref });
}
return $rel_hashref;
}
sub _mk_attribute_getter {
my ($class, $method_name, $return) = @_;
return if $class->can($method_name);
eval "package $class; \n sub $method_name { \$return }";
}
sub _init_relations {
my ($class) = @_;
my $relations = $class->_get_relations;
no strict 'refs';
RELATION_NAME:
for my $relation_name ( keys %{ $relations }) {
my $pkg_method_name = $class . '::' . $relation_name;
next RELATION_NAME if $class->can($pkg_method_name); ### FIXME: orrrr $relation_name???
my $relation = $relations->{$relation_name};
my $full_relation_type = _get_relation_type($class, $relation);
my $related_class = _get_related_class($relation);
### TODO: check for error if returns undef
my $pk = $relation->{params}{pk};
my $fk = $relation->{params}{fk};
my $instance_name = "relation_instance_$relation_name";
if (grep { $full_relation_type eq $_ } qw/one_to_many one_to_one one_to_only/) {
*{$pkg_method_name} = sub {
my ($self, @args) = @_;
if (@args) {
my $object = shift @args;
croak "Using unblessed scalar as an object reference"
unless blessed $object;
$object->save() if ! exists $object->{isin_database} && !$object->{isin_database} == 1;
#$self->$fk($object->$pk);
$self->{$fk} = $object->{$pk};
$self->{$instance_name} = $object;
return $self;
}
# else
if (!$self->{$instance_name}) {
$self->{$instance_name} = $related_class->objects->get($self->{$fk}) // $related_class;
}
return $self->{$instance_name};
}
}
elsif ($full_relation_type eq 'only_to_one') {
*{$pkg_method_name} = sub {
my ($self, @args) = @_;
if (!$self->{$instance_name}) {
$self->{$instance_name} = $related_class->find("$fk = ?", $self->{$pk})->fetch;
}
return $self->{$instance_name};
}
}
elsif ($full_relation_type eq 'many_to_one') {
*{$pkg_method_name} = sub {
my ($self, @args) = @_;
if (@args) {
unless (all_blessed(\@args)) {
return $related_class->find(@args)->left_join($self->_get_table_name);
}
OBJECT:
for my $object (@args) {
next OBJECT if !blessed $object;
my $pk = $self->_get_primary_key;
#$object->$fk($self->$pk)->save;
$object->{$fk} = $self->{$pk};
$object->save();
}
return $self;
}
# else
return $related_class->new() if not $self->can('_get_primary_key');
if (!$self->{$instance_name}) {
$self->{$instance_name} = $related_class->objects->find("$fk = ?", $self->{$pk});
}
return $self->{$instance_name};
}
}
elsif ($full_relation_type eq 'many_to_many') {
*{$pkg_method_name} = sub {
my ($self, @args) = @_;
if (@args) {
my $related_subclass = _get_related_subclass($relation);
unless (all_blessed(\@args)) {
return $related_class->_find_many_to_many({
root_class => $class,
via_table => $relation->{via_table},
m_class => $related_subclass,
self => $self,
where_statement => \@args,
});
}
if (defined $related_subclass) {
my ($fk1, $fk2);
$fk1 = $fk;
RELATED_CLASS_RELATION:
for my $related_class_relation (values %{ $related_class->_get_relations }) {
next RELATED_CLASS_RELATION
unless _get_related_subclass($related_class_relation)
&& $related_subclass eq _get_related_subclass($related_class_relation);
$fk2 = $related_class_relation->{params}{fk};
}
my $pk1_name = $self->_get_primary_key;
my $pk1 = $self->{$pk1_name};
defined $pk1 or croak 'You are trying to create relations between unsaved objects. Save your ' . $class . ' object first';
OBJECT:
for my $object (@args) {
next OBJECT if !blessed $object;
my $pk2_name = $object->_get_primary_key;
my $pk2 = $object->{$pk2_name};
$related_subclass->new($fk1 => $pk1, $fk2 => $pk2)->save;
}
}
else {
my ($fk1, $fk2);
$fk1 = $fk;
$fk2 = class_to_table_name($related_class) . '_id';
my $pk1_name = $self->_get_primary_key;
my $pk1 = $self->{$pk1_name};
my $via_table = $relation->{via_table};
OBJECT:
for my $object (@args) {
next OBJECT if !blessed $object;
my $pk2_name = $object->_get_primary_key;
my $pk2 = $object->{$pk2_name};
my $sql = qq/INSERT INTO "$via_table" ("$fk1", "$fk2") VALUES (?, ?)/;
$self->dbh->do($sql, undef, $pk1, $pk2);
}
}
return $self;
}
# else
if (!$self->{$instance_name}) {
$self->{$instance_name} = $related_class->_find_many_to_many({
root_class => $class,
m_class => _get_related_subclass($relation),
via_table => $relation->{via_table},
self => $self,
});
}
return $self->{$instance_name};
}
}
elsif ($full_relation_type eq 'generic_to_generic') {
*{$pkg_method_name} = sub {
my ($self, @args) = @_;
if (!$self->{$instance_name}) {
my %find_attrs;
while (my ($k, $v) = each %{ $relation->{key} }) {
$find_attrs{$v} = $self->{$k};
}
$self->{$instance_name} = $related_class->find(\%find_attrs);
}
return $self->{$instance_name};
}
}
}
use strict 'refs';
}
sub _what_is_the_table_name {
my $class = ref $_[0] ? ref $_[0] : $_[0];
croak 'Invalid data class' if $class =~ /^ActiveRecord::Simple/;
my $table_name =
$class->can('_get_table_name') ?
$class->_get_table_name
: class_to_table_name($class);
return $table_name;
}
1;
__END__;
=head1 NAME
ActiveRecord::Simple - Simple to use lightweight implementation of ActiveRecord pattern.
=head1 DESCRIPTION
ActiveRecord::Simple is a simple lightweight implementation of ActiveRecord
pattern. It's fast, very simple and very light.
=head1 SYNOPSIS
package Model;
use parent 'ActiveRecord::Simple';
# connect to the database:
__PACKAGE__->connect($dsn, $opts);
package Customer;
use parent 'Model';
__PACKAGE__->table_name('customer');
__PACKAGE__->columns(qw/id first_name last_login/);
__PACKAGE__->primary_key('id');
__PACKAGE__->has_many(purchases => 'Purchase');
package Purchase;
use parent 'Model';
__PACKAGE__->auto_load(); ### load table_name, columns and primary key from the database automatically
__PACKAGE__->belongs_to(customer => 'Customer');
package main;
# get customer with id = 1:
my $customer = Customer->objects->find({ id => 1 })->fetch();
# or (the same):
my $customer = Customer->objects->get(1);
print $customer->first_name; # print first name
$customer->last_login(\'NOW()'); # to use built-in database function just send it as a SCALAR ref
$customer->save(); # save in the database
# get all purchases of $customer:
my @purchases = Purchase->objects->find(customer => $customer)->fetch();
# or (the same):
my @purchases = $customer->purchases->fetch();
# order, group and limit:
my @purchases = $customer->purchases->order_by('paid')->desc->group_by('kind')->limit(10)->fetch();
=head1 CLASS METHODS
L<ActiveRecord::Simple> implements the following class methods.
=head2 new
Object's constructor.
my $log = Log->new(message => 'hello', level => 'info');
=head2 connect
Connect to the database, uses DBIx::Connector if installed, if it's not - L<ActiveRecord::Simple::Connect>.
__PACKAGE__->connect($dsn, $username, $password, $options);
=head2 dbh
Access to the database handler. Undef if it's not connected.
__PACKAGE__->dbh->do('SELECT 1');
=head2 table_name
Set table name.
__PACKAGE__->table_name('log');
=head2 columns
Set columns. Make accessors if make_columns_accessors not 0 (default is 1)
__PACKAGE__->columns('id', 'time');
=head2 primary_key
Set primary key. Optional parameter.
__PACKAGE__->primary_key('id');
=head2 secondary_key
Set secondary key.
__PACKAGE__->secondary_key('time');
=head2 auto_load
Load table_name, columns and primary_key from table_info (automatically from database).
__PACKAGE__->auto_load();
=head2 has_many
Create a ralation to another table (many-to-many, many-to-one).
Customer->has_many(purchases => 'Purchase');
# if you need to set a many-to-many relation, you have to
# specify a third table using "via" key:
Pizza->has_many(toppings => 'Topping', { via => 'pizza_topping' });
=head2 belongs_to
Create a relation to another table (one-to-many, one-to-one). Foreign key is an optional
parameter, default is <table tane>_id.
Purchase->belongs_to(customer => 'Customer');
# or
Purchase->belong_to(customer => 'Customer', { fk => 'customer_id' });
=head2 has_one
Create a relation to another table (one-to-one).
Customer->has_one(address => 'Address');
=head2 generic
Create a relation without foreign keys:
Meal->generic(critical_t => 'Weather', { t_max => 't' });
=head2 make_columns_accessors
Set to 0 before method 'columns' if you don't want to make accessors to columns:
__PACKAGE__->make_columns_accessors(0);
__PACKAGE__->columns('id', 'time'); # now you can't get $log->id and $log->time, only $log->{id} and $log->{time};
=head2 mixins
Create calculated fields
Purchase->mixins(
sum_amount => sub {
return 'SUM(amount)'
}
);
# and then
my $purchase = Purchase->find({ id => 1 })->fields('id', 'title', 'amount', 'sum_amount')->fetch;
=head2 relations
Make a relation. The method is aoutdated.
=head2 objects
Returns instance of L<ActiveRecord::Simple::QueryManager>.
=head2 find [DEPRECATED]
Returns L<ActiveRecord::Simple::Find> object.
my $finder = Customer->find(); # it's like ActiveRecord::Simple::Find->new();
$finder->order_by('id');
my @customers = $finder->fetch;
=head2 all [DEPRECATED]
Same as __PACKAGE__->find->fetch;
=head2 get [DEPRECATED]
Get object by primary_key
my $customer = Customer->get(1);
# same as Customer->find({ id => 1 })->fetch;
=head2 count
Get number of rows
my $cnt = Customer->count('age > ?', 21);
=head2 exists
Check if row is exists in the database
warn "Got Barak!"
if Customer->exists({ name => 'Barak Obama' })
=head1 OBJECT METHODS
L<ActiveRecord::Simple> implements the following object methods.
=head2 is_defined
Check object is defined
=head2 save
Save object to the database
=head2 delete
Delete object from the database
=head2 update
Update object using hashref
$user->update({ last_login => \'NOW()' });
=head2 to_hash
Unbless object, get naked hash
=head2 increment
Increment fields
$customer->increment('age')->save;
=head2 decrement
Decrement fields
$customer->decrement('age')->save;
=head1 AUTHOR
shootnix, C<< <shootnix at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<shootnix@cpan.org>, or through
the github: https://github.com/shootnix/activerecord-simple/issues
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ActiveRecord::Simple
You can also look for information at:
=over 1
=item * Github wiki:
L<https://github.com/shootnix/activerecord-simple/wiki>
=back
=head1 ACKNOWLEDGEMENTS
=head1 LICENSE AND COPYRIGHT
Copyright 2013-2018 shootnix.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
lib/ActiveRecord/Simple/Connect.pm view on Meta::CPAN
package ActiveRecord::Simple::Connect;
use strict;
use warnings;
use 5.010;
use DBI;
my $self;
sub new {
my ($class, $dsn, $username, $password, $params) = @_;
if (!$self) {
$self = { dbh => undef };
if ($dsn) {
$self->{dsn} = $dsn;
$self->{username} = $username if $username;
$self->{password} = $password if $password;
$self->{connection_parameters} = $params if $params;
}
bless $self, $class;
}
return $self;
}
sub db_connect {
my ($self) = @_;
$self->{dbh} = DBI->connect(
$self->{dsn},
$self->{username},
$self->{password},
) or die DBI->errstr;
return $self;
}
sub username {
my ($self, $username) = @_;
$self->{username} = $username if $username;
return $self->{username};
}
sub password {
my ($self, $password) = @_;
$self->{password} = $password if $password;
return $self->{password};
}
sub dsn {
my ($self, $dsn) = @_;
$self->{dsn} = $dsn;
return $self->{dsn};
}
sub connection_parameters {
my ($self, $connection_parameters) = @_;
$self->{connection_parameters} = $connection_parameters;
return $self->{connection_parameters};
}
sub dbh {
my ($self, $dbh) = @_;
$self->{dbh} = $dbh if $dbh;
$self->db_connect unless $self->{dbh} && $self->{dbh}->ping;
return $self->{dbh};
}
1;
lib/ActiveRecord/Simple/Find.pm view on Meta::CPAN
package ActiveRecord::Simple::Find;
use 5.010;
use strict;
use warnings;
use vars qw/$AUTOLOAD/;
use Carp;
use parent 'ActiveRecord::Simple';
use ActiveRecord::Simple::Utils qw/load_module/;
our $MAXIMUM_LIMIT = 100_000_000_000;
sub new {
my ($self_class, $class, @param) = @_;
#my $self = $class->new();
my $self = bless { class => $class } => $self_class;
my $table_name = ($self->{class}->can('_get_table_name')) ? $self->{class}->_get_table_name : undef;
my $pkey = ($self->{class}->can('_get_primary_key')) ? $self->{class}->_get_primary_key : undef;
croak 'can not get table_name for class ' . $self->{class} unless $table_name;
#croak 'can not get primary_key for class ' . $self->{class} unless $pkey;
$self->{prep_select_fields} //= [];
$self->{prep_select_from} //= [];
$self->{prep_select_where} //= [];
my ($fields, $from, $where);
if (!ref $param[0] && scalar @param == 1) {
$fields = qq/"$table_name".*/;
$from = qq/"$table_name"/;
$where = qq/"$table_name"."$pkey" = ?/;
$self->{BIND} = \@param
}
elsif (!ref $param[0] && scalar @param == 0) {
$fields = qq/"$table_name".*/;
$from = qq/"$table_name"/;
$self->{BIND} = undef;
}
elsif (ref $param[0] && ref $param[0] eq 'HASH') {
# find many by params
my ($bind, $condition_pairs) = $self->_parse_hash($param[0]);
my $where_str = join q/ AND /, @$condition_pairs;
$fields = qq/"$table_name".*/;
$from = qq/"$table_name"/;
$where = $where_str;
$self->{BIND} = $bind;
}
elsif (ref $param[0] && ref $param[0] eq 'ARRAY') {
# find many by primary keys
my $whereinstr = join ', ', @{ $param[0] };
$fields = qq/"$table_name".*/;
$from = qq/"$table_name"/;
$where = qq/"$table_name"."$pkey" IN ($whereinstr)/;
$self->{BIND} = undef;
}
else {
# find many by condition
my $wherestr = shift @param;
$fields = qq/"$table_name".*/;
$from = qq/"$table_name"/;
$where = $wherestr;
$self->{BIND} = \@param;
}
push @{ $self->{prep_select_fields} }, $fields if $fields;
push @{ $self->{prep_select_from} }, $from if $from;
push @{ $self->{prep_select_where} }, $where if $where;
return $self;
}
sub count {
my $inv = shift;
my $self = ref $inv ? $inv : $inv->new(@_);
$self->{prep_select_fields} = [ 'COUNT(*)' ];
if (@{ $self->{prep_group_by} || [] }) {
my $table_name = $self->{class}->_get_table_name;
push @{ $self->{prep_select_fields} }, map qq/"$table_name".$_/, @{ $self->{prep_group_by} };
my @group_by = @{ $self->{prep_group_by} };
s/"//g foreach @group_by;
my @results;
foreach my $item ($self->fetch) {
push my @line, (count => $item->{'COUNT(*)'}), map { $_ => $item->{$_} } @group_by;
push @results, { @line };
}
return @results;
}
else {
return $self->fetch->{'COUNT(*)'};
}
}
sub first {
my ($self, $limit) = @_;
$limit //= 1;
$self->{class}->can('_get_primary_key') or croak 'Can\'t use "first" without primary key';
my $primary_key = $self->{class}->_get_primary_key;
return $self->order_by($primary_key)->limit($limit)->fetch;
}
sub last {
my ($self, $limit) = @_;
$self->{class}->can('_get_primary_key') or croak 'Can\'t use "first" without primary key';
my $primary_key = $self->{class}->_get_primary_key;
$limit //= 1;
return $self->order_by($primary_key)->desc->limit($limit)->fetch;
}
sub only {
my ($self, @fields) = @_;
scalar @fields > 0 or croak 'Not defined fields for method "only"';
ref $self or croak 'Create an object abstraction before using the modifiers. Use methods like `find`, `first`, `last` at the beginning';
if ($self->{class}->can('_get_primary_key')) {
my $pk = $self->{class}->_get_primary_key;
push @fields, $pk if ! grep { $_ eq $pk } @fields;
}
my $table_name = $self->{class}->_get_table_name;
my $mixins = $self->{class}->can('_get_mixins') ? $self->{class}->_get_mixins : undef;
my @filtered_prep_select_fields =
grep { $_ ne qq/"$table_name".*/ } @{ $self->{prep_select_fields} };
for my $fld (@fields) {
if ($mixins && grep { $_ eq $fld } keys %$mixins) {
my $mixin = $mixins->{$fld}->($self->{class});
$mixin .= qq/ AS $fld/ unless $mixin =~ /as\s+\w+$/i;
push @filtered_prep_select_fields, $mixin;
}
else {
push @filtered_prep_select_fields, qq/"$table_name"."$fld"/;
}
}
$self->{prep_select_fields} = \@filtered_prep_select_fields;
return $self;
}
# alias to only:
sub fields { shift->only(@_) }
sub order_by {
my ($self, @param) = @_;
#return if not defined $self->{SQL}; ### TODO: die
$self->{prep_order_by} ||= [];
push @{$self->{prep_order_by}}, map qq/"$_"/, @param;
delete $self->{prep_asc_desc};
return $self;
}
sub desc {
return shift->_order_by_direction('DESC');
}
sub asc {
return shift->_order_by_direction('ASC');
}
sub group_by {
my ($self, @param) = @_;
$self->{prep_group_by} ||= [];
push @{$self->{prep_group_by}}, map qq/"$_"/, @param;
return $self;
}
sub limit {
my ($self, $limit) = @_;
#return if not defined $self->{SQL};
return $self if exists $self->{prep_limit};
$self->{prep_limit} = $limit; ### TODO: move $limit to $self->{BIND}
return $self;
}
sub offset {
my ($self, $offset) = @_;
#return if not defined $self->{SQL};
return $self if exists $self->{prep_offset};
$self->{prep_offset} = $offset; ### TODO: move $offset to $self->{BIND}
return $self;
}
sub fetch {
my ($self, $param) = @_;
my ($read_only, $limit);
if (ref $param eq 'HASH') {
$limit = $param->{limit};
$read_only = $param->{read_only};
}
else {
$limit = $param;
}
return $self->_get_slice($limit) if $self->{_objects};
$self->_finish_sql_stmt();
$self->_quote_sql_stmt();
my $class = $self->{class};
my $sth = $self->dbh->prepare($self->{SQL}) or croak $self->dbh->errstr;
$sth->execute(@{ $self->{BIND} }) or croak $self->dbh->errstr;
if (wantarray) {
my @objects;
my $i = 0;
while (my $object_data = $sth->fetchrow_hashref()) {
$i++;
my $obj = $class->new($object_data);
$self->_finish_object_representation($obj, $object_data, $read_only);
push @objects, $obj;
last if $limit && $i == $limit;
}
delete $self->{has_joined_table};
return @objects;
}
else {
my $object_data = $sth->fetchrow_hashref() or return;
my $obj = $class->new($object_data);
$self->_finish_object_representation($obj, $object_data, $read_only);
delete $self->{has_joined_table};
return $obj;
}
}
sub upload {
my ($self, $param) = @_;
my $o = $self->fetch($param);
$_[0] = $o;
return $_[0];
}
sub next {
my ($self, $n) = @_;
$n ||= 1;
$self->{prep_limit} = $n;
$self->{prep_offset} = 0 unless defined $self->{prep_offset};
my @result = $self->fetch;
$self->{prep_offset} += $n;
return wantarray ? @result : $result[0];
}
sub with {
my ($self, @rels) = @_;
return $self if exists $self->{prep_left_joins};
return $self unless @rels;
$self->{class}->can('_get_relations')
or die "Class doesn't have any relations";
my $table_name = $self->{class}->_get_table_name;
$self->{prep_left_joins} = [];
$self->{with} = \@rels;
RELATION:
for my $rel_name (@rels) {
my $relation = $self->{class}->_get_relations->{$rel_name}
or next RELATION;
next RELATION unless grep { $_ eq $relation->{type} } qw/one only/;
my $rel_table_name = $relation->{class}->_get_table_name;
my $rel_columns = $relation->{class}->_get_columns;
REL_COLUMN:
for (@$rel_columns) {
next REL_COLUMN if ref $_;
push @{ $self->{prep_select_fields} }, qq/"$rel_table_name"."$_" AS "JOINED_$rel_name\_$_"/;
}
if ($relation->{type} eq 'one') {
my $join_sql = qq/LEFT JOIN "$rel_table_name" ON /;
$join_sql .= qq/"$rel_table_name"."$relation->{params}{pk}"/;
$join_sql .= qq/ = "$table_name"."$relation->{params}{fk}"/;
push @{ $self->{prep_left_joins} }, $join_sql;
}
}
return $self;
}
sub left_join { shift->with(@_) }
sub to_sql {
my ($self) = @_;
$self->_finish_sql_stmt();
$self->_quote_sql_stmt();
return wantarray ? ($self->{SQL}, $self->{BIND}) : $self->{SQL};
}
sub exists {
my ($self) = @_;
$self->{prep_select_fields} = ['1'];
$self->_finish_sql_stmt;
$self->_quote_sql_stmt;
my $sth = $self->dbh->prepare($self->{SQL});
$sth->execute(@{ $self->{BIND} });
return $sth->fetchrow_arrayref();
}
### Private
sub _find_many_to_many {
my ($self_class, $class, $param) = @_;
return unless $self_class->dbh && $class && $param;
my $mc_fkey;
my $class_opts = {};
my $root_class_opts = {};
if ($param->{m_class}) {
#eval { load $param->{m_class} };
#if (!is_loaded $param->{m_class}) {
# load $param->{m_class};
# mark_as_loaded
#}
load_module $param->{m_class};
for my $opts ( values %{ $param->{m_class}->_get_relations } ) {
if ($opts->{class} eq $param->{root_class}) {
$root_class_opts = $opts;
}
elsif ($opts->{class} eq $class) {
$class_opts = $opts;
}
}
my $self = $self_class->new($class, @{ $param->{where_statement} });
my $connected_table_name = $class->_get_table_name;
$self->{prep_select_from} = [ $param->{m_class}->_get_table_name ];
push @{ $self->{prep_left_joins} },
'JOIN ' . $connected_table_name . ' ON ' . $connected_table_name . '.' . $class->_get_primary_key . ' = '
. $param->{m_class}->_get_table_name . '.' . $class_opts->{params}{fk};
push @{ $self->{prep_select_where} },
$root_class_opts->{params}{fk} . ' = ' . $param->{self}->{ $param->{root_class}->_get_primary_key };
return $self;
}
else {
my $self = $self_class->new($class, @{ $param->{where_statement} });
my $connected_table_name = $class->_get_table_name;
$self->{prep_select_from} = [ $param->{via_table} ];
my $fk = ActiveRecord::Simple::Utils::class_to_table_name($class);
$fk .= '_id';
push @{ $self->{prep_left_joins} },
'JOIN ' . $connected_table_name . ' ON ' . $connected_table_name . '.' . $class->_get_primary_key . ' = '
. $param->{via_table} . '.' . $fk;
my $fk2 = ActiveRecord::Simple::Utils::class_to_table_name($param->{root_class}) . '_id';
push @{ $self->{prep_select_where} },
$fk2 . ' = ' . $param->{self}->{ $param->{root_class}->_get_primary_key };
return $self;
}
}
sub _get_slice {
my ($self, $time) = @_;
return unless $self->{_objects}
&& ref $self->{_objects} eq 'ARRAY'
&& scalar @{ $self->{_objects} } > 0;
if (wantarray) {
$time ||= scalar @{ $self->{_objects} };
return splice @{ $self->{_objects} }, 0, $time;
}
else {
return shift @{ $self->{_objects} };
}
}
sub _quote_sql_stmt {
my ($self) = @_;
return unless $self->{SQL} && $self->dbh;
my $driver_name = $self->dbh->{Driver}{Name};
$driver_name //= 'Pg';
my $quotes_map = {
Pg => q/"/,
mysql => q/`/,
SQLite => q/`/,
};
my $quote = $quotes_map->{$driver_name};
$self->{SQL} =~ s/"/$quote/g;
return $self;
}
sub _finish_object_representation {
my ($self, $obj, $object_data, $read_only) = @_;
if ($self->{has_joined_table}) {
RELATION:
for my $rel_name (@{ $self->{with} }) {
my $relation = $self->{class}->_get_relations->{$rel_name} or next RELATION;
my %pairs = map { $_, $object_data->{$_} } grep { $_ =~ /^JOINED\_$rel_name\_/ } keys %$object_data;
next RELATION unless %pairs;
for my $key (keys %pairs) {
my $val = delete $pairs{$key};
$key =~ s/^JOINED\_$rel_name\_//;
$pairs{$key} = $val;
}
$obj->{"relation_instance_$rel_name"} = $relation->{class}->new(\%pairs);
$obj->_delete_keys(qr/^JOINED\_$rel_name/);
}
}
$obj->{read_only} = 1 if defined $read_only;
$obj->{isin_database} = 1;
return $obj;
}
sub _finish_sql_stmt {
my ($self) = @_;
ref $self->{prep_select_fields} or croak 'Invalid prepare SQL statement';
ref $self->{prep_select_from} or croak 'Invalid prepare SQL statement';
my $table_name = $self->{class}->_get_table_name;
my @add = grep { $_ !~~ $self->{prep_select_fields} } map qq/"$table_name".$_/, @{ $self->{prep_group_by}||[] };
push @{ $self->{prep_select_fields} }, @add;
$self->{SQL} = "SELECT " . (join q/, /, @{ $self->{prep_select_fields} }) . "\n";
$self->{SQL} .= "FROM " . (join q/, /, @{ $self->{prep_select_from} }) . "\n";
if (defined $self->{prep_left_joins}) {
$self->{SQL} .= "$_\n" for @{ $self->{prep_left_joins} };
$self->{has_joined_table} = 1;
}
if (@{ $self->{prep_select_where}||[] }) {
$self->{SQL} .= "WHERE\n";
$self->{SQL} .= join " AND ", @{ $self->{prep_select_where} };
}
if (@{ $self->{prep_group_by}||[] }) {
$self->{SQL} .= ' GROUP BY ';
$self->{SQL} .= join q/, /, @{ $self->{prep_group_by} };
}
if (@{ $self->{prep_order_by}||[] }) {
$self->{SQL} .= ' ORDER BY ';
$self->{SQL} .= join q/, /, @{ $self->{prep_order_by} };
}
$self->{SQL} .= ' LIMIT ' . ($self->{prep_limit} // $MAXIMUM_LIMIT);
$self->{SQL} .= ' OFFSET '. ($self->{prep_offset} // 0);
return $self;
}
sub _parse_hash {
my ($self, $param_hash) = @_;
my $class = $self->{class};
my $table_name = ($self->{class}->can('_get_table_name')) ? $self->{class}->_get_table_name : undef;
my ($bind, $condition_pairs) = ([],[]);
for my $param_name (keys %{ $param_hash }) {
if (ref $param_hash->{$param_name} eq 'ARRAY' and !ref $param_hash->{$param_name}[0]) {
my $instr = join q/, /, map { '?' } @{ $param_hash->{$param_name} };
push @$condition_pairs, qq/"$table_name"."$param_name" IN ($instr)/;
push @$bind, @{ $param_hash->{$param_name} };
}
elsif (ref $param_hash->{$param_name}) {
next if !$class->can('_get_relations');
my $relation = $class->_get_relations->{$param_name} or next;
next if $relation->{type} ne 'one';
my $fk = $relation->{params}{fk};
my $pk = $relation->{params}{pk};
if (ref $param_hash->{$param_name} eq __PACKAGE__) {
my $object = $param_hash->{$param_name};
my $tmp_table = qq/tmp_table_/ . sprintf("%x", $object);
my $request_table = $object->{class}->_get_table_name;
$object->{prep_select_fields} = [qq/"$request_table"."$pk"/];
$object->_finish_sql_stmt;
push @$condition_pairs, qq/"$table_name"."$fk" IN (SELECT "$tmp_table"."$pk" from ($object->{SQL}) as $tmp_table)/;
push @$bind, @{ $object->{BIND} } if ref $object->{BIND} eq 'ARRAY';
}
else {
my $object = $param_hash->{$param_name};
if (ref $object eq 'ARRAY') {
push @$bind, map $_->$pk, @$object;
push @$condition_pairs, qq/"$table_name"."$fk" IN (@{[ join ', ', map "?", @$object ]})/;
}
else {
push @$condition_pairs, qq/"$table_name"."$fk" = ?/;
push @$bind, $object->$pk;
}
}
}
else {
if (defined $param_hash->{$param_name}) {
push @$condition_pairs, qq/"$table_name"."$param_name" = ?/;
push @$bind, $param_hash->{$param_name};
}
else {
# is NULL
push @$condition_pairs, qq/"$table_name"."$param_name" IS NULL/;
}
}
}
return ($bind, $condition_pairs);
}
sub _order_by_direction {
my ($self, $direction) = @_;
# There are no fields for order yet
return unless ref $self->{prep_order_by} eq 'ARRAY' and scalar @{ $self->{prep_order_by} } > 0;
# asc/desc is called before: ->asc->desc
return if defined $self->{prep_asc_desc};
# $direction should be ASC/DESC
return unless $direction =~ /^(ASC|DESC)$/i;
# Add $direction to the latest field
@{$self->{prep_order_by}}[-1] .= " $direction";
$self->{prep_asc_desc} = 1;
return $self;
}
sub DESTROY { }
sub AUTOLOAD {
my $call = $AUTOLOAD;
my $self = shift;
my $class = ref $self;
$call =~ s/.*:://;
my $error = "Can't call method `$call` on class $class.\nPerhaps you have forgotten to fetch your object?";
croak $error;
}
1;
__END__;
=head1 NAME
ActiveRecord::Simple::Find
=head1 DESCRIPTION
ActiveRecord::Simple is a simple lightweight implementation of ActiveRecord
pattern. It's fast, very simple and very light.
ActiveRecord::Simple::Find is a class to search, ordering, organize and fetch data from database.
It generates SQL-code and iteracts with DBI to execute it.
=head1 SYNOPSIS
my @customers = Customer->find({ name => 'Bill' })->fetch;
my @customers = Customer->find({ zip => [1001, 1002, 1003] })->fetch;
my @customers = Customer->find('age > ?', 21)->fetch;
my @customers = Customer->find([1, 2, 3, 4, 5])->order_by('id')->desc->fetch;
=head1 METHODS
L<ActiveRecord::Simple::Find> implements the following methods.
=head2 new
Object constructor, creates basic search pattern. Available from method "find"
of the base class:
# SELECT * FROM log WHERE site_id = 1 AND level = 'error';
my $f = Log->find({ id => 1, level => 'error' });
# SELECT * FROM log WHERE site_id = 1 AND level IN ('error', 'warning');
my $f = Log->find({ id => 1, level => ['error', 'warning'] });
# SELECT * FROM customer WHERE age > 21;
Customer->find('age > ?', 21);
# SELECT * FROM customer WHERE id = 100;
Customer->find(100);
# SELECT * FROM customer WHERE id IN (100, 101, 191);
Customer->find([100, 101, 191]);
=head2 last
Fetch last row from database:
# get very last log:
my $last_log = Log->find->last;
# get last error log of site number 1:
my $last_log = Log->find({ level => 'error', site_id => 1 })->last;
=head2 first
Fetch first row:
# get very first log:
my $first_log = Log->find->first;
# get first error log of site number 1:
my $first_log = Log->find({ level => 'error', site_id => 1 })->first;
=head2 count
Fetch number of records in the database:
my $cnt = Log->find->count();
my $cnt_warnings = Log->find({ level => 'warnings' })->count;
=head2 exists
Check the record is exist:
if (Log->find({ level => 'fatal' })->exists) {
die "got fatal error log!";
}
=head2 fetch
Fetch data from the database as objects:
my @errors = Log->find({ level => 'error' })->fetch;
my $errors = Log->find({ level => 'error' })->fetch; # the same, but returns ARRAY ref
my $error = Log->find(1)->fetch; # only one record
my @only_five_errors = Log->find({ level => 'error' })->fetch(5);
=head2 next
Fetch next n rows from the database:
my $finder = Log->find({ level => 'info' });
# get logs by lists of 10 elements:
while (my @logs = $finder->next(10)) {
print $_->id, "\n" for @logs;
}
=head2 only
Specify field names to get from database:
# SELECT id, message FROM log;
my @logs = Log->find->only('id', 'message');
=head2 fields
The same as "only":
# SELECT id, message FROM log;
my @logs = Log->find->fields('id', 'message');
=head2 order_by
Set "ORDER BY" command to the query:
# SELECT * FROM log ORDER BY inserted_time;
my @logs = Log->find->order_by('inserted_time');
# SELECT * FROM log ORDER BY level, id;
my @logs = Log->find->order_by('level', 'id');
=head2 asc
Set "ASC" to the query:
# SELECT * FROM log ORDER BY id ASC;
my @logs = Log->find->order_by('id')->asc;
=head2 desc
Set "DESC" to the query:
# SELECT * FROM log ORDER BY id DESC;
my @logs = Log->find->order_by('id')->desc;
=head2 limit
SET "LIMIT" to the query:
# SELECT * FROM log LIMIT 100;
my @logs = Log->find->limit(100);
=head2 offset
SET "OFFSET" to the query:
# SELECT * FROM log LIMIT 100 OFFSET 99;
my @logs = Log->find->limit(100)->offset(99);
=head2 group_by
Set "GROUP BY":
my @logs = Log->find->group_by('level');
=head2 with
Set "LEFT JOIN" command to the query:
# SELECT l.*, s.* FROM logs l LEFT JOIN sites s ON s.id = l.site_id
my @logs_and_sites = Log->find->with('sites');
print $_->site->name, ": ", $_->mesage for @logs_and_sites;
=head2 left_join
The same as "with" method
=head2 uplod
Fetch object from database and load into ActiveRecord::Simple::Find object:
my $logs = Log->find({ level => ['error', 'fatal'] });
$logs->order_by('level')->desc;
$logs->limit(100);
$logs->upload;
print $_->message for @$logs;
=head2 to_sql
Show SQL-query that genereted by ActiveRecord::Simple::Find class:
my $finder = Log->frind->only('message')->order_by('level')->desc->limit(100);
print $finder->to_sql; # prints: SELECT message FROM log ORDER BY level DESC LIMIT 100;
=head1 EXAMPLES
# SELECT * FROM pizza WHERE name = 'pepperoni';
Pizza->find({ name => 'pepperoni' });
# SELECT first_name, last_name FORM customer WHERE age > 21 ORDER BY id DESC LIMIT 100;
Customer->find('age > ?', 21)->only('first_name', 'last_name')->order_by('id')->desc->limit(100);
# SELECT p.filename, p.id, pp.* FROM photo p LEFT JOIN person pp ON p.person_id = pp.id WHERE p.size = '1020x768';
Photo->find({ size => '1020x768' })->with('person')->only('filename', 'id');
# SELECT t.* FROM topping_pizza tp LEFT JOIN topping t ON t.id = tp.topping_id WHERE tp.pizza_id = <$val>;
Pizza->get(<$val>)->toppings();
=head1 AUTHOR
shootnix, C<< <shootnix at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<shootnix@cpan.org>, or through
the github: https://github.com/shootnix/activerecord-simple/issues
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ActiveRecord::Simple
You can also look for information at:
=over 1
=item * Github wiki:
L<https://github.com/shootnix/activerecord-simple/wiki>
=back
=head1 ACKNOWLEDGEMENTS
=head1 LICENSE AND COPYRIGHT
Copyright 2013-2018 shootnix.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
lib/ActiveRecord/Simple/QueryManager.pm view on Meta::CPAN
package ActiveRecord::Simple::QueryManager;
use ActiveRecord::Simple::Find;
sub new { bless {}, shift }
sub all { ActiveRecord::Simple::Find->new(shift->{caller})->fetch }
sub get { ActiveRecord::Simple::Find->new(shift->{caller}, @_)->fetch }
sub find { ActiveRecord::Simple::Find->new(shift->{caller}, @_) }
sub sql_fetch_all {
my ($self, $sql, @bind) = @_;
my $data = $self->{caller}->dbh->selectall_arrayref($sql, { Slice => {} }, @bind);
my @list;
for my $row (@$data) {
$self->{caller}->_mk_ro_accessors([keys %$row]);
bless $row, $self->{caller};
push @list, $row;
}
return \@list;
}
sub sql_fetch_row {
my ($self, $sql, @bind) = @_;
my $row = $self->{caller}->dbh->selectrow_hashref($sql, undef, @bind);
$self->{caller}->_mk_ro_accessors([keys %$row]);
bless $row, $self->{caller};
return $row;
}
1;
__END__;
=head1 NAME
ActiveRecord::Simple::QueryManager - query manager for ActiveRecord classes
=head1 DESCRIPTION
Query manager for ActiveRecord classes.
=head1 SYNOPSIS
my $qm = ActiveRecord::Simple::QueryManager->new;
$qm->{caller} = 'User';
my @users = $qm->all(); # SELECT * FROM user;
my @johns = $qm->find({ name => 'John' })->fetch;
=head2 sql_fetch_all
Execute any SQL code and fetch data. Returns list of objects. Accessors for all not specified fields
will be created as read-only.
my @values = Purchase->sql_fetch_all('SELECT id, amount FROM purchase WHERE amount > ?', 100);
print $_->id, " ", $_->amount for, "\n" @values;
=head2 sql_fetch_row
Execute any SQL and fetch data. Returns an object.
my $customer = Customer->sql_fetch_row('SELECT id, name FORM customer WHERE id = ?', 1);
print $customer->name, "\n";
=head2 find
Returns L<ActiveRecord::Simple::Find> object.
my $finder = Customer->find(); # it's like ActiveRecord::Simple::Find->new();
$finder->order_by('id');
my @customers = $finder->fetch;
=head2 all
Same as __PACKAGE__->find->fetch;
=head2 get
Get object by primary_key
my $customer = Customer->get(1);
# same as Customer->find({ id => 1 })->fetch;
lib/ActiveRecord/Simple/Utils.pm view on Meta::CPAN
package ActiveRecord::Simple::Utils;
use strict;
use warnings;
require Exporter;
use Module::Load;
use Module::Loaded;
use Scalar::Util qw/blessed/;
our @ISA = qw/Exporter/;
our @EXPORT = qw/class_to_table_name all_blessed load_module/;
sub quote_sql_stmt {
my ($sql, $driver_name) = @_;
return unless $sql && $driver_name;
$driver_name //= 'Pg';
my $quotes_map = {
Pg => q/"/,
mysql => q/`/,
SQLite => q/`/,
};
my $quote = $quotes_map->{$driver_name};
$sql =~ s/"/$quote/g;
return $sql;
}
sub class_to_table_name {
my ($class) = @_;
#load $class;
return $class->_get_table_name if $class->can('_get_table_name');
$class =~ s/.*:://;
#$class_name = lc $class_name;
my $table_name = join('_', map {lc} grep {length} split /([A-Z]{1}[^A-Z]*)/, $class);
return $table_name;
}
sub is_integer {
my ($data_type) = @_;
return unless $data_type;
return grep { $data_type eq $_ } qw/integer bigint tinyint int smallint/;
}
sub is_numeric {
my ($data_type) = @_;
return unless $data_type;
return 1 if is_integer($data_type);
return grep { $data_type eq $_ } qw/numeric decimal/;
}
sub all_blessed {
my ($list) = @_;
for my $item (@$list) {
return unless defined $item;
return unless blessed $item;
}
return 1;
}
sub load_module {
my ($module_name) = @_;
if (!is_loaded $module_name) {
eval { load $module_name; };
mark_as_loaded $module_name;
}
}
1;
t/00-load.t view on Meta::CPAN
#!perl -T
use Test::More tests => 1;
BEGIN {
use_ok( 'ActiveRecord::Simple' ) || print "Bail out!\n";
}
diag( "Testing ActiveRecord::Simple $ActiveRecord::Simple::VERSION, Perl $], $^X" );
t/01-boilerplate.t view on Meta::CPAN
#!/usr/bin/env perl
use 5.006;
use strict;
use warnings;
use Test::More tests => 4;
sub not_in_file_ok {
my ($filename, %regex) = @_;
open( my $fh, '<', $filename )
or die "couldn't open $filename for reading: $!";
my %violated;
while (my $line = <$fh>) {
while (my ($desc, $regex) = each %regex) {
if ($line =~ $regex) {
push @{$violated{$desc}||=[]}, $.;
}
}
}
if (%violated) {
fail("$filename contains boilerplate text");
diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
} else {
pass("$filename contains no boilerplate text");
}
}
sub module_boilerplate_ok {
my ($module) = @_;
not_in_file_ok($module =>
'the great new $MODULENAME' => qr/ - The great new /,
'boilerplate description' => qr/Quick summary of what the module/,
'stub function definition' => qr/function[12]/,
);
}
TODO: {
local $TODO = "Need to replace the boilerplate text";
not_in_file_ok(README =>
"The README is used..." => qr/The README is used/,
"'version information here'" => qr/to provide version information/,
);
not_in_file_ok(Changes =>
"placeholder date/time" => qr(Date/time)
);
module_boilerplate_ok('lib/ActiveRecord/Simple.pm');
module_boilerplate_ok('lib/ActiveRecord/Simple/Find.pm');
}
#!perl -T
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod
my $min_tp = 1.22;
eval "use Test::Pod $min_tp";
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
pod_file_ok('lib/ActiveRecord/Simple.pm', 'ActiveRecord::Simple POD is ok');
done_testing();
t/03-pod-coverage.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use FindBin qw/$Bin/;
use lib "$Bin/../lib";
# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
if $@;
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
pod_coverage_ok('ActiveRecord::Simple', 'ActiveRecord::Simple POD is ok');
done_testing();
t/04-manifest.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More;
unless ( $ENV{RELEASE_TESTING} ) {
plan( skip_all => "Author tests not required for installation" );
}
eval "use Test::CheckManifest 0.9";
plan skip_all => "Test::CheckManifest 0.9 required" if $@;
ok_manifest();
t/05-accessors.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
package Customer;
use FindBin qw/$Bin/;
use lib "$Bin/../lib";
use parent 'ActiveRecord::Simple';
__PACKAGE__->table_name('customer');
__PACKAGE__->columns(qw/id first_name last_name email/);
__PACKAGE__->primary_key('id');
package main;
use Test::More;
my $customer = Customer->new;
eval { $customer->id };
ok ! $@;
ok $customer->id(1);
is $customer->id, 1;
ok $customer->first_name('Bill');
is $customer->first_name, 'Bill';
ok $customer->last_name('Cleantone')->email('bill@cleantone.com');
is $customer->last_name, 'Cleantone';
is $customer->email, 'bill@cleantone.com';
is $customer->_get_table_name, 'customer';
my $c2 = Customer->new(
id => 2,
first_name => 'Bob',
last_name => 'Rock!',
email => 'bob@rock.com',
);
is $c2->id, 2;
is $c2->first_name, 'Bob';
Customer->_mk_ro_accessors(['say_hello']);
$customer->{say_hello} = 'Hello!';
is $customer->say_hello, 'Hello!';
done_testing();
t/06-no-accessors.t view on Meta::CPAN
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
package Customer;
use FindBin qw/$Bin/;
use lib "$Bin/../lib";
use parent 'ActiveRecord::Simple';
__PACKAGE__->make_columns_accessors(0);
__PACKAGE__->table_name('customer');
__PACKAGE__->columns(qw/id first_name last_name email/);
__PACKAGE__->primary_key('id');
package main;
use Test::More;
my $customer = Customer->new(
id => 2,
first_name => 'Bob',
last_name => 'Rock!',
email => 'bob@rock.com',
);
eval { $customer->id(1) };
ok $@;
like $@, qr/Can't locate object method "id"/;
is $customer->{id}, 2;
is $customer->{first_name}, 'Bob';
done_testing();
t/07-auto_load.t view on Meta::CPAN
#!/usr/bin/perl
BEGIN {
package Schema;
use FindBin qw/$Bin/;
use lib "$Bin/../lib";
use parent 'ActiveRecord::Simple';
eval { require DBD::SQLite } or exit 0;
__PACKAGE__->connect("dbi:SQLite:dbname=:memory:","","");
my $_INIT_SQL_CUSTOMER = q{
CREATE TABLE `customer` (
`id` int AUTO_INCREMENT,
`first_name` varchar(200) NULL,
`second_name` varchar(200) NOT NULL,
`age` tinyint(2) NULL,
`email` varchar(200) NOT NULL,
PRIMARY KEY (`id`)
);
};
__PACKAGE__->dbh->do($_INIT_SQL_CUSTOMER);
}
package Customer;
#
our @ISA = qw/Schema/;
#
__PACKAGE__->auto_load();
#
#
package main;
use Test::More;
ok my $customer = Customer->new();
eval { $customer->first_name };
ok ! $@, 'loaded accessor `first_name`';
eval { $customer->id };
ok ! $@, 'loaded accessor `id`';
eval { $customer->foo };
ok $@, 'error load undefined accessor';
is(Customer->_get_table_name, 'customer', 'loaded table name');
is(Customer->_get_primary_key, 'id', 'loaded primary key');
done_testing();
t/08-basic.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
no warnings 'redefine';
use 5.010;
use Data::Dumper;
use FindBin '$Bin';
use lib "$Bin/../lib";
package t::class;
use base 'ActiveRecord::Simple';
__PACKAGE__->table_name('t');
__PACKAGE__->columns('foo', 'bar');
__PACKAGE__->primary_key('foo');
#__PACKAGE__->belongs_to(class2 => 't::class2');
1;
package t::class2;
use base 'ActiveRecord::Simple';
__PACKAGE__->table_name('t');
__PACKAGE__->columns('foo', 'bar');
__PACKAGE__->primary_key('foo');
#__PACKAGE__->belongs_to(class => 't::class');
1;
package t::ClaSs3;
use base 'ActiveRecord::Simple';
package MockDBI;
sub selectrow_array { 1 }
sub do { 1 }
sub selectrow_hashref { { DUMMY => 'hash' } }
sub fetchrow_hashref { { DUMMY => 'hash' } }
sub prepare { bless {}, 'MockDBI' }
sub execute { 1 }
sub last_insert_id { 1 }
sub selectall_arrayref { [{ foo => 1 }, { bar => 2 }] }
1;
*ActiveRecord::Simple::dbh = sub {
return bless { Driver => { Name => 'mysql' } }, 'MockDBI';
};
package main;
use Test::More;
ok my $c = t::class->new({
foo => 1,
bar => 2,
});
ok $c->save(), 'save';
ok $c->foo(100);
is $c->foo, 100, 'update in memory ok';
ok $c->save(), 'update in database ok';
ok my $c2 = t::class->objects->find(1), 'find, primary key';
isa_ok $c2, 'ActiveRecord::Simple::Find';
ok my $c21 = t::class->objects->get(1), 'get';
isa_ok $c21, 't::class';
ok my $c3 = t::class->objects->find({ foo => 'bar' }), 'find, params';
isa_ok $c3, 'ActiveRecord::Simple::Find';
ok my $c4 = t::class->objects->find([1, 2, 3]), 'find, primary keys';
isa_ok $c4, 'ActiveRecord::Simple::Find';
ok my $c5 = t::class->objects->find('foo = ?', 'bar'), 'find, binded params';
isa_ok $c5, 'ActiveRecord::Simple::Find';
is ref $c->to_hash, 'HASH', 'to_hash';
my $order_find = t::class->objects->find->order_by('foo');
$order_find->fetch;
ok $order_find->{SQL} =~ m/order by/i, 'order by';
$order_find = t::class->objects->find->order_by('foo')->desc;
$order_find->fetch;
ok $order_find->{SQL} =~ m/order by/i, 'order by';
ok $order_find->{SQL} =~ m/desc/i, 'order by, desc';
my $limit_find = t::class->objects->find->limit(1);
$limit_find->fetch;
ok $limit_find->{SQL} =~ m/limit\s+1/i, 'limit 1';
my $offset_find = t::class->objects->find->offset(2);
$offset_find->fetch();
ok $offset_find->{SQL} =~ m/offset\s+2/i, 'offset 2';
my $total_sql = t::class->objects->find->limit(1)->offset(2)->order_by('foo')->desc;
$total_sql->fetch;
ok $total_sql->{SQL} =~ /limit\s+1/i, 'use all predicats, find "limit 1"';
ok $total_sql->{SQL} =~ /offset\s+2/i, 'use all predicats, find "offset 2"';
ok $total_sql->{SQL} =~ /order\s+by/i, 'use all predicats, find "order by"';
ok $total_sql->{SQL} =~ /desc/i, 'use all predicats, find "desc"';
ok $c->delete(), 'delete';
ok my $c6 = t::class->objects->find->only('foo', 'bar'), 'find only "foo"';
my $r;
ok $r = t::class->objects->find->first, 'first';
ok $r = t::class->objects->find->first(10), 'first 10';
ok $r = t::class->objects->find->last, 'last';
#is(t::ClaSs3->_table_name, 'cla_ss3');
#is(t::class->_table_name, 't');
my $cs1 = t::class->new();
my $cs2 = t::ClaSs3->new();
done_testing();
t/09-find.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use FindBin '$Bin';
use lib "$Bin/../lib";
use Data::Dumper;
use Test::More;
use DBI;
eval { require DBD::SQLite } or plan skip_all => 'Need DBD::SQLite for testing';
package Customer;
use parent 'ActiveRecord::Simple';
__PACKAGE__->table_name('customers');
__PACKAGE__->primary_key('id');
__PACKAGE__->columns(qw/id first_name second_name age email/);
#__PACKAGE__->has_one(info => 'CustomersInfo');
__PACKAGE__->mixins(
mixin => sub {
'SUM("id")'
},
);
package main;
my $dbh = DBI->connect("dbi:SQLite:dbname=:memory:","","")
or die DBI->errstr;
my $_INIT_SQL = q{
CREATE TABLE `customers` (
`id` int AUTO_INCREMENT,
`first_name` varchar(200) NULL,
`second_name` varchar(200) NOT NULL,
`age` tinyint(2) NULL,
`email` varchar(200) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL = q{
INSERT INTO `customers` (`id`, `first_name`, `second_name`, `age`, `email`)
VALUES
(1,'Bob','Dylan',NULL,'bob.dylan@aol.com'),
(2,'John','Doe',77,'john@doe.com'),
(3,'Bill','Clinton',50,'mynameisbill@gmail.com'),
(4,'Bob','Marley',NULL,'bob.marley@forever.com'),
(5,'','',NULL,'foo.bar@bazz.com'),
(6, 'Lady', 'Gaga', 666, 'gaga-o-la-la@bad.romance');
};
$dbh->do($_INIT_SQL);
$dbh->do($_DATA_SQL);
Customer->dbh($dbh);
my $finder = Customer->objects->find({ first_name => 'Bob' })->order_by('id');
isa_ok $finder, 'ActiveRecord::Simple::Find';
my @bobs = (1, 4); my $i = 0;
while (my $bob = $finder->next) {
ok $bob->id == $bobs[$i], 'next, bob.id == ' . $bobs[$i];
$i++;
}
$finder = Customer->objects->find;
while (my @customers_pair = $finder->next(2)) {
is scalar @customers_pair, 2, 'next(n) works good';
}
my $f = Customer->objects->find({ first_name => 'Bob' });
ok my $Bob = Customer->objects->find({ first_name => 'Bob' })->fetch, 'find Bob';
isa_ok $Bob, 'Customer';
is $Bob->first_name, 'Bob', 'Bob has a right name';
is $Bob->second_name, 'Dylan';
ok !$Bob->age;
ok my $John = Customer->objects->get(2), 'get John';
is $John->first_name, 'John';
ok my $Bill = Customer->objects->find('second_name = ?', 'Clinton')->fetch, 'find Bill';
is $Bill->first_name, 'Bill';
ok my @customers = Customer->objects->get([1, 2, 3]), 'get customers with #1,2,3';
is scalar @customers, 3;
is $customers[0]->first_name, 'Bob';
is $customers[1]->first_name, 'John';
is $customers[2]->first_name, 'Bill';
eval { Customer->objects->get(1)->fetch };
ok $@, 'fetch after get causes die';
ok my $cnt = Customer->objects->find->count, 'count';
is $cnt, 6;
ok my $exists = Customer->objects->find({ first_name => 'Bob' })->exists, 'exists';
ok(!Customer->objects->find({ first_name => 'Not Found' })->exists);
is(Customer->objects->find({ first_name => 'Not Found' })->exists, undef);
ok my $first = Customer->objects->find->first, 'first';
is_deeply $first, $Bob;
ok my $last = Customer->objects->find->last, 'last';
is $last->id, 6;
ok my $customized = Customer->objects->find({ first_name => 'Bob' })->only('id')->fetch, 'only';
is $customized->id, 1;
ok !$customized->first_name;
ok my $customized2 = Customer->objects->find({ first_name => 'Bob' })->fields('id')->fetch, 'fields (alias to "only")';
is $customized2->id, 1;
ok !$customized2->first_name;
my $c = Customer->objects->find->only('first_name')->first;
$c = Customer->objects->find->only('id')->first;
ok $first = Customer->objects->find->only('id')->first, 'first->only';
is $first->id, 1;
ok !$first->first_name;
ok $last = Customer->objects->find->last, 'last';
is $last->id, 6;
ok my @list = Customer->objects->find->order_by('id')->desc->fetch, 'order_by, desc';
is $list[4]->id, 2;
undef @list;
ok @list = Customer->objects->find->order_by('id')->asc->fetch, 'order_by, asc';
is $list[4]->id, 5;
ok @list = Customer->objects->find->limit(2)->fetch, 'limit';
is scalar @list, 2;
ok @list = Customer->objects->find->order_by('id')->offset(2)->fetch, 'offset';
is $list[0]->id, 3;
is scalar @list, 4;
undef @list;
$Bill = Customer->objects->find({ first_name => 'Bill' });
ok $Bill->upload;
@list = Customer->objects->find->order_by('first_name')->desc->order_by('id')->asc->fetch;
is $list[0]->first_name, 'Lady', 'order_by does work';
undef @list;
@list = Customer->objects->find->group_by('first_name', 'age')->fetch;
is scalar @list, 5, 'group_by, got 4 objects';
my $count = Customer->objects->find->count;
is $count, 6, 'simple count, got 5';
undef $count;
$count = Customer->objects->find({ first_name => 'Bob' })->count;
is $count, 2, 'count, got 2 Bob\'s';
undef $count;
my @count = Customer->objects->find->group_by('first_name')->count;
is_deeply \@count, [{first_name => '', count => 1}, {first_name => 'Bill', count => 1}, {first_name => 'Bob', count => 2}, {first_name => 'John', count => 1}, {first_name => 'Lady', count => 1}];
@count = Customer->objects->find({ first_name => 'Bob' })->group_by('second_name')->count;
is_deeply \@count, [{second_name => 'Dylan', count => 1}, {second_name => 'Marley', count => 1}], 'count when find by first_name, group by second_name';
$Bill = Customer->objects->find(3)->fetch;
is_deeply $Bill->to_hash, {
first_name => 'Bill',
second_name => 'Clinton',
age => 50,
email => 'mynameisbill@gmail.com',
id => 3,
mixin => undef,
}, 'got undefined mixin in the hash';
$Bill = Customer->objects->find(3)->only('id', 'mixin')->fetch;
is_deeply $Bill->to_hash({ only_defined_fields => 1 }), { id => 3, mixin => 3 }, 'got defined mixin';
done_testing();
t/10-relations.t view on Meta::CPAN
BEGIN {
package Schema;
use FindBin '$Bin';
use lib "$Bin/../lib";
use parent 'ActiveRecord::Simple';
__PACKAGE__->connect("dbi:SQLite:dbname=:memory:","","");
my $_DROP_SQL_CUSTOMER = q{
DROP TABLE IF EXISTS customer;
};
my $_INIT_SQL_CUSTOMER = q{
CREATE TABLE `customer` (
`id` int AUTO_INCREMENT,
`first_name` varchar(200) NULL,
`last_name` varchar(200) NOT NULL,
`age` tinyint(2) NULL,
`email` varchar(200) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_CUSTOMER = q{
INSERT INTO `customer` (`id`, `first_name`, `last_name`, `age`, `email`)
VALUES
(1,'Bob','Dylan',NULL,'bob.dylan@aol.com'),
(2,'John','Doe',77,'john@doe.com'),
(3,'Bill','Clinton',50,'mynameisbill@gmail.com'),
(4,'Bob','Marley',NULL,'bob.marley@forever.com'),
(5,'','',NULL,'foo.bar@bazz.com');
};
Schema->dbh->do($_DROP_SQL_CUSTOMER);
Schema->dbh->do($_INIT_SQL_CUSTOMER);
Schema->dbh->do($_DATA_SQL_CUSTOMER);
my $_DROP_SQL_PURCHASE = q{
DROP TABLE IF EXISTS purchase;
};
my $_INIT_SQL_PURCHASE = q{
CREATE TABLE `purchase` (
`id` int AUTO_INCREMENT,
`title` varchar(200) NOT NULL,
`amount` decimal(10,2) NOT NULL DEFAULT 0.0,
`customer_id` int NOT NULL references `customer` (`id`),
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_PURCHASE = q{
INSERT INTO `purchase` (`id`, `title`, `amount`, `customer_id`)
VALUES
(1, 'The Order #1', 10, 1),
(2, 'The Order #2', 5.66, 2),
(3, 'The Order #3', 6.43, 3),
(4, 'The Order #4', 2.20, 1),
(5, 'The Order #5', 3.39, 4);
};
Schema->dbh->do($_DROP_SQL_PURCHASE);
Schema->dbh->do($_INIT_SQL_PURCHASE);
Schema->dbh->do($_DATA_SQL_PURCHASE);
my $_DROP_SQL_ACHIEVEMENT = q{
DROP TABLE IF EXISTS achievement;
};
my $_INIT_SQL_ACHIEVEMENT = q{
CREATE TABLE `achievement` (
`id` int AUTO_INCREMENT,
`title` varchar(30) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ACHEIVEMENT = q{
INSERT INTO `achievement` (`id`, `title`)
VALUES
(1, 'Bronze'),
(2, 'Silver'),
(3, 'Gold');
};
Schema->dbh->do($_DROP_SQL_ACHIEVEMENT);
Schema->dbh->do($_INIT_SQL_ACHIEVEMENT);
Schema->dbh->do($_DATA_SQL_ACHEIVEMENT);
my $_DROP_SQL_CA = q{
DROP TABLE IF EXISTS customer_achievement;
};
my $_INIT_SQL_CA = q{
CREATE TABLE `customer_achievement` (
`customer_id` int NOT NULL references customer (id),
`achievement_id` int NOT NULL references achievement (id)
);
};
my $_DATA_SQL_CA = q{
INSERT INTO `customer_achievement` (`customer_id`, `achievement_id`)
VALUES
(1, 1),
(1, 2),
(2, 1),
(2, 3),
(3, 1),
(3, 2),
(3, 3);
};
Schema->dbh->do($_DROP_SQL_CA);
Schema->dbh->do($_INIT_SQL_CA);
Schema->dbh->do($_DATA_SQL_CA);
}
package Purchase;
our @ISA = qw/Schema/;
__PACKAGE__->table_name('purchase');
__PACKAGE__->columns(qw/id title amount customer_id/);
__PACKAGE__->primary_key('id');
__PACKAGE__->belongs_to(customer => 'Customer');
package Customer;
our @ISA = qw/Schema/;
__PACKAGE__->table_name('customer');
__PACKAGE__->columns(qw/id first_name last_name age email/);
__PACKAGE__->primary_key('id');
__PACKAGE__->has_many(purchases => 'Purchase');
__PACKAGE__->has_many(achievements => 'Achievement', { via => 'customer_achievement' });
package Achievement;
our @ISA = qw/Schema/;
__PACKAGE__->table_name('achievement');
__PACKAGE__->columns(qw/id title/);
__PACKAGE__->primary_key('id');
__PACKAGE__->has_many(customers => 'Customer', { via => 'customer_achievement' });
package main;
use Test::More;
use Data::Dumper;
use 5.010;
ok my $customer = Customer->objects->get(1);
is $customer->first_name, 'Bob';
my @purchases = $customer->purchases->fetch;
is scalar @purchases, 2;
my $purchase = Purchase->objects->get(2);
is $purchase->id, 2;
is $purchase->title, 'The Order #2';
is $purchase->customer->first_name, 'John';
my $achievement = Achievement->objects->get(1);
is $achievement->title, 'Bronze';
my @customers = $achievement->customers->fetch;
is scalar @customers, 3;
my @achievements = $customer->achievements->fetch;
is scalar @achievements, 2;
ok my $Bill = Customer->objects->get(3), 'got Bill';
ok $achievement = Achievement->new({ title => 'Bill Achievement', id => 4 })->save, 'create achievement';
is $Bill->id, 3;
is $achievement->id, 4;
ok $Bill->achievements($achievement)->save, 'trying to bind achievement to the customer';
ok my $cnt = $Bill->achievements({ title => 'Bill Achievement' })->count(), 'trying to count customers achievements';
is $cnt, 1, 'looks good';
ok $Bill->achievements({ title => 'Bill Achievement' })->exists;
ok !$Bill->achievements({ title => 'Not Existing Achievement' })->exists;
ok my @bills_orders = $Bill->purchases->fetch, 'got Bill\'s orders';
is scalar @bills_orders, 1;
ok my $order = Purchase->objects->get(3), 'order';
ok $order->customer, 'the order has a customer';
is $order->customer->id, $bills_orders[0]->id;
ok @achievements = $Bill->achievements->fetch;#
is @achievements, 4;
isa_ok $achievements[0], 'Achievement';
ok my $a = Achievement->objects->get(1);
ok @customers = $a->customers->order_by('id')->fetch;
is @customers, 3;
done_testing();
t/11-crud-methods.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use FindBin '$Bin';
use lib "$Bin/../lib";
use Data::Dumper;
use DBI;
package Customer;
use parent 'ActiveRecord::Simple';
__PACKAGE__->table_name('customer');
__PACKAGE__->primary_key('id');
__PACKAGE__->columns(qw/id first_name second_name age email/);
__PACKAGE__->has_many('orders' => 'Order');
__PACKAGE__->has_many(achievements => 'Achievement', { via => 'customer_achievement' });
package Order;
use parent 'ActiveRecord::Simple';
__PACKAGE__->table_name('order');
__PACKAGE__->primary_key('id');
__PACKAGE__->columns(qw/id title amount customer_id/);
__PACKAGE__->belongs_to(customer => 'Customer');
package Achievement;
use parent 'ActiveRecord::Simple';
__PACKAGE__->table_name('achievement');
__PACKAGE__->primary_key('id');
__PACKAGE__->columns(qw/id title/);
__PACKAGE__->has_many(customers => 'Customer', { via => 'customer_achievement' });
package main;
use Test::More;
eval { require DBD::SQLite } or plan skip_all => 'Need DBD::SQLite for testing';
my $dbh = DBI->connect("dbi:SQLite:dbname=:memory:","","")
or die DBI->errstr;
my $_INIT_SQL_CUSTOMERS = q{
CREATE TABLE `customer` (
`id` int AUTO_INCREMENT,
`first_name` varchar(200) NULL,
`second_name` varchar(200) NOT NULL,
`age` tinyint(2) NULL,
`email` varchar(200) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_CUSTOMERS = q{
INSERT INTO `customer` (`id`, `first_name`, `second_name`, `age`, `email`)
VALUES
(1,'Bob','Dylan',NULL,'bob.dylan@aol.com'),
(2,'John','Doe',77,'john@doe.com'),
(3,'Bill','Clinton',50,'mynameisbill@gmail.com'),
(4,'Bob','Marley',NULL,'bob.marley@forever.com'),
(5,'','',NULL,'foo.bar@bazz.com');
};
$dbh->do($_INIT_SQL_CUSTOMERS);
$dbh->do($_DATA_SQL_CUSTOMERS);
my $_INIT_SQL_ORDERS = q{
CREATE TABLE `order` (
`id` int AUTO_INCREMENT,
`title` varchar(200) NOT NULL,
`amount` decimal(10,2) NOT NULL DEFAULT 0.0,
`customer_id` int NOT NULL references `customer` (`id`),
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ORDERS = q{
INSERT INTO `order` (`id`, `title`, `amount`, `customer_id`)
VALUES
(1, 'The Order #1', 10, 1),
(2, 'The Order #2', 5.66, 2),
(3, 'The Order #3', 6.43, 3),
(4, 'The Order #4', 2.20, 1),
(5, 'The Order #5', 3.39, 4);
};
$dbh->do($_INIT_SQL_ORDERS);
$dbh->do($_DATA_SQL_ORDERS);
my $_INIT_SQL_ACHIEVEMENTS = q{
CREATE TABLE `achievement` (
`id` int AUTO_INCREMENT,
`title` varchar(30) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ACHEIVEMENTS = q{
INSERT INTO `achievement` (`id`, `title`)
VALUES
(1, 'Bronze'),
(2, 'Silver'),
(3, 'Gold');
};
$dbh->do($_INIT_SQL_ACHIEVEMENTS);
$dbh->do($_DATA_SQL_ACHEIVEMENTS);
my $_INIT_SQL_CA = q{
CREATE TABLE `customer_achievement` (
`customer_id` int NOT NULL references customer (id),
`achievement_id` int NOT NULL references achievement (id)
);
};
my $_DATA_SQL_CA = q{
INSERT INTO `customer_achievement` (`customer_id`, `achievement_id`)
VALUES
(1, 1),
(1, 2),
(2, 1),
(2, 3),
(3, 1),
(3, 2),
(3, 3);
};
$dbh->do($_INIT_SQL_CA);
$dbh->do($_DATA_SQL_CA);
Customer->dbh($dbh);
ok my $Bill = Customer->objects->get(3), 'got Bill';
ok my $achievement = Achievement->new({ title => 'Bill Achievement', id => 4 })->save, 'create achievement';
is $Bill->id, 3;
is $achievement->id, 4;
ok $Bill->achievements($achievement)->save, 'trying to bind achievement to the customer';
#ok my $ca = CustomersAchievement->find({ customer_id => $Bill->id, achievement_id => $achievement->id })->fetch, 'fetching binding';
#is $ca->customer_id, $Bill->id;
#is $ca->achievement_id, $achievement->id;
#my @ca = CustomersAchievement->find({ customer_id => $Bill->id, achievement_id => $achievement->id })->fetch;
ok my $cnt = $Bill->achievements({ title => 'Bill Achievement' })->count(), 'trying to count customers achievements';
is $cnt, 1, 'looks good';
ok $Bill->achievements({ title => 'Bill Achievement' })->exists;
ok !$Bill->achievements({ title => 'Not Existing Achievement' })->exists;
ok my @bills_orders = $Bill->orders->fetch, 'got Bill\'s orders';
is scalar @bills_orders, 1;
ok my $order = Order->objects->get(3), 'order';
ok $order->customer, 'the order has a customer';
is $order->customer->id, $bills_orders[0]->id;
ok my @achievements = $Bill->achievements->fetch;#
is @achievements, 4;
isa_ok $achievements[0], 'Achievement';
ok my $a = Achievement->objects->get(1);
ok my @customers = $a->customers->order_by('id')->fetch;
is @customers, 3;
done_testing();
t/12-connect.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use FindBin '$Bin';
use lib "$Bin/../lib";
use Data::Dumper;
use DBI;
#use Scalar::Util qw/blessed/;
package Customer;
use parent 'ActiveRecord::Simple';
__PACKAGE__->table_name('customers');
__PACKAGE__->primary_key('id');
__PACKAGE__->columns(qw/id first_name second_name age email/);
__PACKAGE__->has_many('orders' => 'Order');
__PACKAGE__->has_many('achievements' => { CustomersAchievement => 'Achievement' });
package main;
use Test::More;
eval { require DBD::SQLite } or plan skip_all => 'Need DBD::SQLite for testing';
ok(Customer->connect("dbi:SQLite:dbname=:memory:","",""), 'connect');
eval { require DBIx::Connector };
if ($@) {
# There is no DBIx::Connector, use DBI/ARS::Connect
}
else {
isa_ok $ActiveRecord::Simple::connector, 'DBIx::Connector';
}
my $hello = Customer->dbh->selectrow_array('SELECT "hello"');
is $hello, 'hello';
done_testing();
t/13-init.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Test::More;
use FindBin '$Bin';
use lib "$Bin/../lib";
BEGIN {
package Schema;
use parent 'ActiveRecord::Simple';
eval { require DBD::SQLite } or exit 0;
__PACKAGE__->connect("dbi:SQLite:dbname=:memory:","","");
my $_INIT_SQL_CUSTOMERS = q{
CREATE TABLE `customer` (
`id` int AUTO_INCREMENT,
`first_name` varchar(200) NULL,
`second_name` varchar(200) NOT NULL,
`age` tinyint(2) NULL,
`email` varchar(200) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_CUSTOMERS = q{
INSERT INTO `customer` (`id`, `first_name`, `second_name`, `age`, `email`)
VALUES
(1,'Bob','Dylan',NULL,'bob.dylan@aol.com'),
(2,'John','Doe',77,'john@doe.com'),
(3,'Bill','Clinton',50,'mynameisbill@gmail.com'),
(4,'Bob','Marley',NULL,'bob.marley@forever.com'),
(5,'','',NULL,'foo.bar@bazz.com');
};
Schema->dbh->do($_INIT_SQL_CUSTOMERS);
Schema->dbh->do($_DATA_SQL_CUSTOMERS);
my $_INIT_SQL_ORDERS = q{
CREATE TABLE `order` (
`id` int AUTO_INCREMENT,
`title` varchar(200) NOT NULL,
`amount` decimal(10,2) NOT NULL DEFAULT 0.0,
`customer_id` int NOT NULL references `customers` (`id`),
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ORDERS = q{
INSERT INTO `order` (`id`, `title`, `amount`, `customer_id`)
VALUES
(1, 'The Order #1', 10, 1),
(2, 'The Order #2', 5.66, 2),
(3, 'The Order #3', 6.43, 3),
(4, 'The Order #4', 2.20, 1),
(5, 'The Order #5', 3.39, 4);
};
Schema->dbh->do($_INIT_SQL_ORDERS);
Schema->dbh->do($_DATA_SQL_ORDERS);
my $_INIT_SQL_ACHIEVEMENTS = q{
CREATE TABLE `achievement` (
`id` int AUTO_INCREMENT,
`title` varchar(30) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ACHEIVEMENTS = q{
INSERT INTO `achievement` (`id`, `title`)
VALUES
(1, 'Bronze'),
(2, 'Silver'),
(3, 'Gold');
};
Schema->dbh->do($_INIT_SQL_ACHIEVEMENTS);
Schema->dbh->do($_DATA_SQL_ACHEIVEMENTS);
my $_INIT_SQL_CA = q{
CREATE TABLE `customer_achievement` (
`customer_id` int NOT NULL references customers (id),
`achievement_id` int NOT NULL references achievements (id)
);
};
my $_DATA_SQL_CA = q{
INSERT INTO `customer_achievement` (`customer_id`, `achievement_id`)
VALUES
(1, 1),
(1, 2),
(2, 1),
(2, 3),
(3, 1),
(3, 2),
(3, 3);
};
Schema->dbh->do($_INIT_SQL_CA);
Schema->dbh->do($_DATA_SQL_CA);
}
package Customer;
#use parent 'Schema';
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->has_many(orders => 'Order');
__PACKAGE__->has_many(achievements => 'Achievement', { via => 'customer_achievement' });
package Order;
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->belongs_to(customer => 'Customer');
package Achievement;
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->has_many(customers => 'Customer', { via => 'customer_achievement' });
package main;
ok my $Bill = Customer->objects->get(3), 'got Bill';
ok my @bills_orders = $Bill->orders->fetch, 'got Bill\'s orders';
is scalar @bills_orders, 1;
ok my $order = Order->objects->get(3), 'order';
ok $order->customer, 'the order has a customer';
is $order->customer->id, $bills_orders[0]->id, 'id == id';
ok my @achievements = $Bill->achievements->fetch;
is @achievements, 3;
isa_ok $achievements[0], 'Achievement';
ok my $a = Achievement->objects->get(1);
ok my @customers = $a->customers->fetch;
is @customers, 3;
done_testing();
t/14-smart-accessors.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use FindBin '$Bin';
use lib "$Bin/../lib";
use Test::More;
BEGIN {
package Schema;
use parent 'ActiveRecord::Simple';
eval { require DBD::SQLite } or exit 0;
__PACKAGE__->connect("dbi:SQLite:dbname=:memory:","","");
my $_INIT_SQL_CUSTOMERS = q{
CREATE TABLE `customer` (
`id` int AUTO_INCREMENT,
`first_name` varchar(200) NULL,
`second_name` varchar(200) NOT NULL,
`age` tinyint(2) NULL,
`email` varchar(200) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_CUSTOMERS = q{
INSERT INTO `customer` (`id`, `first_name`, `second_name`, `age`, `email`)
VALUES
(1,'Bob','Dylan',NULL,'bob.dylan@aol.com'),
(2,'John','Doe',77,'john@doe.com'),
(3,'Bill','Clinton',50,'mynameisbill@gmail.com'),
(4,'Bob','Marley',NULL,'bob.marley@forever.com'),
(5,'','',NULL,'foo.bar@bazz.com');
};
Schema->dbh->do($_INIT_SQL_CUSTOMERS);
Schema->dbh->do($_DATA_SQL_CUSTOMERS);
my $_INIT_SQL_ORDERS = q{
CREATE TABLE `order` (
`id` int AUTO_INCREMENT,
`title` varchar(200) NOT NULL,
`amount` decimal(10,2) NOT NULL DEFAULT 0.0,
`customer_id` int NOT NULL references `customers` (`id`),
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ORDERS = q{
INSERT INTO `order` (`id`, `title`, `amount`, `customer_id`)
VALUES
(1, 'The Order #1', 10, 1),
(2, 'The Order #2', 5.66, 2),
(3, 'The Order #3', 6.43, 3),
(4, 'The Order #4', 2.20, 1),
(5, 'The Order #5', 3.39, 4);
};
Schema->dbh->do($_INIT_SQL_ORDERS);
Schema->dbh->do($_DATA_SQL_ORDERS);
my $_INIT_SQL_ACHIEVEMENTS = q{
CREATE TABLE `achievement` (
`id` int AUTO_INCREMENT,
`title` varchar(30) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ACHEIVEMENTS = q{
INSERT INTO `achievement` (`id`, `title`)
VALUES
(1, 'Bronze'),
(2, 'Silver'),
(3, 'Gold');
};
Schema->dbh->do($_INIT_SQL_ACHIEVEMENTS);
Schema->dbh->do($_DATA_SQL_ACHEIVEMENTS);
my $_INIT_SQL_CA = q{
CREATE TABLE `customer_achievement` (
`customer_id` int NOT NULL references customers (id),
`achievement_id` int NOT NULL references achievements (id)
);
};
my $_DATA_SQL_CA = q{
INSERT INTO `customer_achievement` (`customer_id`, `achievement_id`)
VALUES
(1, 1),
(1, 2),
(2, 1),
(2, 3),
(3, 1),
(3, 2),
(3, 3);
};
Schema->dbh->do($_INIT_SQL_CA);
Schema->dbh->do($_DATA_SQL_CA);
}
package Customer;
#use parent 'Schema';
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->has_many(orders => 'Order');
__PACKAGE__->has_many(achievements => 'Achievement', { via => 'customer_achievement' });
package Order;
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->belongs_to(customer => 'Customer');
package Achievement;
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->has_many(customers => 'Customer', { via => 'customer_achievement' });
package main;
ok my $Bill = Customer->objects->find({ first_name => 'Bill' })->fetch, 'get Bill';
ok $Bill->orders(Order->new({ title => 'Test smart accessor', amount => '100' }))->save;
ok my $order = Order->objects->find({ title => 'Test smart accessor' })->fetch, 'one->many, yep!';
my $new_order = Order->new({ title => 'New Order vol. 1', amount => '7.77', customer_id => 1 })->save;
ok $new_order->customer($Bill)->save;
is $new_order->customer_id, $Bill->id, 'many->one, good!';
my $new_order2 = Order->new({ title => 'New Order vol. 2', amount => '7.78', customer => $Bill });
$new_order2->save;
ok my $no2 = Order->objects->find({ title => 'New Order vol. 2' })->fetch;
is $no2->customer_id, $Bill->id, 'saving with relational accessors works fine';
ok my @orders = Order->objects->find({ customer => $Bill })->fetch;
is scalar @orders, 3, 'accessors in find';
is(Order->objects->find({ customer => $Bill })->count, scalar @orders, 'accessors in count');
done_testing();
t/15-sql-row.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Test::More;
use FindBin '$Bin';
use lib "$Bin/../lib";
BEGIN {
package Schema;
use parent 'ActiveRecord::Simple';
eval { require DBD::SQLite } or exit 0;
__PACKAGE__->connect("dbi:SQLite:dbname=:memory:","","");
my $_INIT_SQL_CUSTOMERS = q{
CREATE TABLE `customer` (
`id` int AUTO_INCREMENT,
`first_name` varchar(200) NULL,
`second_name` varchar(200) NOT NULL,
`age` tinyint(2) NULL,
`email` varchar(200) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_CUSTOMERS = q{
INSERT INTO `customer` (`id`, `first_name`, `second_name`, `age`, `email`)
VALUES
(1,'Bob','Dylan',NULL,'bob.dylan@aol.com'),
(2,'John','Doe',77,'john@doe.com'),
(3,'Bill','Clinton',50,'mynameisbill@gmail.com'),
(4,'Bob','Marley',NULL,'bob.marley@forever.com'),
(5,'','',NULL,'foo.bar@bazz.com');
};
Schema->dbh->do($_INIT_SQL_CUSTOMERS);
Schema->dbh->do($_DATA_SQL_CUSTOMERS);
my $_INIT_SQL_ORDERS = q{
CREATE TABLE `order` (
`id` int AUTO_INCREMENT,
`title` varchar(200) NOT NULL,
`amount` decimal(10,2) NOT NULL DEFAULT 0.0,
`customer_id` int NOT NULL references `customers` (`id`),
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ORDERS = q{
INSERT INTO `order` (`id`, `title`, `amount`, `customer_id`)
VALUES
(1, 'The Order #1', 10, 1),
(2, 'The Order #2', 5.66, 2),
(3, 'The Order #3', 6.43, 3),
(4, 'The Order #4', 2.20, 1),
(5, 'The Order #5', 3.39, 4);
};
Schema->dbh->do($_INIT_SQL_ORDERS);
Schema->dbh->do($_DATA_SQL_ORDERS);
my $_INIT_SQL_ACHIEVEMENTS = q{
CREATE TABLE `achievement` (
`id` int AUTO_INCREMENT,
`title` varchar(30) NOT NULL,
PRIMARY KEY (`id`)
);
};
my $_DATA_SQL_ACHEIVEMENTS = q{
INSERT INTO `achievement` (`id`, `title`)
VALUES
(1, 'Bronze'),
(2, 'Silver'),
(3, 'Gold');
};
Schema->dbh->do($_INIT_SQL_ACHIEVEMENTS);
Schema->dbh->do($_DATA_SQL_ACHEIVEMENTS);
my $_INIT_SQL_CA = q{
CREATE TABLE `customer_achievement` (
`customer_id` int NOT NULL references customers (id),
`achievement_id` int NOT NULL references achievements (id)
);
};
my $_DATA_SQL_CA = q{
INSERT INTO `customer_achievement` (`customer_id`, `achievement_id`)
VALUES
(1, 1),
(1, 2),
(2, 1),
(2, 3),
(3, 1),
(3, 2),
(3, 3);
};
Schema->dbh->do($_INIT_SQL_CA);
Schema->dbh->do($_DATA_SQL_CA);
}
package Customer;
#use parent 'Schema';
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->has_many('orders' => 'Order');
__PACKAGE__->has_many('achievements' => 'Achievement', { via => 'customer_achievement' });
package Order;
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->belongs_to(customer => 'Customer');
package Achievement;
our @ISA = qw/Schema/;
__PACKAGE__->auto_load();
__PACKAGE__->has_many(customers => 'Customer', { via => 'customer_achievement' });
package main;
ok my $one = Customer->objects->sql_fetch_all('select 1 as one, 2 as two');
is ref $one, 'ARRAY';
is scalar @$one, 1;
my $one1 = shift @$one;
isa_ok $one1, 'Customer';
ok $one1->one;
is $one1->one, 1;
ok $one1->two;
is $one1->two, 2;
eval { $one1->foo };
ok $@;
ok my $two = Customer->objects->sql_fetch_row('select 3 as three, 4 as four');
isa_ok $two, 'Customer';
ok $two->three;
is $two->three, 3;
eval { $two->five };
ok $@;
eval { $two->three(4) };
ok $@;
like $@, qr/read-only/;
#is $two->three, 3, 'still 3';
done_testing();
( run in 0.938 second using v1.01-cache-2.11-cpan-9bca49b1385 )