DBIx-EAV
view release on metacpan or search on metacpan
# =========================================================================
# THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA.
# DO NOT EDIT DIRECTLY.
# =========================================================================
use 5.008_001;
use strict;
use Module::Build::Tiny 0.035;
Build_PL();
Revision history for Perl extension DBIx-EAV
0.11 2018-02-09T14:30:06Z
* new _normalize_entity_schema() method
* fixed declare_entities() bug
0.10 2018-02-08T17:52:21Z
* new schema option 'enable_multi_tenancy'
* improved entity type registration/loading
- implemented declare_entities()
- removed register_types()
0.09 2016-08-23T01:46:22Z
[ FIX ]
* added undeclared deps to cpanfile (GH #1 by andk)
0.08 2016-08-15T19:01:30Z
[ NEW ]
* Implemented custom Entity/ResultSet classes
- set via entity_namespaces/resultset_namespaces
- can now define entities via custom classes instead of register_types()
[ TESTS ]
* migrated to Test2
0.07 2016-07-26T22:36:26Z
- improved schema deployment, now using a version table
- added method 'version_table'
- added method 'version_table_is_installed'
- added method 'install_version_table'
- added method 'version'
- added method 'installed_version'
- schema->deploy() now abort silently when the current version is already deployed
0.06 2016-06-04T18:35:21Z
- implemented DBIx::EAV::EntityType load() class method
- type() can now load previously registered types
- improved relationship registration/installation
- added column 'incoming_name' to table relationships
- fixed tenant.t
0.05 2016-06-04T14:12:15Z
- renamed option 'default_data_type' to 'default_attribute_type'
- added tests for multi-tenancy disable mode
- improved docs
0.04 2016-06-04T11:31:14Z
- constructor param 'schema_config' replaces all schema-config-related params
- Schema now enables foreign keys for SQLite on BUILD
- fixed constraints from 'entity_relationships' to 'entities' table
- moved methods 'db_driver_name' and 'has_data_type' to Schema.pm
- renamed method 'register_schema' to 'register_types'
- fixed Entity->_get_related() to handle query and options arguments
- improved docs
0.03 2016-06-03T17:56:55Z
* DBIx::EAV can now deploy the eav schema to the database (via SQL::Translator)
- implemented schema->deploy
- implemented schema->get_ddl($sqlt_producer)
- new constructor option 'static_attributes' to define extra 'entities' table columns
- tests now using schema->deploy instead of eav-schema.sql (deleted it)
0.02 2016-06-02T04:59:44Z
- implemented DBIx::EAV->connect() method
0.01 2016-06-02T03:10:43Z
- initial import from cafe's private repo
This software is copyright (c) 2016 by Carlos Fernando Avila Gratz <cafe@kreato.com.br>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
Terms of the Perl programming language system itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2016 by Carlos Fernando Avila Gratz <cafe@kreato.com.br>.
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
51 Franklin St, Suite 500, Boston, MA 02110-1335 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- The Artistic License 1.0 ---
This software is Copyright (c) 2016 by Carlos Fernando Avila Gratz <cafe@kreato.com.br>.
This is free software, licensed under:
The Artistic License 1.0
The Artistic License
Preamble
The intent of this document is to state the conditions under which a Package
may be copied, such that the Copyright Holder maintains some semblance of
artistic control over the development of the package, while giving the users of
the package the right to use and distribute the Package in a more-or-less
customary fashion, plus the right to make reasonable modifications.
Definitions:
- "Package" refers to the collection of files distributed by the Copyright
Holder, and derivatives of that collection of files created through
textual modification.
- "Standard Version" refers to such a Package if it has not been modified,
or has been modified in accordance with the wishes of the Copyright
Holder.
- "Copyright Holder" is whoever is named in the copyright or copyrights for
the package.
- "You" is you, if you're thinking about copying or distributing this Package.
- "Reasonable copying fee" is whatever you can justify on the basis of media
cost, duplication charges, time of people involved, and so on. (You will
not be required to justify it to the Copyright Holder, but only to the
computing community at large as a market that must bear the fee.)
- "Freely Available" means that no fee is charged for the item itself, though
there may be fees involved in handling the item. It also means that
recipients of the item may redistribute it under the same conditions they
received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications derived
from the Public Domain or from the Copyright Holder. A Package modified in such
a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided that
you insert a prominent notice in each changed file stating how and when you
changed that file, and provided that you do at least ONE of the following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or an
equivalent medium, or placing the modifications on a major archive site
such as ftp.uu.net, or by allowing the Copyright Holder to include your
modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict with
standard executables, which must also be provided, and provide a separate
manual page for each non-standard executable that clearly documents how it
differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or executable
form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where to
get the Standard Version.
b) accompany the distribution with the machine-readable source of the Package
with your modifications.
c) accompany any non-standard executables with their corresponding Standard
Version executables, giving the non-standard executables non-standard
names, and clearly documenting the differences in manual pages (or
equivalent), together with instructions on where to get the Standard
Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this Package. You
may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
Build.PL
Changes
LICENSE
META.json
README.md
TODO.md
cpanfile
lib/DBIx/EAV.pm
lib/DBIx/EAV/Cursor.pm
lib/DBIx/EAV/Entity.pm
lib/DBIx/EAV/EntityType.pm
lib/DBIx/EAV/Manual.pod
lib/DBIx/EAV/ResultSet.pm
lib/DBIx/EAV/Schema.pm
lib/DBIx/EAV/Table.pm
minil.toml
t/connect.t
t/cursor.t
t/ecommerce.yml
t/entities.yml
t/entity-class.t
t/entity.t
t/inheritance.t
t/lib/My/Entity/Artist.pm
t/lib/My/Entity/CD.pm
t/lib/My/Entity/PopArtist.pm
t/lib/My/ResultSet/Artist.pm
t/lib/Test/DBIx/EAV.pm
t/relationships.t
t/resultset.t
t/schema.t
t/table.t
t/tenant.t
META.yml
MANIFEST
{
"abstract" : "Entity-Attribute-Value data modeling (aka 'open schema') for Perl",
"author" : [
"Carlos Fernando Avila Gratz <cafe@kreato.com.br>"
],
"dynamic_config" : 0,
"generated_by" : "Minilla/v3.0.14",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "DBIx-EAV",
"no_index" : {
"directory" : [
"t",
"xt",
"inc",
"share",
"eg",
"examples",
"author",
"builder"
]
},
"prereqs" : {
"configure" : {
"requires" : {
"Module::Build::Tiny" : "0.035"
}
},
"develop" : {
"requires" : {
"Test::CPAN::Meta" : "0",
"Test::MinimumVersion::Fast" : "0.04",
"Test::PAUSE::Permissions" : "0.04",
"Test::Pod" : "1.41",
"Test::Spellunker" : "v0.2.7"
}
},
"runtime" : {
"requires" : {
"Class::Load" : "0",
"DBI" : "0",
"Data::Dumper" : "0",
"Digest::MD5" : "0",
"Lingua::EN::Inflect" : "1.899",
"Moo" : "0",
"SQL::Abstract" : "0",
"SQL::Translator" : "0.11021",
"Scalar::Util" : "0",
"namespace::clean" : "0",
"perl" : "5.010",
"strictures" : "2.000003"
}
},
"test" : {
"requires" : {
"DBD::SQLite" : "1.50",
"Test2::Suite" : "0",
"YAML" : "1.15"
}
}
},
"provides" : {
"DBIx::EAV" : {
"file" : "lib/DBIx/EAV.pm",
"version" : "0.11"
},
"DBIx::EAV::Cursor" : {
"file" : "lib/DBIx/EAV/Cursor.pm"
},
"DBIx::EAV::Entity" : {
"file" : "lib/DBIx/EAV/Entity.pm"
},
"DBIx::EAV::EntityType" : {
"file" : "lib/DBIx/EAV/EntityType.pm"
},
"DBIx::EAV::ResultSet" : {
"file" : "lib/DBIx/EAV/ResultSet.pm"
},
"DBIx::EAV::Schema" : {
"file" : "lib/DBIx/EAV/Schema.pm"
},
"DBIx::EAV::Table" : {
"file" : "lib/DBIx/EAV/Table.pm"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/cafe01/dbix-eav/issues"
},
"homepage" : "https://github.com/cafe01/dbix-eav",
"repository" : {
"url" : "git://github.com/cafe01/dbix-eav.git",
"web" : "https://github.com/cafe01/dbix-eav"
}
},
"version" : "0.11",
"x_serialization_backend" : "JSON::PP version 2.27300"
}
---
abstract: "Entity-Attribute-Value data modeling (aka 'open schema') for Perl"
author:
- 'Carlos Fernando Avila Gratz <cafe@kreato.com.br>'
build_requires:
DBD::SQLite: '1.50'
Test2::Suite: '0'
YAML: '1.15'
configure_requires:
Module::Build::Tiny: '0.035'
dynamic_config: 0
generated_by: 'Minilla/v3.0.14, 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: DBIx-EAV
no_index:
directory:
- t
- xt
- inc
- share
- eg
- examples
- author
- builder
provides:
DBIx::EAV:
file: lib/DBIx/EAV.pm
version: '0.11'
DBIx::EAV::Cursor:
file: lib/DBIx/EAV/Cursor.pm
DBIx::EAV::Entity:
file: lib/DBIx/EAV/Entity.pm
DBIx::EAV::EntityType:
file: lib/DBIx/EAV/EntityType.pm
DBIx::EAV::ResultSet:
file: lib/DBIx/EAV/ResultSet.pm
DBIx::EAV::Schema:
file: lib/DBIx/EAV/Schema.pm
DBIx::EAV::Table:
file: lib/DBIx/EAV/Table.pm
requires:
Class::Load: '0'
DBI: '0'
Data::Dumper: '0'
Digest::MD5: '0'
Lingua::EN::Inflect: '1.899'
Moo: '0'
SQL::Abstract: '0'
SQL::Translator: '0.11021'
Scalar::Util: '0'
namespace::clean: '0'
perl: '5.010'
strictures: '2.000003'
resources:
bugtracker: https://github.com/cafe01/dbix-eav/issues
homepage: https://github.com/cafe01/dbix-eav
repository: git://github.com/cafe01/dbix-eav.git
version: '0.11'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
[](https://travis-ci.org/cafe01/dbix-eav) [](https://coveralls.io/r/cafe01/dbix-eav?bran...
# NAME
DBIx::EAV - Entity-Attribute-Value data modeling (aka 'open schema') for Perl
# SYNOPSIS
#!/usr/bin/env perl
use strict;
use warnings;
use DBIx::EAV;
# connect to the database
my $eav = DBIx::EAV->connect("dbi:SQLite:database=:memory:");
# or
# $eav = DBIx::EAV->new( dbh => $dbh, %constructor_params );
# create eav tables
$eav->schema->deploy;
# register entities
$eav->declare_entities({
Artist => {
many_to_many => 'CD',
has_many => 'Review',
attributes => [qw/ name:varchar description:text rating:int birth_date:datetime /]
},
CD => {
has_many => ['Track', 'Review'],
has_one => ['CoverImage'],
attributes => [qw/ title description:text rating:int /]
},
Track => {
attributes => [qw/ title description:text duration:int /]
},
CoverImage => {
attributes => [qw/ url /]
},
Review => {
attributes => [qw/ content:text views:int likes:int dislikes:int /]
},
});
# insert data (and possibly related data)
my $bob = $eav->resultset('Artist')->insert({
name => 'Robert',
description => '...',
cds => [
{ title => 'CD1', rating => 5 },
{ title => 'CD2', rating => 6 },
{ title => 'CD3', rating => 8 },
{ title => 'CD4', rating => 9 },
]
});
# get attributes
print $bob->get('name'); # Robert
# update name
$bob->update({ name => 'Bob' });
# add more cds
$bob->add_related('cds', { title => 'CD5', rating => 7 });
# get Bob's cds via auto-generated 'cds' relationship
print "\nAll Bob CDs:\n";
printf " - %s (rating %d)\n", $_->get('title'), $_->get('rating')
foreach $bob->get('cds');
print "\nBest Bob CDs:\n";
printf " - %s (rating %d)\n", $_->get('title'), $_->get('rating')
foreach $bob->get('cds', { rating => { '>' => 7 } });
# ResultSets ...
# retrieve Bob from database
$bob = $eav->resultset('Artist')->find({ name => 'Bob' });
# retrieve Bob's cds directly from CD resultset
# note the use of 'artists' relationship automaticaly created
# from the "Artist many_to_many CD" declaration
my @cds = $eav->resultset('CD')->search({ artists => $bob });
# same as above
@cds = $bob->get('cds');
# or traverse the cds using the resultset cursor
my $cds_rs = $bob->get('cds');
while (my $cd = $cds_rs->next) {
print $cd->get('title');
}
# delete all cds
$eav->resultset('CD')->delete;
# delete all cds and related data (i.e. tracks)
$eav->resultset('CD')->delete_all;
# DESCRIPTION
An implementation of Entity-Attribute-Value data modeling with support for
entity relationships, inheritance, custom classes and multi-tenancy.
See [DBIx::EAV::Manual](https://metacpan.org/pod/DBIx::EAV::Manual).
# ALPHA STAGE
This project is in its infancy, and the main purpose of this stage is to let
other developers try it, and help identify any major design flaw before we can
stabilize the API. One exception is the ResultSet whose API (and docs :\]) I've
borrowed from [DBIx::Class](https://metacpan.org/pod/DBIx::Class), so its (API is) already stable.
# CONSTRUCTORS
## new
- Arguments: %params
Valid `%params` keys:
- dbh **(required)**
Existing [DBI](https://metacpan.org/pod/DBI) database handle. See ["connect"](#connect).
- schema\_config
Hashref of options used to instantiate our [DBIx::EAV::Schema](https://metacpan.org/pod/DBIx::EAV::Schema).
See ["CONSTRUCTOR OPTIONS" in DBIx::EAV::Schema](https://metacpan.org/pod/DBIx::EAV::Schema#CONSTRUCTOR-OPTIONS).
- entity\_namespaces
Arrayref of namespaces to look for custom [entity](https://metacpan.org/pod/DBIx::EAV::Entity) classes.
# mimic DBIx::Class
entity_namespaces => ['MyApp::Schema::Result']
Class names are created by appending the entity type name to each namespace in
the list. The first existing class is used.
Custom entity classes are useful not only provide custom business logic, but
also to define your entities, like DBIx::Class result classes.
See ["CUSTOM CLASS" in DBIx::EAV::Entity](https://metacpan.org/pod/DBIx::EAV::Entity#CUSTOM-CLASS).
- resultset\_namespaces
Arrayref of namespaces to look for custom resultset classes.
# mimic DBIx::Class
resultset_namespaces => ['MyApp::Schema::ResultSet']
Class names are created by appending the entity type name to each namespace in
the list. The first existing class is used.
## connect
- Arguments: $dsn, $user, $pass, $attrs, \\%constructor\_params
Connects to the database via `DBI->connect($dsn, $user, $pass, $attrs)`
then returns a new instance via [new(\\%constructor\_params)](#new).
# METHODS
## declare\_entities
- Arguments: \\%schema
- Return value: none
Declares entity types specified in \\%schema, where each key is the name of the
[type](https://metacpan.org/pod/DBIx::EAV::EntityType) and the value is a hashref describing its
attributes and relationships. Fully described in
["ENTITY DEFINITION" in DBIx::EAV::EntityType](https://metacpan.org/pod/DBIx::EAV::EntityType#ENTITY-DEFINITION).
You must declare your entities every time a new instance of DBIx::EAV is created.
This method stores the entities schema, and calculates a signature for each.
Next time type() is called the relevant entity type will get registerd or
updated (if the signature changed)
## resultset
- Arguments: $name
- Return value: [$rs](https://metacpan.org/pod/DBIx::EAV::ResultSet)
Returns a new [resultset](https://metacpan.org/pod/DBIx::EAV::ResultSet) instance for
[type](https://metacpan.org/pod/DBIx::EAV::EntityType) `$name`.
my $rs = $eav->resultset('Artist');
## type
- Arguments: $name
Returns the [DBIx::EAV::EntityType](https://metacpan.org/pod/DBIx::EAV::EntityType) instance for type `$name`. If the type
instance is not already installed in this DBIx::EAV instance, we try to load
the type definition from the database. Dies if type is not registered.
my $types = $eav->type('Artist');
See ["INSTALLED VS REGISTERED TYPES"](#installed-vs-registered-types).
## has\_type
- Arguments: $name
Returns true if [entity type](https://metacpan.org/pod/DBIx::EAV::EntityType) `$name` is installed.
## schema
Returns the [DBIx::EAV::Schema](https://metacpan.org/pod/DBIx::EAV::Schema) instance representing the physical database tables.
## table
Shortcut for `->schema->table`.
## dbh\_do
- Arguments: $stmt, \\@bind?
- Return Values: ($rv, $sth)
Prepares `$stmt` and executes with the optional `\@bind` values. Returns the
return value from execute `$rv` and the actual statement handle `$sth` object.
Set environment variable `DBIX_EAV_TRACE` to 1 to get statements printed to
`STDERR`.
# INSTALLED VS REGISTERED TYPES
# LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
# AUTHOR
Carlos Fernando Avila Gratz <cafe@kreato.com.br>
- create explicit option to enable multitenancy
- document the fact that DBIx::EAV accepts schema_config params directly
requires 'perl', '5.010';
requires 'Moo';
requires 'DBI';
requires 'strictures', '2.000003';
requires 'Scalar::Util';
requires 'SQL::Abstract';
requires 'SQL::Translator', '0.11021';
requires 'Lingua::EN::Inflect', '1.899';
requires 'namespace::clean';
requires 'Class::Load';
requires 'Data::Dumper';
requires 'Digest::MD5';
on 'test' => sub {
requires 'Test2::Suite';
requires 'YAML', '1.15';
requires 'DBD::SQLite', '1.50';
};
lib/DBIx/EAV.pm view on Meta::CPAN
package DBIx::EAV;
use Moo;
use strictures 2;
use DBI;
use Lingua::EN::Inflect ();
use Data::Dumper;
use Digest::MD5 qw/ md5_hex /;
use DBIx::EAV::EntityType;
use DBIx::EAV::Entity;
use DBIx::EAV::ResultSet;
use DBIx::EAV::Schema;
use Carp qw' croak confess ';
use Scalar::Util 'blessed';
use Class::Load qw' try_load_class ';
use namespace::clean;
our $VERSION = "0.11";
# required
has 'dbh', is => 'ro', required => 1;
# options
has 'default_attribute_type', is => 'ro', default => 'varchar';
has 'schema_config', is => 'ro', default => sub { {} };
has 'entity_namespaces', is => 'ro', default => sub { [] };
has 'resultset_namespaces', is => 'ro', default => sub { [] };
# internal
has 'schema', is => 'ro', lazy => 1, builder => 1, init_arg => undef, handles => [qw/ table dbh_do /];
has '_type_declarations', is => 'ro', default => sub { {} };
has '_types', is => 'ro', default => sub { {} };
has '_types_by_id', is => 'ro', default => sub { {} };
# group schema_config params
around BUILDARGS => sub {
my ( $orig, $class, @args ) = @_;
my $params = @args == 1 && ref $args[0] ? $args[0] : { @args };
my $schema_config = delete $params->{schema_config} || {};
my @schema_params = grep { exists $params->{$_} } qw/
tenant_id data_types database_cascade_delete static_attributes
table_prefix id_type default_attribute_type enable_multi_tenancy
/;
@{$schema_config}{@schema_params} = delete @{$params}{@schema_params};
$class->$orig(%$params, schema_config => $schema_config);
};
sub _build_schema {
my $self = shift;
DBIx::EAV::Schema->new(%{$self->schema_config}, dbh => $self->dbh);
}
sub connect {
my ($class, $dsn, $user, $pass, $attrs, $constructor_params) = @_;
croak 'Missing $dsn argument for connect()' unless $dsn;
croak "connect() must be called as a class method."
if ref $class;
$constructor_params //= {};
$constructor_params->{dbh} = DBI->connect($dsn, $user, $pass, $attrs)
or die $DBI::errstr;
$class->new($constructor_params);
}
sub type {
my ($self, $name) = @_;
confess 'usage: eav->type($name)' unless $name;
return $self->_types->{$name}
if exists $self->_types->{$name};
my $type = $self->_load_or_register_type('name', $name);
confess "EntityType '$name' does not exist."
unless $type;
$type;
}
sub type_by_id {
my ($self, $value) = @_;
return $self->_types_by_id->{$value}
if exists $self->_types_by_id->{$value};
$self->_load_or_register_type('id', $value)
or confess "EntityType 'id=$value' does not exist.";
}
sub declare_entities {
my ($self, $schema) = @_;
my $declarations = $self->_type_declarations;
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Sortkeys = 1;
local $Data::Dumper::Maxdepth = 10;
for my $name (sort keys %$schema) {
# generate signature
my $entity_schema = $self->_normalize_entity_schema($name, $schema->{$name});
my $signature = md5_hex Dumper($entity_schema);
# not declared yet
if (!$declarations->{$name}) {
$declarations->{$name} = {
signature => $signature,
schema => $entity_schema
};
next;
}
else {
# same schema, do nothing
next if $declarations->{$name}{signature} eq $signature;
# its different, replace declaration and invalidate insalled type
printf STDERR "# %s declaration changed from %s to %s\n", $name, $declarations->{$name}{signature}, $signature;
$declarations->{$name} = {
signature => $signature,
schema => $entity_schema
};
my $type_id = $self->_types->{$name}->id;
delete $self->_types->{$name};
delete $self->_types_by_id->{$type_id};
}
}
}
sub _load_or_register_type {
my ($self, $field, $value) = @_;
my $declarations = $self->_type_declarations;
# find registered type
if (my $type_row = $self->table('entity_types')->select_one({ $field => $value })) {
# find custom class to update type declaration
if (my $custom_entity_class = $self->_resolve_entity_class($type_row->{name})) {
$self->declare_entities({ $value => $custom_entity_class->type_definition });
}
# update type registration if changed
my $declaration = $declarations->{$type_row->{name}}
or die "Found registered but not declared entity type '$type_row->{name}'";
my $type;
# declaration didnt change, load from db
if ($declaration->{signature} eq $type_row->{signature}) {
# printf STDERR "# loaded $type_row->{name} signature %s.\n", $type_row->{signature};
$type = DBIx::EAV::EntityType->load({ %$type_row, core => $self});
}
# update definition
else {
# printf STDERR "# loaded $type_row->{name} signature changed from %s to %s.\n", $type_row->{signature}, $declaration->{signature};
$self->_update_type_definition($type_row, $declaration->{schema});
$type = DBIx::EAV::EntityType->new({ %$type_row, core => $self});
}
# install type and return
$self->_types->{$type->name} = $type;
$self->_types_by_id->{$type->id} = $type;
return $type;
}
# not found, give up unless we have a name
return unless $field eq 'name';
# find custom class to update type declaration
if (my $custom_entity_class = $self->_resolve_entity_class($value)) {
$self->declare_entities({ $value => $custom_entity_class->type_definition });
}
# declaration not found
return unless $declarations->{$value};
# register new type
$self->_register_entity_type($value);
}
sub _resolve_entity_class {
my ($self, $name) = @_;
foreach my $ns (@{ $self->entity_namespaces }) {
my $entity_class = join '::', $ns, $name;
my ($is_loaded, $error) = try_load_class $entity_class;
return $entity_class if $is_loaded;
# rethrow compilation errors
die $error if $error =~ /^Can't locate .* in \@INC/;
}
return;
}
sub _resolve_resultset_class {
my ($self, $name) = @_;
foreach my $ns (@{ $self->resultset_namespaces }) {
my $class = join '::', $ns, $name;
my ($is_loaded, $error) = try_load_class $class;
return $class if $is_loaded;
# rethrow compilation errors
die $class;
}
return;
}
sub resultset {
my ($self, $name) = @_;
my $type;
if (blessed $name) {
confess "invalid argument" unless $name->isa('DBIx::EAV::EntityType');
$type = $name;
}
else {
$type = $self->type($name);
}
my $rs_class = $self->_resolve_resultset_class($type->name)
|| 'DBIx::EAV::ResultSet';
$rs_class->new({
eav => $self,
type => $type,
});
}
sub _register_entity_type {
my ($self, $name) = @_;
# error: undeclared type
my $declaration = $self->_type_declarations->{$name}
or die "_register_entity_type() error: No type declaration for '$name'";
# error: already registered
my $types_table = $self->table('entity_types');
if (my $type = $types_table->select_one({ name => $name })) {
die "Type '$type->{name}' is already registered!'";
}
# isnert new entity type
my $id = $types_table->insert({ name => $name, signature => $declaration->{signature} });
my $type = $types_table->select_one({ id => $id });
die "Error inserting entity type '$name'!" unless $type;
# insert type definition (parent, attributes, relationships)
$self->_update_type_definition($type, $declaration->{schema});
# install and return
$self->_types->{$name} =
$self->_types_by_id->{$type->{id}} = DBIx::EAV::EntityType->new(%$type, core => $self);
}
sub _update_type_definition {
my ($self, $type, $spec) = @_;
# parent type first
my $parent_type = $self->_update_type_inheritance($type, $spec);
$type->{parent} = $parent_type if $parent_type;
# update or create attributes
$self->_update_type_attributes($type, $spec);
# update or create relationships
foreach my $reltype (qw/ has_one has_many many_to_many /) {
next unless defined $spec->{$reltype};
$spec->{$reltype} = [$spec->{$reltype}]
unless ref $spec->{$reltype} eq 'ARRAY';
foreach my $rel (@{$spec->{$reltype}}) {
# $entity_type->register_relationship($reltype, $rel);
$self->_register_type_relationship($type, $reltype, $rel);
}
}
}
sub _update_type_inheritance {
my ($self, $type, $spec) = @_;
my $hierarchy_table = $self->table('type_hierarchy');
my $inheritance_row = $hierarchy_table->select_one({ child_type_id => $type->{id} });
my $parent_type;
if ($spec->{extends}) {
die "Unknown type '$spec->{extends}' specified in 'extents' option for type '$type->{name}'."
unless $parent_type = $self->type($spec->{extends});
# update parent link
if ($inheritance_row && $inheritance_row->{parent_type_id} ne $parent_type->id) {
$hierarchy_table->update({ parent_type_id => $parent_type->id }, $inheritance_row)
or die "Error updating to inheritance table. ( for '$type->{name}' extends '$spec->{extends}')";
}
# insert parent link
elsif(!$inheritance_row) {
$hierarchy_table->insert({ child_type_id => $type->{id}, parent_type_id => $parent_type->id })
or die "Error inserting to inheritance table. ( for '$type->{name}' extends '$spec->{extends}')";
}
$type->{parent} = $parent_type;
}
else {
# remove parent link
if ($inheritance_row) {
$hierarchy_table->delete($inheritance_row)
or die "Error deleting from inheritance table. (to remove '$type->{name}' parent link)";
}
}
$parent_type;
}
sub _update_type_attributes {
my ($self, $type, $spec) = @_;
my $attributes = $self->table('attributes');
my %static_attributes = map { $_ => {name => $_, is_static => 1} } @{$self->table('entities')->columns};
$type->{attributes} = {};
my %inherited_attributes = $type->{parent} ? map { $_->{name} => $_ } $type->{parent} ->attributes( no_static => 1 ) : ();
foreach my $attr_spec (@{$spec->{attributes}}) {
printf STDERR "[warn] entity '%s' is overriding inherited attribute '%s'", $type->{name}, $attr_spec->{name}
if $inherited_attributes{$attr_spec->{name}};
my $attr = $attributes->select_one({
entity_type_id => $type->{id},
name => $attr_spec->{name}
});
if (defined $attr) {
# TODO update attribute definition
}
else {
delete $attr_spec->{id}; # safety
my %data = %$attr_spec;
$data{entity_type_id} = $type->{id};
$data{data_type} = delete($data{type}) || $self->default_attribute_type;
die sprintf("Attribute '%s' has unknown data type '%s'.", $data{name}, $data{data_type})
unless $self->schema->has_data_type($data{data_type});
$attributes->insert(\%data);
$attr = $attributes->select_one(\%data);
die "Error inserting attribute '$attr_spec->{name}'!" unless $attr;
}
$type->{attributes}{$attr->{name}} = $attr;
}
}
sub _register_type_relationship {
my ($self, $type, $reltype, $params) = @_;
die sprintf("Error: invalid %s relationship for entity '%s': missing 'entity' parameter.", $reltype, $type->{name})
unless $params->{entity};
my $other_entity = $self->type($params->{entity});
$params->{name} ||= $reltype =~ /_many$/ ? lc Lingua::EN::Inflect::PL($other_entity->name)
: lc $other_entity->name;
$params->{incoming_name} ||= $reltype eq 'many_to_many' ? lc Lingua::EN::Inflect::PL($type->{name})
: lc $type->{name};
my %rel = (
left_entity_type_id => $type->{id},
right_entity_type_id => $other_entity->id,
name => $params->{name},
incoming_name => $params->{incoming_name},
"is_$reltype" => 1
);
# update or insert
my $relationships_table = $self->table('relationships');
my $existing_rel = $relationships_table->select_one({
left_entity_type_id => $type->{id},
name => $rel{name},
});
if ($existing_rel) {
$rel{id} = $existing_rel->{id};
# update
my %changed_cols = map { $_ => $rel{$_} }
grep { $rel{$_} ne $existing_rel->{$_} }
keys %rel;
$relationships_table->update(\%changed_cols, { id => $rel{id} })
if keys %changed_cols > 0;
}
else {
my $id = $relationships_table->insert(\%rel);
die sprintf("Database error while registering '%s -> %s' relationship.", $type->{name}, $rel{name})
unless $id;
$rel{id} = $id;
}
# this type side
$type->{relationships}->{$rel{name}} = \%rel;
# install their side
$other_entity->_relationships->{$rel{incoming_name}} = {
%rel,
is_right_entity => 1,
name => $rel{incoming_name},
incoming_name => $rel{name},
};
}
sub _normalize_entity_schema {
my ($self, $entity_name, $schema) = @_;
# validate, normalize and copy data structures
my %normalized;
# scalar keys
for (qw/ extends /) {
$normalized{$_} = $schema->{$_}
if exists $schema->{$_};
}
# attributes
my %static_attributes = map { $_ => {name => $_, is_static => 1} } @{$self->table('entities')->columns};
foreach my $attr_spec (@{$schema->{attributes}}) {
# expand string to name/type
unless (ref $attr_spec) {
my ($name, $type) = split ':', $attr_spec;
$attr_spec = {
name => $name,
type => $type || $self->default_attribute_type
};
}
die sprintf("Error normalizing attribute '%s' for entity '%s': can't use names of static attributes (real table columns).", $attr_spec->{name}, $entity_name)
if exists $static_attributes{$attr_spec->{name}};
push @{$normalized{attributes}}, { %$attr_spec };
}
# relationships
for my $reltype (qw/ has_one has_many many_to_many /) {
next unless $schema->{$reltype};
my $rels = $schema->{$reltype};
if (my $reftype = ref $rels) {
die "Error: invalid '$reltype' config for '$entity_name'" if $reftype ne 'ARRAY';
} else {
$rels = [$rels]
}
foreach my $params (@$rels) {
my %rel;
my $reftype = ref $params;
# scalar: entity
if (!$reftype) {
%rel = ( entity => $params )
}
elsif ($reftype eq 'ARRAY') {
%rel = (
name => $params->[0],
entity => $params->[1],
incoming_name => $params->[2],
);
}
elsif ($reftype eq 'HAS') {
%rel = %$params;
}
else {
die "Error: invalid '$reltype' config for '$entity_name'.";
}
die sprintf("Error: invalid %s relationship for entity '%s': missing 'entity' parameter.", $reltype, $entity_name)
unless $rel{entity};
# push
push @{$normalized{$reltype}}, \%rel;
}
}
\%normalized;
}
1;
__END__
=encoding utf-8
=head1 NAME
DBIx::EAV - Entity-Attribute-Value data modeling (aka 'open schema') for Perl
=head1 SYNOPSIS
#!/usr/bin/env perl
use strict;
use warnings;
use DBIx::EAV;
# connect to the database
my $eav = DBIx::EAV->connect("dbi:SQLite:database=:memory:");
# or
# $eav = DBIx::EAV->new( dbh => $dbh, %constructor_params );
# create eav tables
$eav->schema->deploy;
# register entities
$eav->declare_entities({
Artist => {
many_to_many => 'CD',
has_many => 'Review',
attributes => [qw/ name:varchar description:text rating:int birth_date:datetime /]
},
CD => {
has_many => ['Track', 'Review'],
has_one => ['CoverImage'],
attributes => [qw/ title description:text rating:int /]
},
Track => {
attributes => [qw/ title description:text duration:int /]
},
CoverImage => {
attributes => [qw/ url /]
},
Review => {
attributes => [qw/ content:text views:int likes:int dislikes:int /]
},
});
# insert data (and possibly related data)
my $bob = $eav->resultset('Artist')->insert({
name => 'Robert',
description => '...',
cds => [
{ title => 'CD1', rating => 5 },
{ title => 'CD2', rating => 6 },
{ title => 'CD3', rating => 8 },
{ title => 'CD4', rating => 9 },
]
});
# get attributes
print $bob->get('name'); # Robert
# update name
$bob->update({ name => 'Bob' });
# add more cds
$bob->add_related('cds', { title => 'CD5', rating => 7 });
# get Bob's cds via auto-generated 'cds' relationship
print "\nAll Bob CDs:\n";
printf " - %s (rating %d)\n", $_->get('title'), $_->get('rating')
foreach $bob->get('cds');
print "\nBest Bob CDs:\n";
printf " - %s (rating %d)\n", $_->get('title'), $_->get('rating')
foreach $bob->get('cds', { rating => { '>' => 7 } });
# ResultSets ...
# retrieve Bob from database
$bob = $eav->resultset('Artist')->find({ name => 'Bob' });
# retrieve Bob's cds directly from CD resultset
# note the use of 'artists' relationship automaticaly created
# from the "Artist many_to_many CD" declaration
my @cds = $eav->resultset('CD')->search({ artists => $bob });
# same as above
@cds = $bob->get('cds');
# or traverse the cds using the resultset cursor
my $cds_rs = $bob->get('cds');
while (my $cd = $cds_rs->next) {
print $cd->get('title');
}
# delete all cds
$eav->resultset('CD')->delete;
# delete all cds and related data (i.e. tracks)
$eav->resultset('CD')->delete_all;
=head1 DESCRIPTION
An implementation of Entity-Attribute-Value data modeling with support for
entity relationships, inheritance, custom classes and multi-tenancy.
See L<DBIx::EAV::Manual>.
=head1 ALPHA STAGE
This project is in its infancy, and the main purpose of this stage is to let
other developers try it, and help identify any major design flaw before we can
stabilize the API. One exception is the ResultSet whose API (and docs :]) I've
borrowed from L<DBIx::Class>, so its (API is) already stable.
=head1 CONSTRUCTORS
=head2 new
=over
=item Arguments: %params
=back
Valid C<%params> keys:
=over
=item dbh B<(required)>
Existing L<DBI> database handle. See L</connect>.
=item schema_config
Hashref of options used to instantiate our L<DBIx::EAV::Schema>.
See L<DBIx::EAV::Schema/"CONSTRUCTOR OPTIONS">.
=item entity_namespaces
Arrayref of namespaces to look for custom L<entity|DBIx::EAV::Entity> classes.
# mimic DBIx::Class
entity_namespaces => ['MyApp::Schema::Result']
Class names are created by appending the entity type name to each namespace in
the list. The first existing class is used.
Custom entity classes are useful not only provide custom business logic, but
also to define your entities, like DBIx::Class result classes.
See L<DBIx::EAV::Entity/"CUSTOM CLASS">.
=item resultset_namespaces
Arrayref of namespaces to look for custom resultset classes.
# mimic DBIx::Class
resultset_namespaces => ['MyApp::Schema::ResultSet']
Class names are created by appending the entity type name to each namespace in
the list. The first existing class is used.
=back
=head2 connect
=over
=item Arguments: $dsn, $user, $pass, $attrs, \%constructor_params
=back
Connects to the database via C<< DBI->connect($dsn, $user, $pass, $attrs) >>
then returns a new instance via L<new(\%constructor_params)|/new>.
=head1 METHODS
=head2 declare_entities
=over
=item Arguments: \%schema
=item Return value: none
=back
Declares entity types specified in \%schema, where each key is the name of the
L<type|DBIx::EAV::EntityType> and the value is a hashref describing its
attributes and relationships. Fully described in
L<DBIx::EAV::EntityType/"ENTITY DEFINITION">.
You must declare your entities every time a new instance of DBIx::EAV is created.
This method stores the entities schema, and calculates a signature for each.
Next time type() is called the relevant entity type will get registerd or
updated (if the signature changed)
=head2 resultset
=over
=item Arguments: $name
=item Return value: L<$rs|DBIx::EAV::ResultSet>
=back
Returns a new L<resultset|DBIx::EAV::ResultSet> instance for
L<type|DBIx::EAV::EntityType> C<$name>.
my $rs = $eav->resultset('Artist');
=head2 type
=over
=item Arguments: $name
=back
Returns the L<DBIx::EAV::EntityType> instance for type C<$name>. If the type
instance is not already installed in this DBIx::EAV instance, we try to load
the type definition from the database. Dies if type is not registered.
my $types = $eav->type('Artist');
See L<"INSTALLED VS REGISTERED TYPES">.
=head2 has_type
=over
=item Arguments: $name
=back
Returns true if L<entity type|DBIx::EAV::EntityType> C<$name> is installed.
=head2 schema
Returns the L<DBIx::EAV::Schema> instance representing the physical database tables.
=head2 table
Shortcut for C<< ->schema->table >>.
=head2 dbh_do
=over
=item Arguments: $stmt, \@bind?
=item Return Values: ($rv, $sth)
Prepares C<$stmt> and executes with the optional C<\@bind> values. Returns the
return value from execute C<$rv> and the actual statement handle C<$sth> object.
Set environment variable C<DBIX_EAV_TRACE> to 1 to get statements printed to
C<STDERR>.
=back
=head1 INSTALLED VS REGISTERED TYPES
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
lib/DBIx/EAV/Cursor.pm view on Meta::CPAN
package DBIx::EAV::Cursor;
use Moo;
use Carp qw/ croak confess /;
use Data::Dumper;
use SQL::Abstract;
use Scalar::Util qw/ blessed /;
my $sql = SQL::Abstract->new();
has 'eav', is => 'ro', required => 1;
has 'type', is => 'ro', required => 1;
has 'query', is => 'ro', default => sub { {} };
has 'options', is => 'ro', default => sub { {} };
has '_sth', is => 'ro', lazy => 1, builder => 1, predicate => '_has_sth', clearer => '_reset_sth';
sub _check_query_already_executed {
my $self = shift;
croak "Query already executed!" if defined $self->_sth;
}
sub _build__sth {
my $self = shift;
my ($sql_query, $bind) = $self->_build_sql_query();
my ($rv, $sth) = $self->eav->table('entities')->_do($sql_query, $bind);
$sth;
}
sub _build_sql_query {
my $self = shift;
my $opts = $self->options;
my $eav = $self->eav;
my $type = $self->type;
my $entities_table = $eav->table('entities');
my ($order_by, $group_by, $having, %parser_data, %replacements);
# selected field
my @select_fields = $opts->{select} ? @{$opts->{select}}
: @{$entities_table->columns};
# distinct (before normalizing @select_fields)
if ($opts->{distinct}) {
# if has group_by, warn and ignore distinct
if ($opts->{group_by}) {
}
else {
# exclude id from group by to make the distinct effect
$opts->{group_by} = [grep { !ref && $_ !~ /^(me\.|)id$/ } @select_fields];
}
}
# normalize select fields
for (my $i = 0; $i < @select_fields; $i++) {
# literal, dont touch
next if ref $select_fields[$i] eq 'SCALAR';
my $ident = $select_fields[$i];
my ($fn, $as);
# sql function
if (ref $ident) {
$as = delete $ident->{'-as'};
($fn, $ident) = each %$ident;
unless ($as) {
$as = lc($fn.'_'.$ident);
$as =~ s/\./_/g;
}
$parser_data{aliases}{$as} = 1;
}
my $info = $self->_parse_clause_identifier($ident, \%parser_data);
$select_fields[$i] = $fn ? \(sprintf "%s( %s ) AS %s", uc $fn, $info->{replacement}, $as)
: $info->{replacement};
}
# add type criteria unless we have a subselect ('from' option)
my $type_criteria = $opts->{from} ? [] : [ entity_type_id => $type->id ];
if ($opts->{subtype_depth}) {
push @$type_criteria, [ '_parent_type_'.$_, $type->id ]
for 1 .. $opts->{subtype_depth};
}
# parse WHERE
my ($where, @bind) = $sql->where({ -and => [ $type_criteria, $self->query] });
my $i = 0;
my $where_re = qr/ ([\w._]+) (?:=|!=|<>|>|<|>=|<=|IN|IS NULL|LIKE|NOT LIKE) \?/;
while ($where =~ /$where_re/g) {
my $ident = $1;
my $info = $self->_parse_clause_identifier($ident, \%parser_data, $bind[$i]);
$bind[$i] = $info->{bind}
if exists $info->{bind};
$replacements{$ident} = $info->{replacement};
$i++;
}
# replace identifiers in WHERE
while (my ($string, $replacement) = each %replacements) {
$where =~ s/\b$string\b/$replacement/g;
}
# parse ORDER BY
if (defined $opts->{order_by}) {
%replacements = ();
$order_by = $sql->where(undef, $opts->{order_by});
while ($order_by =~ / ([\w._]+)(?: ASC| DESC|,|$)/g) {
my $ident = $1;
my $info = $self->_parse_clause_identifier($ident, \%parser_data);
die "Cursor: query error: can't order by relationship! ($ident)'"
if $info->{is_relationship};
$replacements{$ident} = $info->{replacement};
}
# replace identifiers
while (my ($string, $replacement) = each %replacements) {
$order_by =~ s/\b$string\b/$replacement/g;
}
}
# prepare prefetch attributes
# if ($opts->{prefetch}) {
# foreach my $attr (ref $opts->{prefetch} eq 'ARRAY' ? @{$opts->{prefetch}} : ($opts->{prefetch})) {
# die "unknown attribute given to prefetch: '$attr'"
# unless $attr =~ /^(?:$possible_attrs)$/;
#
# $join_attr{$attr} = 1;
# push @select_fields, "$attr.value AS $attr";
# }
# }
# parse ORDER BY
if (defined $opts->{group_by}) {
my @fields;
foreach my $ident (ref $opts->{group_by} eq 'ARRAY' ? @{$opts->{group_by}} : $opts->{group_by}) {
my $info = $self->_parse_clause_identifier($ident, \%parser_data);
die "Cursor: query error: can't group by a relationship! ($ident)'"
if $info->{is_relationship};
push @fields, $info->{replacement};
}
$group_by .= 'GROUP BY '. join(', ', @fields);
}
# parse HAVING
if (defined $opts->{having}) {
my @having_bind;
($having, @having_bind) = $sql->where($opts->{having});
push @bind, @having_bind;
$having =~ s/^\s*WHERE/HAVING/;
%replacements = ();
while ($having =~ /$where_re/g) {
my $ident = $1;
my $info = $self->_parse_clause_identifier($ident, \%parser_data);
$replacements{$ident} = $info->{replacement};
}
# replace identifiers
while (my ($string, $replacement) = each %replacements) {
$having =~ s/\b$string\b/$replacement/g;
}
}
# build sql statement
# SELECT ... FROM
# from subselect
my $from = $entities_table->name;
if (my $subquery = $opts->{from}) {
my ($sub_select, $sub_bind) = @$$subquery;
$from = "($sub_select)";
push @bind, @$sub_bind;
}
my $sql_query = $sql->select("$from AS me", \@select_fields);
# JOINs
if (my $depth = $opts->{subtype_depth}) {
my $hierarchy_table = $eav->table("type_hierarchy")->name;
$sql_query .= " LEFT JOIN $hierarchy_table AS _parent_type_1 ON (_parent_type_1.child_type_id = me.entity_type_id)";
my $i = 2;
while ($depth > 1) {
$sql_query .= sprintf(" LEFT JOIN $hierarchy_table AS _parent_type_%d ON (_parent_type_%d.child_type_id = _parent_type_%d.parent_type_id)",
$i, $i, $i - 1);
$depth--;
$i++;
}
}
$sql_query .= " $_" for @{$parser_data{joins} || []};
# WHERE, GROUP BY, HAVING, ORDER BY
$sql_query .= " $where";
$sql_query .= " $group_by" if defined $group_by;
$sql_query .= " $having" if defined $having;
$sql_query .= " $order_by" if defined $order_by;
# LIMIT / OFFSET
if ($opts->{limit}) {
die "invalid limit" unless $opts->{limit} =~ /^\d+$/;
$sql_query .= " LIMIT $opts->{limit}";
if (defined $opts->{offset}) {
die "invalid offset" unless $opts->{offset} =~ /^\d+$/;
$sql_query .= " OFFSET $opts->{offset}";
}
}
# return query and bind values
($sql_query, \@bind);
}
sub _parse_clause_identifier {
my ($self, $identifier, $parser_data, $bind_value) = @_;
# cached
return $parser_data->{cache}->{$identifier}
if exists $parser_data->{cache}->{$identifier};
my $type = $self->type;
my $eav = $self->eav;
# special case: parent_type
return $parser_data->{cache}->{$identifier} = { replacement => $identifier.'.parent_type_id' }
if $identifier =~ /^_parent_type_\d+$/;
# special case: alias
return { replacement => $identifier }
if exists $parser_data->{aliases}{$identifier};
# remove me.
$identifier =~ s/^me\.//;
# parse possibly deep related identifier
# valid formats:
# - <attr>
# - <rel>
# - <rel>+.<attr>
my @parts = split /\./, $identifier;
my @joins;
my $current_type = $type;
my $current_entity_alias = 'me';
my @rels;
for (my $i = 0; $i < @parts; $i++) {
my $id_part = $parts[$i];
if ($current_type->has_relationship($id_part)) {
my $rel = $current_type->relationship($id_part);
my ($our_side, $their_side) = $rel->{is_right_entity} ? qw/ right left / : qw/ left right /;
my $related_type = $self->eav->type_by_id($rel->{"${their_side}_entity_type_id"});
push @rels, $rel->{name};
my $current_rel_alias = join '_', @rels, 'link';
# join relationship table
unless ($parser_data->{joined}{$current_rel_alias}) {
push @{$parser_data->{joins}}, sprintf "INNER JOIN %sentity_relationships AS %s ON %s.id = %s.%s_entity_id AND %s.relationship_id = %d",
$eav->schema->table_prefix,
$current_rel_alias,
$current_entity_alias,
$current_rel_alias,
$our_side,
$current_rel_alias,
$rel->{id};
$parser_data->{joined}{$current_rel_alias} = 1;
}
# endpart is the relationship itself
if ($i == $#parts) {
if (defined $bind_value) {
die sprintf('Cursor: query error: the entity given to "%s" is not an entity of type %s.', $identifier, $related_type->name)
unless blessed $bind_value
&& $bind_value->isa('DBIx::EAV::Entity')
&& $bind_value->is_type($related_type->name);
die "Cursor: query error: the '".$related_type->name."' instance given to '$identifier' is not in storage."
unless $bind_value->in_storage;
}
# set replacement for WHERE, and change bind value to the entity id
# note: dont cache this result because bindvalue can change
return {
replacement => $current_rel_alias .'.'. $their_side.'_entity_id',
bind => $bind_value ? $bind_value->id : '',
is_relationship => 1
}
}
# step into the related type
else {
$current_type = $related_type;
$current_entity_alias = $current_entity_alias eq 'me' ? $rel->{name}
: $current_entity_alias.'_'.$rel->{name};
unless ($parser_data->{joined}{$current_entity_alias}) {
push @{$parser_data->{joins}}, sprintf "INNER JOIN %sentities AS %s ON %s.id = %s.%s_entity_id",
$eav->schema->table_prefix,
$current_entity_alias,
$current_entity_alias,
$current_rel_alias,
$their_side;
$parser_data->{joined}{$current_entity_alias} = 1;
}
}
}
elsif ($current_type->has_static_attribute($id_part)) {
# attribute allowed only at the and
confess "Cursor: query error: invalid identifier '$identifier': attribute only allowed at the and of identifier."
if $i < $#parts;
return $parser_data->{cache}->{$identifier} = {
replacement => $current_entity_alias.'.'.$id_part,
};
}
elsif ($current_type->has_attribute($id_part)) {
# attribute allowed only at the and
confess "Cursor: query error: invalid identifier '$identifier': attribute only allowed at the and of identifier."
if $i < $#parts;
my $attr = $current_type->attribute($id_part);
my $join_alias = $current_entity_alias eq 'me' ? $attr->{name}
: $current_entity_alias.'_'.$attr->{name};
unless ($parser_data->{joined}{$join_alias}) {
push @{$parser_data->{joins}}, sprintf "LEFT JOIN %svalue_%s AS %s ON (%s.entity_id = %s.id AND %s.attribute_id = %s)",
$eav->schema->table_prefix,
$attr->{data_type},
$join_alias,
$join_alias,
$current_entity_alias,
$join_alias,
$attr->{id};
$parser_data->{joined}{$join_alias} = 1;
}
return { replacement => $join_alias.'.value' }
}
else {
die sprintf "Cursor: query error: invalid identifier '%s': '%s' is not a valid attribute/relationship for '%s'\n",
$identifier,
$id_part,
$current_type->name;
}
}
}
sub as_query {
\[shift->_build_sql_query];
}
sub reset {
my $self = shift;
$self->_reset_sth;
$self;
}
sub first {
$_[0]->reset->next;
}
sub next {
my $self = shift;
$self->_sth->fetchrow_hashref;
}
sub all {
my $self = shift;
my @rows;
$self->reset;
while (my $row = $self->next) {
push @rows, $row;
}
$self->reset;
return wantarray ? @rows : \@rows;
}
1;
__END__
=head1 NAME
DBIx::EAV::Cursor - Represents a query used for fetching entities.
=head1 SYNOPSIS
# get cursor from resultset
my $cursor = $eav->resultset('CD')->search(\%query)->cursor;
while (my $cd = $cursor->next) {
# $cd is the raw hashref returned from database
printf "CD id: %d\n", $cd->{id};
}
=head1 DESCRIPTION
A cursor is used to build, execute and iterate over a SQL query for the entities
table. A a cursor instance is returned from L<find|DBIx::EAV::Collection> and from
L<get|DBIx::EAV::Entity> (when you get() related data). You will never need
to create a instance of this class yourself.
=head1 METHODS
=head2 all
=over 4
=item Arguments: none
=item Return Value: L<@entities|DBIx::EAV::Entity>
=back
Returns all entities in the result.
=head2 next
=over 4
=item Arguments: none
=item Return Value: L<$result|DBIx::EAV::Entity> | undef
=back
Returns the next element in the resultset (C<undef> if there is none).
Can be used to efficiently iterate over records in the resultset:
my $cursor = $eav->resultset('CD')->find;
while (my $cd = $cursor->next) {
print $cd->get('title');
}
Note that you need to store the cursor object, and call C<next> on it.
Calling C<< resultset('CD')->next >> repeatedly will always return the
first record from the cursor.
=head2 first
=over 4
=item Arguments: none
=item Return Value: L<$result|DBIx::EAV::Entity> | undef
=back
L<Resets|/reset> the cursor (causing a fresh query to storage) and returns
an object for the first result (or C<undef> if the resultset is empty).
=head2 reset
Deletes the current statement handle, if any. Next data fetching will trigger a
new database query.
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
lib/DBIx/EAV/Entity.pm view on Meta::CPAN
package DBIx::EAV::Entity;
use Moo;
use strictures 2;
use Scalar::Util qw/ blessed /;
use Data::Dumper;
use Carp 'croak';
has 'eav', is => 'ro', required => 1;
has 'type', is => 'ro', required => 1, handles => [qw/ is_type /];
has 'raw', is => 'ro', default => sub { {} };
has '_modified', is => 'ro', default => sub { {} };
has '_modified_related', is => 'ro', default => sub { {} };
sub in_storage {
my $self = shift;
exists $self->raw->{id} && defined $self->raw->{id};
}
sub id {
my $self = shift;
return unless exists $self->raw->{id};
$self->raw->{id};
}
sub get {
my $self = shift;
my $name = shift;
my $type = $self->type;
return $self->raw->{$name}
if $type->has_attribute($name);
if ($type->has_relationship($name)) {
my $rel = $type->relationship($name);
my $rs = $self->_get_related($name, @_);
# return an Entity for has_one and belongs_to; return Cursor otherwise
return $rs->next if
$rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity});
# *_many rel, return cursor or array of entities
return wantarray ? $rs->all : $rs;
}
die sprintf "get() error: '%s' is not a valid attribute/relationship for '%s'", $name, $self->type->name;
}
sub _get_related {
my ($self, $relname, $query, $options) = @_;
my $rel = $self->type->relationship($relname);
my ($our_side, $their_side) = $rel->{is_right_entity} ? qw/ right left / : qw/ left right /;
my $related_type = $self->eav->type_by_id($rel->{"${their_side}_entity_type_id"});
$query //= {};
$query->{$rel->{incoming_name}} = $self;
$self->eav->resultset($related_type)->search($query, $options);
}
sub load_attributes {
my ($self, @attrs) = @_;
die "Can't load_attributes(): this entity has no id!"
unless defined $self->id;
my $eav = $self->eav;
my $type = $self->type;
@attrs = $type->attributes( no_static => 1, names => 1 )
if @attrs == 0;
# build sql query: one aliases subselect for each attribute
my $sql_query = 'SELECT ' . join(', ', map {
my $attr_spec = $type->attribute($_);
my $value_table = $eav->table('value_'. $attr_spec->{data_type} );
sprintf "(SELECT value FROM %s WHERE entity_id = %d AND attribute_id = %d) AS %s",
$value_table->name,
$self->id,
$attr_spec->{id},
$_;
} @attrs);
# fetch data
my ($rv, $sth) = $eav->dbh_do($sql_query);
my $data = $sth->fetchrow_hashref;
die "load_attributes() failed! No data returned from database!"
unless ref $data eq 'HASH';
my $raw = $self->raw;
my $total = 0;
# adopt data
for (keys %$data) {
$raw->{$_} = $data->{$_};
$total++;
}
# return the number os attrs loaded
$total;
}
sub update {
my $self = shift;
$self->set(@_)->save;
}
sub set {
my $self = shift;
my $numargs = scalar(@_);
die 'Call set(\%data) or set($attr, $value)'
if 1 > $numargs || $numargs > 2;
if ($numargs == 2) {
$self->_set(@_);
}
elsif ($numargs == 1) {
die "You must pass a hashref set()" unless ref $_[0] eq 'HASH';
while (my ($k, $v) = each %{$_[0]}) {
$self->_set($k, $v);
}
}
$self;
}
sub _set {
my ($self, $attr_name, $value) = @_;
my $type = $self->type;
if ($type->has_relationship($attr_name)) {
return $self->_set_related($attr_name, $value);
}
my $attr = $self->type->attribute($attr_name);
die "Sorry, you can't set the 'id' attribute."
if $attr_name eq 'id';
# same value
return if defined $value &&
exists $self->raw->{$attr_name} &&
defined $self->raw->{$attr_name} &&
$value eq $self->raw->{$attr_name};
# remember original value
$self->_modified->{$attr_name} = $self->raw->{$attr_name}
unless exists $self->_modified->{$attr_name};
# set
# TODO use type-specific deflator
$self->raw->{$attr_name} = $value;
}
sub _set_related {
my ($self, $relname, $data) = @_;
my $type = $self->type;
my $rel = $type->relationship($relname);
die "You can only pass related data in the form of a hashref, blessed Entity object, or an arrayref of it."
unless ref $data eq 'HASH' || ref $data eq 'ARRAY' || (blessed $data && $data->isa('DBIx::EAV::Entity'));
die "You can't pass an arrayref for the '$rel->{name}' relationship."
if ref $data eq 'ARRAY' && ( $rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity}) );
$self->raw->{$relname} = $data;
$self->_modified_related->{$relname} = 1;
}
sub save {
my $self = shift;
my $type = $self->type;
my $entities_table = $self->eav->table('entities');
my $is_new_entity = not $self->in_storage;
my $raw = $self->raw;
# modified static attrs
my %modified_static_attributes = map { $_ => $self->raw->{$_} }
grep { $type->has_static_attribute($_) }
keys %{$self->_modified};
# insert if its new entity
if ($is_new_entity) {
# TODO insert default values
my $id = $entities_table->insert({
%modified_static_attributes,
entity_type_id => $type->id,
});
die "Invalid ID returned ($id) while inserting new entity."
unless $id > 0;
my $static_attributes = $entities_table->select_one({ id => $id });
die "Error: could not fetch the entity row I've just inserted!"
unless $static_attributes->{id} == $id;
$raw->{$_} = $static_attributes->{$_}
for keys %$static_attributes;
# undirty those attrs
delete $self->_modified->{$_} for keys %modified_static_attributes;
%modified_static_attributes = ();
}
# upsert attributes
my $modified_count = 0;
while (my ($attr_name, $old_value) = each %{$self->_modified}) {
$modified_count++;
my $value = $raw->{$attr_name};
my $attr_spec = $self->type->attribute($attr_name);
# save static attrs later
if ($attr_spec->{is_static}) {
$modified_static_attributes{$attr_name} = $value;
next;
}
my $values_table = $self->eav->table('value_'.$attr_spec->{data_type});
my %attr_criteria = (
entity_id => $self->id,
attribute_id => $attr_spec->{id}
);
# undefined value, delete attribute row
if (not defined $value) {
$values_table->delete(\%attr_criteria);
}
# update or insert value
elsif (defined $old_value) {
$values_table->update({ value => $value }, \%attr_criteria);
}
else {
$values_table->insert({
%attr_criteria,
value => $value
});
}
}
# upset related
foreach my $relname (keys %{$self->_modified_related}) {
$self->_save_related($relname, $self->raw->{$relname});
}
# update static attributes
if ($modified_count > 0) {
$entities_table->update(\%modified_static_attributes, { id => $self->id })
if keys(%modified_static_attributes) > 0;
}
# undirty
%{$self->_modified} = ();
$self;
}
sub _save_related {
my ($self, $relname, $data, $options) = @_;
$options //= {};
my $rel = $self->type->relationship($relname);
my ($our_side, $their_side) = $rel->{is_right_entity} ? qw/ right left / : qw/ left right /;
my $related_type = $self->eav->type_by_id($rel->{"${their_side}_entity_type_id"});
# delete any old links
my $relationship_table = $self->eav->table('entity_relationships');
$relationship_table->delete({
relationship_id => $rel->{id},
$our_side."_entity_id" => $self->id
}) unless $options->{keep_current_links};
# link new objects
foreach my $entity (ref $data eq 'ARRAY' ? @$data : ($data)) {
# if is a blessed object, check its a entity from the correct type
if (blessed $entity) {
die "Can't save data for relationship '$relname': unknown data type: ". ref $entity
unless $entity->isa('DBIx::EAV::Entity');
die sprintf("relationship '%s' requires '%s' objects, not '%s'", $relname, $related_type->name, $entity->type->name)
unless $entity->type->id == $related_type->id;
die "Can't save data for relationship '$relname': related entity is not in_storage."
unless $entity->in_storage;
# remove any links to it
$relationship_table->delete({
relationship_id => $rel->{id},
$their_side."_entity_id" => $entity->id
}) unless $rel->{is_many_to_many};
}
elsif (ref $entity eq 'HASH') {
# insert new entity
$entity = $self->eav->resultset($related_type->name)->insert($entity);
}
else {
die "Can't save data for relationship '$relname': unknown data type: ". ref $entity;
}
# create link
$relationship_table->insert({
relationship_id => $rel->{id},
$our_side."_entity_id" => $self->id,
$their_side."_entity_id" => $entity->id
}) or die "Error creating link for relationship '$relname'";
}
}
sub add_related {
my ($self, $relname, $data) = @_;
my $rel = $self->type->relationship($relname);
die "Can't call add_related() for relationship '$rel->{name}'"
if $rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity});
$self->_save_related($relname, $data, { keep_current_links => 1 });
}
sub remove_related {
my ($self, $relname, $data) = @_;
my $rel = $self->type->relationship($relname);
die "Can't call add_related() for relationship '$rel->{name}'"
if $rel->{is_has_one} || ($rel->{is_has_many} && $rel->{is_right_entity});
my $relationships_table = $self->eav->table('entity_relationships');
my ($our_side, $their_side) = $rel->{is_right_entity} ? qw/ right left / : qw/ left right /;
my $related_type = $self->eav->type_by_id($rel->{"${their_side}_entity_type_id"});
$data = [$data] unless ref $data eq 'ARRAY';
foreach my $entity (@$data) {
die "remove_related() error: give me an instance of '".$related_type->name."' or an arrayref of it."
unless blessed $entity && $entity->isa('DBIx::EAV::Entity') && $entity->is_type($related_type->name);
$relationships_table->delete({
relationship_id => $rel->{id},
$our_side ."_entity_id" => $self->id,
$their_side."_entity_id" => $entity->id
});
}
}
sub discard_changes {
my $self = shift;
while (my ($k, $v) = each %{$self->_modified}) {
$self->raw->{$k} = $v;
delete $self->raw->{$k};
}
$self;
}
sub delete {
my $self = shift;
die "Can't delete coz I'm not in storage!"
unless $self->in_storage;
my $eav = $self->eav;
my $type = $self->type;
# cascade delete child entities
foreach my $rel ($type->relationships) {
next if $rel->{is_right_entity}
|| $rel->{is_many_to_many}
|| (exists $rel->{cascade_delete} && $rel->{cascade_delete} == 0);
my $rs = $self->_get_related($rel->{name});
while (my $related_entity = $rs->next) {
$related_entity->delete;
}
}
unless ($eav->schema->database_cascade_delete) {
# delete relationship links
$eav->table('entity_relationships')->delete([
{ left_entity_id => $self->id },
{ right_entity_id => $self->id }
]);
# delete attributes
my %data_types = map { $_->{data_type} => 1 }
$type->attributes( no_static => 1 );
foreach my $data_type (keys %data_types) {
$eav->table('value_'.$data_type)->delete({ entity_id => $self->id });
}
}
# delete entity
my $entities_table = $self->eav->table('entities');
my $rv = $entities_table->delete({ id => $self->id });
delete $self->raw->{id}; # not in_storage
$rv;
}
## ##
## Class Methods ##
## ##
sub is_custom_class {
my $class = shift;
croak "is_custom_class() is a Class method." if ref $class;
$class ne __PACKAGE__;
}
sub type_definition {
my $class = shift;
croak "type_definition() is a Class method." if ref $class;
croak "type_definition() must be called on DBIx::EAV::Entity subclasses."
unless $class->is_custom_class;
no strict 'refs';
unless (defined *{"${class}::__TYPE_DEFINITION__"}) {
my %definition;
# detect parent entity
my $parent_class = ${"${class}::ISA"}[0];
($definition{extends}) = $parent_class =~ /::(\w+)$/
if $parent_class ne __PACKAGE__;
*{"${class}::__TYPE_DEFINITION__"} = \%definition;
}
\%{"${class}::__TYPE_DEFINITION__"};
}
# install class methods for type definition
foreach my $stuff (qw/ attribute has_many has_one many_to_many /) {
no strict 'refs';
*{$stuff} = sub {
my ($class, $spec) = @_;
croak "$stuff() is a Class method." if ref $class;
croak "$stuff() must be called on DBIx::EAV::Entity subclasses."
unless $class->is_custom_class;
my $key = $stuff eq 'attribute' ? 'attributes' : $stuff;
push @{ $class->type_definition->{$key} }, $spec;
};
}
1;
__END__
=head1 NAME
DBIx::EAV::Entity - Represents an entity record.
=head1 SYNOPSIS
=head1 DESCRIPTION
This class can be used by itself or as base class for your entity objects.
=head1 CUSTOM CLASS
DBIx::EAV lets you define your entities via custom classes, which are subclasses
of DBIx::EAV::Entity. Unlike DBIx::Class, the custom classes are not loaded
upfront. They are lazy loaded whenever a call to L<DBIx::EAV/type> is made.
Directly or indirectly (i.e. via other DBIx::EAV methods like L<"resultset()"|DBIx::EAV/resultset>).
Custom classes are used not only define the entity attributes and relationships,
but also to add define you application's business logic, via custom entity methods.
Okay, an example. Lets mimic the namespaces used by DBIx::Class:
my $eav = DBIx::EAV->connect($dsn, $user, $pass, $attrs, {
entity_namespaces => 'MyApp::Schema::Result',
resultset_namespaces => 'MyApp::Schema::ResultSet',
});
Now lets create a 'User' entity class.
package MyApp::Schema::Result::User;
use Moo;
BEGIN { extends 'DBIx::EAV::Entity' }
__PACKAGE__->attribute('first_name');
__PACKAGE__->attribute('last_name');
__PACKAGE__->attribute('email');
__PACKAGE__->attribute('birth_date:datetime');
__PACKAGE__->attribute('is_verified:boolean:0');
# can also define relationships
#__PACKAGE__->has_one( ... );
#__PACKAGE__->has_many( ... );
#__PACKAGE__->many_to_many( ... );
# custom methods
sub full_name {
my $self = shift;
return join ' ', $self->get('first_name'), $self->get('last_name');
}
1;
Done. You have just defined the C<User> entity type, and also a custom class for
instances of the this type.
my $user = $eav->resultset('User')->create({
first_name => 'Carlos',
last_name => 'Gratz'
});
print $user->full_name; # Carlos Gratz
# obviously, all other DBIx::EAV::Entity are also available :]
As you could have noted in the first code snippet, its also possible to create
custom resultset classes.
package MyApp::Schema::ResultSet::User;
use Moo;
extends 'DBIx::EAV::ResultSet';
sub verified_only {
my $self = shift;
$self->search({ is_verified => 1 });
}
1;
Now a call to C<< $eav->resultset('User') >> returns an instance of
C<MyApp::Schema::ResultSet::User>.
my $users_rs = $eav->resultset('User');
$users_rs->isa('MyApp::Schema::ResultSet::User'); # 1
my $verified_user = $users_rs->verified_only
->find({ email => 'user@example.com'});
=head1 CUSTOM CLASS INHERITANCE
DBIx::EAV supports entity type inheritance. When working with custom classes all
you need to do is set you custom base class by normal perl means. DBIx::EAV
will inspect your class C<@ISA> and get the parent entity name.
package MyApp::DB::Result::UserSubclass;
BEGIN { extends 'MyApp::DB::Result::User' }
# define attributes, relationships and methods for 'UserSubclass'
1;
For more information on how entity type inheritance works in DBIx::EAV, read
L<DBIx::EAV::Manual::Inheritance>.
=head1 METHODS
=head2 in_storage
Returns true if a database id is present.
sub in_storage {
my $self = shift;
exists $self->raw->{id} && defined $self->raw->{id};
}
=head2 id
Returns the entity database id or C<undef> if entity is not in storage.
# new_entity() doesn't call save(). $cd1 has no id in this case
my $cd1 = $eav->resultset('CD')->new_entity({ title => 'CD1' });
$cd1->id; # undef
$cd1->save;
$cd1->id; # <database id>
$cd1->delete;
$cd1->id; # undef
=head2 get
=over 4
=item Arguments: $attr_name | $relationship_name
=item Return Value: $attr_value | $related_cursor | @related_entities
=back
Returns a attribute value or related entities.
=head2 set
=over 4
=item Arguments: $name, $value \%values
=item Arguments: \%values
=item Return Value: L<$self|DBIx::EAV::Entity>
=back
Set a new value for the attribute or relationship C<$name>. Returns C<$self> to
allow method chaining. Even though subsequent calls to L</get> will return the
new value you have just L</set>, changes are not saved in the database until you
call L</save>. Use L</update> if you wan't to set and save in one call.
$cd->set('title' => 'New title');
$cd->get('title'); # New title
$cd->save; # or $cd->discard_changes
# set multiple values
$cd->set({
title => 'New Title',
year => 2016
});
When setting the value for a relationship, this method replaces the existing
set of related entities by the new one (relationship bindings are deleted,
not the related entities themselves). Valid values for relationships are
existing L<entities|DBIx::EAV::Entity> or hashref suitable for inserting the
related entity, or a arrayref of those (for *_many relationships). Passing an
entity instance which is not of the correct type for the relationship or not
L</in_storage> is a fatal error.
# set (and replace) the cd tracks
$cd->set('tracks', [
{ title => 'Track1', duration => ... },
{ title => 'Track2', duration => ... },
{ title => 'Track3', duration => ... },
]);
# set its tags
my @tags = $eav->resultset('Tag')->find( name => [qw/ Foo Bar Baz /]);
$cd->set('tags', \@tags);
You can obviously set attribute and relationships at the same time:
$cd->set({
title => 'New Title',
year => 2016,
tracks => \@tracks
});
Se also L</add_related> if you want to add (instead of replace) related entities.
=head2 save
=over 4
=item Arguments: none
=item Return Value: $self
=back
Save all changes to the database.
# modify
$entity->set( ... );
$entity->save;
First thing C<save> does is insert the entity (in the entities table) if its
not already L</in_storage>. Then it saves the non-static attributes:
attributes values (in the values tables) are inserted, updated or deleted,
whether the value is new (undef -> value), existing (value -> value),
or undef (value -> undef).
Then relationship bindings are inserted/deleted according with each relationship
type and rules. Related entities in the form of hashref is inserted before the
bindings takes place.
Last but not least, modifications to static attributes are saved on the
L<entities table|DBIx::EAV::Schema>.
=head2 update
=over 4
=item Arguments: $name, $value \%values
=item Arguments: \%values
=item Return Value: L<$self|DBIx::EAV::Entity>
=back
A shortcut for C<set()> and C<save()>.
# set and save in one call
$cd->update({
title => 'New CD Title',
year => 2016
});
=head2 load_attributes
=over 4
=item Arguments: @attr_names?
=back
Fetches the attributes values from database L<value tables> and stores in
entity's L</raw> data structure. If this method is called without arguments
all attributes will be loaded.
NOTE: In the current version of DBIx::EAV this method is called internally by
L<DBIx::EAV::Cursor/next>, which makes all attributes to be loaded everytime.
Its planned for a future version to make the attributes get lazy-loaded, which
will make this method relevant.
=head2 add_related
=over 4
=item Arguments: L<$rel_name|DBIx::EAV::EntityType/relationship>, $related_data
=back
Available only for has_many and many_to_many relationships, this method binds
entities via the C<$rel_name> relationship. C<$related_data> must be a
L<entity|DBIx::EAV::Entity> instance (of the proper type for the relationship)
or a hashref of data to be inserted (again, suitable for the related type), or a
arrayref of those. Passing L<Entity|DBIx::EAV::Entity> objects which are not
L</in_storage> results in a fatal error.
# add tracks to a cd
$cd->add_related('tracks', [
{ title => 'Track1', duration => ... },
{ title => 'Track2', duration => ... },
{ title => 'Track3', duration => ... },
]);
# also accepts existing entities
my @tracks = $eav->resultset('Track')->populate( ... );
$cd->add_related('tracks', \@tracks);
=head2 remove_related
=over 4
=item Arguments: L<$rel_name|DBIx::EAV::EntityType/relationship>, L<$related_entities|DBIx::EAV::Entity>
=back
Unbinds C<$related_entities> from the relationship C<$rel_name>. Note that it
doesn't delete the related entities.
my @tags = $eav->resultset('Tag')->find( name => [qw/ Foo Bar Baz /]);
$article->remove_related('tags', \@tags);
=head2 discard_changes
Reverts all modified attributes to the its original value. Note that the internal
memory of modified attributes is reset after a call to L</save>.
=head2 delete
=over
=item Arguments: none
=item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
=back
Throws an exception if the object is not in the database according to
L</in_storage>.
The object is still perfectly usable, but L</in_storage> will
now return 0 and the object will be reinserted (same attrs, new id) if you
call L</save>.
If you delete an object in a class with a C<has_many> or C<has_one>
relationship, an attempt is made to delete all the related objects as well.
To turn this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref of the relationship, see L<DBIx::EAV/Relationships>.
Since a entity is represented by data not only in the entities table, but also
in value tables and relationship links table, those related rows must be deleted
before the main row.
First a C<DELETE> is executed for the relationship links table where this entity
is the right-side entity, unbinding from "parent" relationships. Then a
C<DELETE> query is executed for each value table, unless this entity has no
attributes of that data type.
Those extra C<DELETE> operations are unneccessary if you are using database-level
C<ON DELETE CASCADE>. See L<DBIx::EAV/DATABASE-LEVEL CASCADE DELETE>.
See also L<DBIx::EAV::ResulutSet/delete>.
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
lib/DBIx/EAV/EntityType.pm view on Meta::CPAN
package DBIx::EAV::EntityType;
use Moo;
use strictures 2;
use Carp qw/ confess /;
has 'core', is => 'ro', required => 1;
has 'id', is => 'ro', required => 1;
has 'name', is => 'ro', required => 1;
has 'parent', is => 'ro', predicate => 1;
has '_static_attributes', is => 'ro', init_arg => undef, lazy => 1, builder => 1;
has '_attributes', is => 'ro', init_arg => 'attributes', default => sub { {} };
has '_relationships', is => 'ro', init_arg => 'relationships', default => sub { {} };
sub _build__static_attributes {
my $self = shift;
+{
map { $_ => {name => $_, is_static => 1} }
@{$self->core->table('entities')->columns}
}
}
sub load {
my ($class, $row) = @_;
die "load() is a class method" if ref $class;
my $self = $class->new($row);
# load attributes
my $sth = $self->core->table('attributes')->select({ entity_type_id => $self->id });
while (my $attr = $sth->fetchrow_hashref) {
$self->_attributes->{$attr->{name}} = $attr;
}
# load relationships
$sth = $self->core->table('relationships')->select([ {left_entity_type_id => $self->id} , {right_entity_type_id => $self->id} ]);
while (my $rel = $sth->fetchrow_hashref) {
if ($self->id eq $rel->{left_entity_type_id}) {
$self->_relationships->{$rel->{name}} = $rel;
}
else {
$self->_relationships->{$rel->{incoming_name}} = {
%$rel,
is_right_entity => 1,
name => $rel->{incoming_name},
incoming_name => $rel->{name},
};
}
}
$self;
}
sub parents {
my ($self) = @_;
return () unless $self->has_parent;
my @parents;
my $parent = $self->parent;
while ($parent) {
push @parents, $parent;
$parent = $parent->parent;
}
@parents;
}
sub is_type($) {
my ($self, $type) = @_;
confess 'usage: is_type($type)' unless $type;
return 1 if $self->name eq $type;
foreach my $parent ($self->parents) {
return 1 if $parent->name eq $type;
}
0;
}
sub has_attribute {
my ($self, $name) = @_;
return 1 if exists $self->_attributes->{$name} || exists $self->_static_attributes->{$name};
return 0 unless $self->has_parent;
my $parent = $self->parent;
while ($parent) {
return 1 if $parent->has_own_attribute($name);
$parent = $parent->parent;
}
0;
}
sub has_static_attribute {
my ($self, $name) = @_;
exists $self->_static_attributes->{$name};
}
sub has_own_attribute {
my ($self, $name) = @_;
exists $self->_attributes->{$name} || exists $self->_static_attributes->{$name};
}
sub has_inherited_attribute {
my ($self, $name) = @_;
return 0 unless $self->has_parent;
my $parent = $self->parent;
while ($parent) {
return 1 if exists $parent->_attributes->{$name};
$parent = $parent->parent;
}
0;
}
sub attribute {
my ($self, $name) = @_;
# our attr
return $self->_attributes->{$name}
if exists $self->_attributes->{$name};
return $self->_static_attributes->{$name}
if exists $self->_static_attributes->{$name};
# parent attr
my $parent = $self->parent;
while ($parent) {
return $parent->_attributes->{$name}
if exists $parent->_attributes->{$name};
$parent = $parent->parent;
}
# unknown attribute
die sprintf("Entity '%s' does not have attribute '%s'.", $self->name, $name);
}
sub attributes {
my ($self, %options) = @_;
my @items;
# static
push @items, values %{$self->_static_attributes}
unless $options{no_static};
# own
push @items, values %{$self->_attributes}
unless $options{no_own};
# inherited
unless ($options{no_inherited}) {
my $parent = $self->parent;
while ($parent) {
push @items, values %{$parent->_attributes};
$parent = $parent->parent;
}
}
return $options{names} ? map { $_->{name} } @items : @items;
}
sub has_own_relationship {
my ($self, $name) = @_;
exists $self->_relationships->{$name};
}
sub has_relationship {
my ($self, $name) = @_;
return 1 if exists $self->_relationships->{$name};
return 0 unless $self->has_parent;
my $parent = $self->parent;
while ($parent) {
return 1 if $parent->has_own_relationship($name);
$parent = $parent->parent;
}
0;
}
sub relationship {
my ($self, $name) = @_;
# our
return $self->_relationships->{$name}
if exists $self->_relationships->{$name};
# parent
my $parent = $self->parent;
while ($parent) {
return $parent->_relationships->{$name}
if exists $parent->_relationships->{$name};
$parent = $parent->parent;
}
# unknown
die sprintf("Entity '%s' does not have relationship '%s'.", $self->name, $name);
}
sub relationships {
my ($self, %options) = @_;
# ours
my @items = values %{$self->_relationships};
# inherited
unless ($options{no_inherited}) {
my $parent = $self->parent;
while ($parent) {
push @items, values %{$parent->_relationships};
$parent = $parent->parent;
}
}
return $options{names} ? map { $_->{name} } @items : @items;
}
sub prune_attributes {
my ($self, $names) = @_;
# TODO implement prune_attributes
die "not implemented yet";
}
sub prune_relationships {
my ($self, $names) = @_;
# TODO implement prune_relationships
die "not implemented yet";
}
1;
__END__
=encoding utf-8
=head1 NAME
DBIx::EAV::EntityType - An entity definition. Its attributes and relationships.
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 ENTITY DEFINITION
An entity definition is a key/value pair in the form of C<< EntityName => \%definition >>,
where the possible keys for %definition are:
=over
=item attributes
=item has_one
An arrayref of related entity names to create a has_one relationship.
=item has_many
An arrayref of related entity names to create a has_many relationship.
=item many_to_many
An arrayref of related entity names to create a many_to_many relationship.
=back
=head1 METHODS
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
lib/DBIx/EAV/Manual.pod view on Meta::CPAN
__END__
=encoding utf-8
=head1 NAME
DBIx::EAV::Manual - Users Manual
=head1 WHAT'S EAV?
EAV is a data model where instead of representing each entity using a physical
table with columns representing its attributes, everything is stored as rows of
the eav tables. Each entity is stored as a row of the 'entities' table, and each
of its attributes values are stored as a row of one of the values table. There is
one value table for each data type.
For a better explanation of what an Entity-Attribute-Value data model is, check
this L<Wikipedia article|https://en.wikipedia.org/wiki/Entity%E2%80%93attribute%E2%80%93value_model>.
The specific tables used by this implementation are described in
L<DBIx::EAV::Schema/TABLES>.
=head1 EAV USE CASES
=head2 When the number of possible attributes is huge
EAV modeling has been used by health and clinical software by decades because the
number of possible attributes like tests results and diagnostics are huge and
just a few of those attributes are acctualy filled (non-NULL).
=head2 When you dont't know your schema in advance
E-commerce solutions use EAV modeling to allow the definition of any kind of product
and still be able to do filtering/sorting of results based of product attributes.
For example, the entity 'HardDrive' would have atrributes 'capacity' and 'rpm',
while entity 'Monitor' would have attributes 'resolution' and 'contrast_ratio'.
=head2 To abstract the physical database layer
Many SaaS platforms use EAV modeling to offer database services to its custormers,
without exposing the physical database system.
=head2 When you need frequent changes to your schema
An open-schema data model can be useful for app prototyping.
=head1 DBIx::EAV CONCEPTS
=head2 EntityType
An L<EntityType|DBIx::EAV::EntityType> is the blueprint of an entity. Like a
Class in OOP. Each type has a unique name, one or more attributes and zero or
more relationships. See L<DBIx::EAV::EntityType>.
=head2 Entity
An actual entity record (of some type) that has its own id and attribute values.
See L<DBIx::EAV::Entity>.
=head2 Attribute
Attributes are analogous to columns in traditional database modeling. Its the
actual named properties that describes an entity type. Every attribute has a
unique name and a data type. Unlike traditional table columns, adding/removing
attributes to an existing entity type is very easy and cheap.
=head2 Value
The actual attribute data stored in one of the value tables. There is one value
table for each data type.
See L</data_types>, L<DBIx::EAV::Schema>.
=head2 ResultSet
Concept borrowed from L<DBIx::Class>, a ResultSet represents a query used for
fetching a set of entities of a type, as well as other CRUD operations on
multiple entities.
=head2 Relationships
=head2 Physical Schema
This is the actual database tables used by the EAV system. Its represented by
L<DBIx::EAV::Schema>.
=head2 EAV Schema
Its the total set of Entity Types registered on the system, which form the
actual application business model.
See L</register_types>.
=head2 Cursor
A Cursor is used internally by the ResultSet to prepare, execute and traverse
through SELECT queries.
=head1 RELATIONSHIPS
=head2 has_one
=head2 has_many
=head2 many_to_many
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
lib/DBIx/EAV/ResultSet.pm view on Meta::CPAN
package DBIx::EAV::ResultSet;
use Moo;
use DBIx::EAV::Entity;
use DBIx::EAV::Cursor;
use Data::Dumper;
use Carp qw/ croak confess /;
use overload
'0+' => "_to_num",
'bool' => "_to_bool",
fallback => 1;
my $sql = SQL::Abstract->new;
has 'eav', is => 'ro', required => 1;
has 'type', is => 'ro', required => 1;
has '_query', is => 'rw', default => sub { [] }, init_arg => 'query';
has '_options', is => 'rw', default => sub { {} }, init_arg => 'options';
has 'cursor', is => 'rw',
lazy => 1,
init_arg => undef,
predicate => '_has_cursor',
clearer => '_clear_cursor',
builder => '_build_cursor';
has 'entity_class', is => 'ro', init_arg => undef, lazy => 1, default => sub {
my $self = shift;
$self->eav->_resolve_entity_class($self->type->name) || 'DBIx::EAV::Entity';
};
sub _to_num { $_[0]->count }
sub _to_bool { 1 }
sub _build_cursor {
my $self = shift;
DBIx::EAV::Cursor->new(
eav => $self->eav,
type => $self->type,
query => $self->_query,
options => $self->_options,
);
}
sub new_entity {
my ($self, $data) = @_;
my $entity = $self->entity_class->new( eav => $self->eav, type => $self->type );
$entity->set($data) if ref $data eq 'HASH';
$entity;
}
sub inflate_entity {
my ($self, $data) = @_;
my $type = $self->type;
$type = $self->eav->type_by_id($data->{entity_type_id})
if $data->{entity_type_id} && $data->{entity_type_id} != $type->id;
my $entity = $self->entity_class->new( eav => $self->eav, type => $type, raw => $data );
$entity->load_attributes;
$entity;
}
{
no warnings;
*create = \&insert;
}
sub insert {
my ($self, $data) = @_;
$self->new_entity($data)->save;
}
sub populate {
my ($self, $data) = @_;
die 'Call populate(\@items)' unless ref $data eq 'ARRAY';
my @result;
foreach my $item (@$data) {
push @result, $self->insert($item);
}
return wantarray ? @result : \@result;
}
sub update {
my ($self, $data, $where) = @_;
$where //= {};
$where->{entity_type_id} = $self->type->id;
# do a direct update for static attributes
}
sub delete {
my $self = shift;
my $eav = $self->eav;
my $type = $self->type;
my $entities_table = $eav->table('entities');
# Call delete_all for SQLite since it doesn't
# support delete with joins.
# Better solution welcome.
return $self->delete_all if
$self->eav->schema->db_driver_name eq 'SQLite';
unless ($eav->schema->database_cascade_delete) {
# delete links by relationship id
my @ids = map { $_->{id} } $type->relationships;
$eav->table('entity_relationships')->delete(
{
relationship_id => \@ids,
$entities_table->name.'.entity_type_id' => $type->id
},
{ join => { $entities_table->name => [{ 'me.left_entity_id' => 'their.id' }, { 'me.right_entity_id' => 'their.id' }] } }
);
# delete attributes:
# - group attrs by data type so only one DELETE command is sent per data type
# - restrict by entity_type_id so we dont delete parent/sibiling/child data
my %types;
push @{ $types{$_->{data_type}} }, $_->{id}
for $type->attributes(no_static => 1);
while (my ($data_type, $ids) = each %types) {
my $value_table = $eav->table('value_'.$data_type);
$value_table->delete(
{
attribute_id => $ids,
$entities_table->name.'.entity_type_id' => $type->id
},
{ join => { $entities_table->name => { 'me.entity_id' => 'their.id' } } }
);
}
}
$entities_table->delete({ entity_type_id => $type->id });
}
sub delete_all {
my $self = shift;
my $rs = scalar @_ > 0 ? $self->search_rs(@_) : $self;
my $i = 0;
while (my $entity = $rs->next) {
$entity->delete;
$i++;
}
$i;
}
sub find {
my ($self, $criteria, $options) = @_;
croak "Missing find() criteria."
unless defined $criteria;
# simple id search
return $self->search_rs({ id => $criteria }, $options)->next
unless ref $criteria;
my $rs = $self->search_rs($criteria, $options);
my $result = $rs->next;
# criteria is a search query, die if this query returns multiple items
croak "find() returned more than one entity. If this is what you want, use search or search_rs."
if defined $result && defined $rs->cursor->next;
$result;
}
sub search {
my ($self, $query, $options) = @_;
my $rs = $self->search_rs($query, $options);
return wantarray ? $rs->all : $rs;
}
sub search_rs {
my ($self, $query, $options) = @_;
# simple combine queries using AND
my @new_query = @{ $self->_query };
push @new_query, $query if $query;
# merge options
my $merged_options = $self->_merge_options($options);
(ref $self)->new(
eav => $self->eav,
type => $self->type,
query => \@new_query,
options => $merged_options
);
}
sub _merge_options {
my ($self, $options) = @_;
my %merged = %{ $self->_options };
return \%merged
unless defined $options;
confess "WTF" if $options eq '';
foreach my $opt (keys %$options) {
# doesnt even exist, just copy
if (not exists $merged{$opt}) {
$merged{$opt} = $options->{$opt};
}
# having: combine queries using AND
elsif ($opt eq 'having') {
$merged{$opt} = [$merged{$opt}, $options->{$opt}];
}
# merge array
elsif (ref $merged{$opt} eq 'ARRAY') {
$merged{$opt} = [
@{$merged{$opt}},
ref $options->{$opt} eq 'ARRAY' ? @{$options->{$opt}} : $options->{$opt}
];
}
else {
$merged{$opt} = $options->{$opt};
}
}
\%merged;
}
sub count {
my $self = shift;
return $self->search(@_)->count if @_;
# from DBIx::Class::ResultSet::count()
# this is a little optimization - it is faster to do the limit
# adjustments in software, instead of a subquery
my $options = $self->_options;
my ($limit, $offset) = @$options{qw/ limit offset /};
my $count = $self->_count_rs($options)->cursor->next->{count};
$count -= $offset if $offset;
$count = 0 if $count < 0;
$count = $limit if $limit && $count > $limit;
$count;
}
sub _count_rs {
my ($self, $options) = @_;
my %tmp_options = ( %$options, select => [\'COUNT(*) AS count'] );
# count using subselect if needed
$tmp_options{from} = $self->as_query
if $options->{group_by} || $options->{distinct};
delete @tmp_options{qw/ limit offset order_by group_by distinct /};
(ref $self)->new(
eav => $self->eav,
type => $self->type,
query => [@{ $self->_query }],
options => \%tmp_options
);
}
sub as_query {
my $self = shift;
$self->cursor->as_query;
}
sub reset {
my $self = shift;
$self->_clear_cursor;
$self;
}
sub first {
$_[0]->reset->next;
}
sub next {
my $self = shift;
# fetch next
my $entity_row = $self->cursor->next;
return unless defined $entity_row;
# instantiate entity
$self->inflate_entity($entity_row);
}
sub all {
my $self = shift;
my @entities;
$self->reset;
while (my $entity = $self->next) {
push @entities, $entity;
}
$self->reset;
return wantarray ? @entities : \@entities;
}
sub pager {
die "pager() not implemented";
}
sub distinct {
die "distinct() not implemented";
}
sub storage_size {
die "storage_size() not implemented";
}
1;
__END__
=encoding utf-8
=head1 NAME
DBIx::EAV::ResultSet - Represents a query used for fetching a set of entities.
=head1 SYNOPSIS
# resultsets are bound to an entity type
my $cds_rs = $eav->resultset('CD');
# insert CDs
my $cd1 = $cds_rs->insert({ title => 'CD1', tracks => \@tracks });
my $cd2 = $cds_rs->insert({ title => 'CD2', tracks => \@tracks });
my $cd3 = $cds_rs->insert({ title => 'CD3', tracks => \@tracks });
# ... or use populate() to insert many
my (@cds) = $cds_rs->populate(\@cds);
# find all 2015 cds
my @cds = $eav->resultset('CD')->search({ year => 2015 });
foreach my $cd (@cds) {
printf "CD '%s' has %d tracks.\n",
$cd->get('title'),
$cd->get('tracks')->count;
}
# find one
my $cd2 = $cds_rs->search_one({ name => 'CD2' });
# find by related attribute
my $cd2 = $cds_rs->search_one({ 'tracks.title' => 'Some CD2 Track' });
# count
my $top_cds_count = $cds_rs->search({ rating => { '>' => 7 } })->count;
# update
# delete all entities
$cds_rs->delete; # fast, but doesn't deletes related entities
$cds_rs->delete_all; # cascade delete all cds and related entities
=head1 DESCRIPTION
A ResultSet is an object which stores a set of conditions representing
a query. It is the backbone of DBIx::EAV (i.e. the really
important/useful bit).
No SQL is executed on the database when a ResultSet is created, it
just stores all the conditions needed to create the query.
A basic ResultSet representing the data of an entire table is returned
by calling C<resultset> on a L<DBIx::EAV> and passing in a
L<type|DBIx::EntityType> name.
my $users_rs = $eav->resultset('User');
A new ResultSet is returned from calling L</search> on an existing
ResultSet. The new one will contain all the conditions of the
original, plus any new conditions added in the C<search> call.
A ResultSet also incorporates an implicit iterator. L</next> and L</reset>
can be used to walk through all the L<entities|DBIx::EAV::Entity> the ResultSet
represents.
The query that the ResultSet represents is B<only> executed against
the database when these methods are called:
L</find>, L</next>, L</all>, L</first>, L</count>.
If a resultset is used in a numeric context it returns the L</count>.
However, if it is used in a boolean context it is B<always> true. So if
you want to check if a resultset has any results, you must use C<if $rs
!= 0>.
=head1 METHODS
=head2 new_entity
=over 4
=item Arguments: \%entity_data
=item Return Value: L<$entity|DBIx::EAV::EntityType>
=back
Creates a new entity object of the resultset's L<type|DBIx::EAV::EntityType> and
returns it. The row is not inserted into the database at this point, call
L<DBIx::EAV::Entity/save> to do that. Calling L<DBIx::EAV::Entity/in_storage>
will tell you whether the entity object has been inserted or not.
# create a new entity, do some modifications...
my $cd = $eav->resultset('CD')->new_entity({ title => 'CD1' });
$cd->set('year', 2016);
# now insert it
$cd->save;
=head2 insert
=over 4
=item Arguments: \%entity_data
=item Return Value: L<$entity|DBIx:EAV::Entity>
=back
Attempt to create a single new entity or a entity with multiple related entities
in the L<type|DBIx::EAV::EntityType> represented by the resultset (and related
types). This will not check for duplicate entities before inserting, use
L</find_or_create> to do that.
To create one entity for this resultset, pass a hashref of key/value
pairs representing the attributes of the L</type> and the values you wish to
store. If the appropriate relationships are set up, you can also pass related
data.
To create related entities, pass a hashref of related-object attribute values
B<keyed on the relationship name>. If the relationship is of type C<has_many>
or C<many_to_many> - pass an arrayref of hashrefs.
The process will correctly identify the relationship type and side, and will
transparently populate the L<entitiy_relationships table>.
This can be applied recursively, and will work correctly for a structure
with an arbitrary depth and width, as long as the relationships actually
exists and the correct data has been supplied.
Instead of hashrefs of plain related data (key/value pairs), you may
also pass new or inserted objects. New objects (not inserted yet, see
L</new_entity>), will be inserted into their appropriate types.
Effectively a shortcut for C<< ->new_entity(\%entity_data)->save >>.
Example of creating a new entity.
my $cd1 = $cds_rs->insert({
title => 'CD1',
year => 2016
});
Example of creating a new entity and also creating entities in a related
C<has_many> resultset. Note Arrayref for C<tracks>.
my $cd1 = $eav->resultset('CD')->insert({
title => 'CD1',
year => 2016
tracks => [
{ title => 'Track1', duration => ... },
{ title => 'Track2', duration => ... },
{ title => 'Track3', duration => ... }
]
});
Example of passing existing objects as related data.
my @tags = $eav->resultset('Tag')->search(\%where);
my $article = $eav->resultset('Article')->insert({
title => 'Some Article',
content => '...',
tags => \@tags
});
=over
=item WARNING
When subclassing ResultSet never attempt to override this method. Since
it is a simple shortcut for C<< $self->new_entity($data)->save >>, a
lot of the internals simply never call it, so your override will be
bypassed more often than not. Override either L<DBIx::EAV::Entity/new>
or L<DBIx::EAV::Entity/save> depending on how early in the
L</insert> process you need to intervene.
=back
=head2 populate
=over 4
=item Arguments: \@entites
=item Return Value: L<@inserted_entities|DBIx:EAV::Entity>
=back
Shortcut for inserting multiple entities at once. Returns a list of inserted
entities.
my @cds = $eav->resultset('CD')->populate([
{ title => 'CD1', ... },
{ title => 'CD2', ... },
{ title => 'CD3', ... }
]);
=head2 count
=over 4
=item Arguments: \%where, \%options
=item Return Value: $count
=back
Performs an SQL C<COUNT> with the same query as the resultset was built
with to find the number of elements. Passing arguments is equivalent to
C<< $rs->search($cond, \%attrs)->count >>
=head2 delete
=over 4
=item Arguments: \%where
=item Return Value: $underlying_storage_rv
=back
Deletes the entities matching \%where condition without fetching them first.
This will run faster, at the cost of related entities not being casdade deleted.
Call L</delete_all> if you want to cascade delete related entities.
When L<DBIx::EAV/database_cascade_delete> is enabled, the delete operation is
done in a single query. Otherwise one more query is needed for each of the
L<values table|DBIx::EAV::Schema> and another for the
L<relationship link table|DBIx::EAV::Schema>.
=over
=item WARNING
This method requires database support for C<DELETE ... JOIN>. Since the current
implementation of DBIx::EAV is only tested against MySQL and SQLite, this method
calls L</delete_all> if SQLite database is detected.
=back
=head2 delete_all
=over 4
=item Arguments: \%where, \%options
=item Return Value: $num_deleted
=back
Fetches all objects and deletes them one at a time via
L<DBIx::EAV::Entity/delete>. Note that C<delete_all> will cascade delete related
entities, while L</delete> will not.
=head1 QUERY OPTIONS
=head2 limit
=over 4
=item Value: $rows
=back
Specifies the maximum number of rows for direct retrieval or the number of
rows per page if the page option or method is used.
=head2 offset
=over 4
=item Value: $offset
=back
Specifies the (zero-based) row number for the first row to be returned, or the
of the first row of the first page if paging is used.
=head2 page
NOT IMPLEMENTED.
=head2 group_by
=over 4
=item Value: \@columns
=back
A arrayref of columns to group by. Can include columns of joined tables.
group_by => [qw/ column1 column2 ... /]
=head2 having
=over 4
=item Value: \%condition
=back
The HAVING operator specifies a B<secondary> condition applied to the set
after the grouping calculations have been done. In other words it is a
constraint just like L</QUERY> (and accepting the same
L<SQL::Abstract syntax|SQL::Abstract/WHERE CLAUSES>) applied to the data
as it exists after GROUP BY has taken place. Specifying L</having> without
L</group_by> is a logical mistake, and a fatal error on most RDBMS engines.
Valid fields for criteria are all known attributes, relationships and related
attributes for the type this cursor is bound to.
E.g.
$eav->resultset('CD')->search(undef, {
'+select' => { count => 'tracks' }, # alias 'count_tracks' created automatically
group_by => ['me.id'],
having => { count_tracks => { '>' => 5 } }
});
Althought literal SQL is supported, you must know the actual alias and column names
used in the generated SQL statement.
having => \[ 'count(cds_link.) >= ?', 100 ]
Set the debug flag to get the SQL statements printed to stderr.
=head2 distinct
=over 4
=item Value: (0 | 1)
=back
Set to 1 to automatically generate a L</group_by> clause based on the selection
(including intelligent handling of L</order_by> contents). Note that the group
criteria calculation takes place over the B<final> selection. This includes
any L</+columns>, L</+select> or L</order_by> additions in subsequent
L</search> calls, and standalone columns selected via
L<DBIx::Class::ResultSetColumn> (L</get_column>). A notable exception are the
extra selections specified via L</prefetch> - such selections are explicitly
excluded from group criteria calculations.
If the cursor also explicitly has a L</group_by> attribute, this
setting is ignored and an appropriate warning is issued.
=head2 subtype_depth
=over 4
=item Value: $depth
Specifies how deep in the type hierarchy you want the query to go. By default
its 0, and the query is restricted to the type this cursor is bound to. Even though
you can use this option to find entities of subtypes, you cannot use the subtypes own
attributes in the query. So if you need to do a subtype query, ensure all attributes
needed for the query are defined on the parent type.
# Example entity types:
# Product [attrs: name, price, description]
# HardDrive [extends: Product] [attrs: rpm, capacity]
# Monitor [extends: Product] [attrs: resolution, contrast_ratio]
# FancyMonitor [extends: Monitor] [attrs: fancy_feature]
# this query won't find any HardDrive or Monitor, only Product entities
$eav->resultset('Product')->search({ price => { '<' => 500 } });
# this also finds HardDrive and Monitor entities
$eav->resultset('Product')->search(
{ price => { '<' => 500 } }, # subtype's attributes are not allowed
{ subtype_depth => 1 }
);
# this query also finds FancyMonitor
$eav->resultset('Product')->search(
\%where,
{ subtype_depth => 2 }
);
=back
=head2 prefetch
NOT IMPLEMENTED.
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
lib/DBIx/EAV/Schema.pm view on Meta::CPAN
package DBIx::EAV::Schema;
use Moo;
use Carp 'croak';
use Scalar::Util 'blessed';
use DBIx::EAV::Table;
use SQL::Translator;
use constant {
SQL_DEBUG => $ENV{DBIX_EAV_TRACE}
};
our $SCHEMA_VERSION = 1;
my %driver_to_producer = (
mysql => 'MySQL'
);
has 'dbh', is => 'ro', required => 1;
has 'database_cascade_delete', is => 'ro', default => 1;
has 'table_prefix', is => 'ro', default => 'eav_';
has 'tenant_id', is => 'ro';
has 'enable_multi_tenancy', is => 'ro', default => 0;
has 'data_types', is => 'ro', default => sub { [qw/ int decimal varchar text datetime bool /] };
has 'static_attributes', is => 'ro', default => sub { [] };
has 'id_type', is => 'ro', default => 'int';
has 'translator', is => 'ro', init_arg => undef, lazy => 1, builder => 1;
has '_tables', is => 'ro', init_arg => undef, default => sub { {} };
sub BUILD {
my $self = shift;
# enable sqlite fk for cascade delete to work
$self->dbh_do("PRAGMA foreign_keys = ON;")
if $self->db_driver_name eq 'SQLite';
}
sub _build_translator {
my $self = shift;
my $sqlt = SQL::Translator->new;
$self->_build_sqlt_schema($sqlt->schema);
$sqlt;
}
sub _build_sqlt_schema {
my ($self, $schema) = @_;
my $enable_multi_tenancy = $self->enable_multi_tenancy || $self->tenant_id;
my @schema = (
entity_types => {
columns => ['id', $enable_multi_tenancy ? 'tenant_id' : (), 'name:varchar:255', 'signature:char:32'],
index => [$enable_multi_tenancy ? 'tenant_id' : ()],
unique => {
name => [$enable_multi_tenancy ? 'tenant_id' : (),'name']
}
},
entities => {
columns => [qw/ id entity_type_id /, @{ $self->static_attributes } ],
fk => { entity_type_id => 'entity_types' }
},
attributes => {
columns => [qw/ id entity_type_id name:varchar:255 data_type:varchar:64 /],
fk => { entity_type_id => 'entity_types' }
},
relationships => {
columns => [qw/ id left_entity_type_id right_entity_type_id name:varchar:255 incoming_name:varchar:255 is_has_one:bool::0 is_has_many:bool::0 is_many_to_many:bool::0 /],
fk => { left_entity_type_id => 'entity_types', right_entity_type_id => 'entity_types' },
unique => {
name => ['left_entity_type_id','name']
}
},
entity_relationships => {
columns => [qw/ relationship_id left_entity_id right_entity_id /],
pk => [qw/ relationship_id left_entity_id right_entity_id /],
fk => {
relationship_id => 'relationships',
left_entity_id => { table => 'entities', cascade_delete => $self->database_cascade_delete },
right_entity_id => { table => 'entities', cascade_delete => $self->database_cascade_delete },
}
},
type_hierarchy => {
columns => [qw/ parent_type_id child_type_id /],
pk => [qw/ parent_type_id child_type_id /],
fk => {
parent_type_id => { table => 'entity_types', cascade_delete => $self->database_cascade_delete },
child_type_id => { table => 'entity_types', cascade_delete => $self->database_cascade_delete },
}
},
map {
("value_$_" => {
columns => [qw/ entity_id attribute_id /, 'value:'.$_],
fk => {
entity_id => { table => 'entities', cascade_delete => $self->database_cascade_delete },
attribute_id => 'attributes'
}
})
} @{ $self->data_types }
);
for (my $i = 0; $i < @schema; $i += 2) {
# add table
my $table_name = $schema[$i];
my $table_schema = $schema[$i+1];
my $table = $schema->add_table( name => $self->table_prefix . $table_name )
or die $schema->error;
# add columns
foreach my $col ( @{ $table_schema->{columns} }) {
my $field_params = ref $col ? $col : do {
my ($name, $type, $size, $default) = split ':', $col;
+{
name => $name,
data_type => $type,
size => $size,
default_value => $default
}
};
$field_params->{data_type} = $self->id_type
if $field_params->{name} =~ /(?:^id$|_id$)/;
$field_params->{is_auto_increment} = 1
if $field_params->{name} eq 'id';
$field_params->{is_nullable} //= 0;
$table->add_field(%$field_params)
or die $table->error;
}
# # primary key
my $pk = $table->get_field('id') ? 'id' : $table_schema->{pk};
$table->primary_key($pk) if $pk;
# # foreign keys
foreach my $fk_column (keys %{ $table_schema->{fk} || {} }) {
my $params = $table_schema->{fk}->{$fk_column};
$params = { table => $params } unless ref $params;
$table->add_constraint(
name => join('_', 'fk', $table_name, $fk_column, $params->{table}),
type => 'foreign_key',
fields => $fk_column,
reference_fields => 'id',
reference_table => $self->table_prefix . $params->{table},
on_delete => $params->{cascade_delete} ? 'CASCADE' : 'NO ACTION'
);
}
# # unique constraints
foreach my $name (keys %{ $table_schema->{unique} || {} }) {
$table->add_index(
name => join('_', 'unique', $table_name, $name),
type => 'unique',
fields => $table_schema->{unique}{$name},
);
}
# # index
foreach my $colname (@{ $table_schema->{index} || [] }) {
$table->add_index(
name => join('_', 'idx', $table_name, $colname),
type => 'normal',
fields => $colname,
);
}
}
return 1;
}
sub version { $SCHEMA_VERSION }
sub get_ddl {
my ($self, $producer) = @_;
unless ($producer) {
my $driver = $self->dbh->{Driver}{Name};
$producer = $driver_to_producer{$driver} || $driver;
}
$self->translator->producer($producer);
$self->translator->translate;
}
sub version_table {
my $self = shift;
DBIx::EAV::Table->new(
dbh => $self->dbh,
name => $self->table_prefix . 'schema_versions',
columns => [qw/ id version ddl /]
);
}
sub version_table_is_installed {
my $self = shift;
my $success = 0;
eval {
$self->dbh_do(sprintf 'SELECT COUNT(*) FROM %s', $self->table_prefix . 'schema_versions');
$success = 1;
};
$success;
}
sub install_version_table {
my $self = shift;
my $sqlt = SQL::Translator->new;
my $table = $sqlt->schema->add_table( name => $self->version_table->name );
$table->add_field(
name => 'id',
data_type => 'INTEGER',
is_auto_increment => 1
);
$table->add_field(
name => 'version',
data_type => 'INTEGER'
);
$table->add_field(
name => 'ddl',
data_type => 'TEXT'
);
$table->primary_key('id');
# execute ddl
my $driver = $self->dbh->{Driver}{Name};
$sqlt->producer($driver_to_producer{$driver} || $driver);
$self->dbh_do($_)
for grep { /\w/ } split ';', $sqlt->translate;
}
sub installed_version {
my $self = shift;
my $table = $self->version_table;
my $row;
eval {
my ($rv, $sth) = $self->dbh_do(sprintf 'SELECT * FROM %s ORDER BY id DESC', $table->name);
$row = $sth->fetchrow_hashref;
};
return unless $row;
$row->{version};
}
sub deploy {
my $self = shift;
my %options = ( @_, no_comments => 1 );
$self->translator->$_($options{$_})
for keys %options;
# deploy version table
$self->install_version_table
unless $self->version_table_is_installed;
# check we already installed this version
my $version_table = $self->version_table;
return if $version_table->select_one({ version => $self->version }) && !$options{add_drop_table};
# deploy ddl
my $ddl = $self->get_ddl;
print STDERR $ddl if SQL_DEBUG;
$self->dbh_do($_)
for grep { /\w/ } split ';', $ddl;
# create version record
$version_table->insert({
version => $self->version,
ddl => 'DDL'
});
}
sub dbh_do {
my ($self, $stmt, $bind) = @_;
if (SQL_DEBUG) {
my $i = 0;
print STDERR "$stmt";
print STDERR $bind ? sprintf(": %s\n", join(' ', map { $i++.'='.$_ } @{ $bind || [] }))
: ";\n";
}
my $sth = $self->dbh->prepare($stmt);
my $rv = $sth->execute(ref $bind eq 'ARRAY' ? @$bind : ());
die $sth->errstr unless defined $rv;
return ($rv, $sth);
}
sub table {
my ($self, $name) = @_;
return $self->_tables->{$name}
if exists $self->_tables->{$name};
my $table_schema = $self->translator->schema->get_table($self->table_prefix . $name);
croak "Table '$name' does not exist."
unless $table_schema;
$self->_tables->{$name} = DBIx::EAV::Table->new(
dbh => $self->dbh,
tenant_id => $self->tenant_id,
name => $table_schema->name,
columns => [ $table_schema->field_names ]
);
}
sub has_data_type {
my ($self, $name) = @_;
foreach (@{$self->data_types}) {
return 1 if $_ eq $name;
}
0;
}
sub db_driver_name {
shift->dbh->{Driver}{Name};
}
1;
__END__
=encoding utf-8
=head1 NAME
DBIx::EAV::Schema - Describes the physical EAV database schema.
=head1 SYNOPSIS
my $schema = DBIx:EAV::Schema->new(
dbh => $dbh, # required
tables => \%tables # required
tenant_id => $tenant_id, # default undef
table_prefix => 'my_eav_', # default 'eav_'
);
=head1 DESCRIPTION
This class represents the physical eav database schema. Will never need to
instantiate an object of this class directly.
=head1 CONSTRUCTOR OPTIONS
=head2 data_types
=over
=item Default: C<[qw/ int decimal varchar text datetime bool /]>
=back
Arrayref of SQL data types that will be available to entity attributes. DBIx::EAV
uses one value table for each data type listed here. See L</values> and L</deploy>.
=head2 static_attributes
=over
=item Default: C<[]>
Arrayref of column definitions which will be available as static attributes for
all entities. A column definition is a string in the form of
C<"$col_name:$data_type:$data_size:$default_value"> or a hashref suitable for
L<SQL::Translator::Schema::Table/add_field>.
Example defining a C<slug VARCHAR(255)> and a C<is_deleted BOOL DEFAULT 0>
attributes. Note that in the definition of C<is_deleted> we wanted to specify
the C<$default_value> but not the C<$data_size> field.
static_attributes => [qw/ slug:varchar:255 is_deleted:bool::0 /]
=back
=head2 table_prefix
=over
=item Default: C<"eav_">
=back
Prefix added to our tables names to form the real database table name.
See L</TABLES>.
=head2 database_cascade_delete
=over
=item Default: C<1>
=back
When enabled, entities delete operations (via L<DBIx::EAV::Entity/delete> or
L<DBIx::EAV::ResultSet/delete>) are accomplished through a single C<DELETE> SQL command.
Also instructs L</deploy> to create the proper C<ON DELETE CASCADE> constraints.
See L</"CASCADE DELETE">.
=head2 tenant_id
=over
=item Default: C<undef>
=back
Setting this parameter enables the multi-tenancy feature.
=head2 id_type
=over
=item Default: C<"int">
=back
Data type used by L</deploy> for the C<PRIMARY KEY> ('id') and C<FOREIGN KEY> ('*_id') columns.
=head1 TABLES
This section describes the tables used by L<DBIx::EAV>.
=head2 entity_types
=over
=item Columns: id, tenant_id?, name:varchar:255
=item Primary Key: id
=item Index: tenant_id?
=item Unique: name
=back
=head2 attributes
=over
=item Columns: id, entity_type_id, name:varchar:255, data_type:varchar:64
=item Primary Key: id
=item Foreign Key: entity_type_id -> L</entity_types>
=back
=head2 relationships
=over
=item Columns: id, name:varchar:255, left_entity_type_id, right_entity_type_id, is_has_one:bool::0, is_has_many:bool::0, is_many_to_many:bool::0
=item Primary Key: id
=item Foreign Key: left_entity_type_id -> L</entity_types>
=item Foreign Key: right_entity_type_id -> L</entity_types>
=item Unique: left_entity_type_id, name
=back
Stores the relationships definition between L<entity types|/entity_types>.
See L<DBIx::EAV::Manual/RELATIONSHIPS>.
=head2 type_hierarchy
=over
=item Columns: parent_type_id, child_type_id
=item Primary Key: parent_type_id, child_type_id
=item Foreign Key: parent_type_id -> L</entity_types>
=item Foreign Key: child_type_id -> L</entity_types>
=back
Stores the type -> subtype relationship. See L</"TYPE INHERITANCE">.
=head2 entities
=over
=item Columns: id, entity_type_id, (L</static_attributes>)?
=item Primary Key: id
=item Foreign Key: entity_type_id -> L</entity_types>
=back
Stores the main entities rows, which by default contain only the C<id> and
C<entity_type_id> columns. Any defined L</static_attributes> are also added as
real columns of this table. This is a very "tall and skinny" table, tipical of EAV
systems.
=head2 entity_relationships
=over
=item Columns: relationship_id, left_entity_id, right_entity_id
=item Primary Key: id
=item Foreign Key: left_entity_id -> L</entitites> (ON DELETE CASCADE)
=item Foreign Key: right_entity_id -> L</entitites> (ON DELETE CASCADE)
=back
Stores the actual relationship links between L</entities>.
=head2 values
=over
=item Columns: entity_id, attribute_id, value
=item Primary Key: entity_id, attribute_id
=item Foreign Key: entity_id -> L</entitites> (ON DELETE CASCADE)
=item Foreign Key: attribute_id -> L</attributes>
=back
Stores the actual attributes values. One table named
C< $table_prefix . $data_type . "_value" > is created for each data type listed
in L</data_types>.
=head1 METHODS
=head2 table
my $table = $schema->table($name);
Returns a L<DBIx::EAV::Table> representing the table $name.
=head2 dbh_do
=head2 has_data_type
=head2 deploy
Create the eav database tables.
$eav->schema->deploy( add_drop_table => 1 );
=head2 get_ddl
Returns the eav schema DDL in any of the supported L<SQL::Translator> producers.
If no argument is passed a producer for the L<current driver|/db_driver_name> is
used.
my $mysql_ddl = $eav->schema->get_ddl('MySQL');
=head2 db_driver_name
Shortcut for C<< $self->dbh->{Driver}{Name} >>.
=head1 CASCADE DELETE
Since a single L<entity|DBIx::EAV::Entity>'s data is spread over several value
tables, we can't just delete the entity in a single SQL C<DELETE> command.
We must first send a C<DELETE> for each of those value tables, and one more for
the L</entity_relationships> table. If an entity has attributes of 4 data types,
and has any relationship defined, a total of 6 (six!!) C<DELETE> commands will
be needed to delete a single entity. Four to the L</values> tables, one to the
L</entity_relationships> and one for the actual L</entities> table).
Those extra C<DELETE> commands can be avoided by using database-level
C<ON DELETE CASCADE> for the references from the B<values> and
B<entity_relationships> tables to the B<entities> table.
The current DBIx::EAV implementation can handle both situations, but defaults
to database-level cascade delete. See L</database_cascade_delete> option.
I'll probably drop support for no database-level cascade delete in the future...
if no one points otherwise.
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
lib/DBIx/EAV/Table.pm view on Meta::CPAN
package DBIx::EAV::Table;
use Moo;
use SQL::Abstract;
use constant {
SQL_DEBUG => $ENV{DBIX_EAV_TRACE}
};
my $sql = SQL::Abstract->new;
has '_dbh', is => 'ro', required => 1, init_arg => 'dbh';
has 'name', is => 'ro', required => 1;
has 'columns', is => 'ro', required => 1;
has 'tenant_id', is => 'ro';
sub BUILD {
my $self = shift;
die sprintf "Error instantiating table '%s': tenant_id is required!"
if $self->has_column('tenant_id') && !defined $self->tenant_id;
}
sub has_column {
my ($self, $name) = @_;
foreach (@{$self->columns}) {
return 1 if $_ eq $name;
}
0;
}
sub select {
my ($self, $where) = @_;
$where //= {};
$where = $self->_mangle_where($where);
my ($stmt, @bind) = $sql->select($self->name.' AS me', $self->columns, $where);
my ($rv, $sth) = $self->_do($stmt, \@bind);
$sth;
}
sub select_one {
my ($self, $where) = @_;
$self->select($where)->fetchrow_hashref;
}
sub insert {
my ($self, $data) = @_;
$data->{tenant_id} = $self->tenant_id
if $self->has_column('tenant_id');
my ($stmt, @bind) = $sql->insert($self->name, $data);
my ($rv, $sth) = $self->_do($stmt, \@bind);
if ($rv == 1) {
return $self->_dbh->last_insert_id(undef, undef, undef, undef) || 1;
}
else {
$rv;
}
}
sub update {
my ($self, $data, $where) = @_;
$where = $self->_mangle_where($where);
my ($stmt, @bind) = $sql->update($self->name, $data, $where);
my ($rv, $sth) = $self->_do($stmt, \@bind);
$rv;
}
sub delete {
my ($self, $where, $opts) = @_;
$opts //= {};
my $stmt = $opts->{join} ? sprintf("DELETE me FROM %s AS me", $self->name)
: sprintf("DELETE FROM %s", $self->name);
# JOIN
while (my ($table, $spec) = each %{ $opts->{join} || {} }) {
my ($join_criteria, @bind) = $sql->where($spec);
while ( (my $offset = index($join_criteria, '?')) > -1) {
my $val = shift @bind;
substr($join_criteria, $offset, 1, $val);
}
$join_criteria =~ s/^\s*WHERE//;
$join_criteria =~ s/\btheir\./$table./g;
$stmt .= " INNER JOIN $table ON $join_criteria";
}
# WHERE
my ($where_part, @bind);
if ($where) {
$where = $self->_mangle_where($where);
($where_part, @bind) = $sql->where($where);
$stmt .= " $where_part";
}
my ($rv, $sth) = $self->_do($stmt, \@bind);
$rv;
}
sub _mangle_where {
my ($self, $where) = @_;
return $where unless $self->has_column('tenant_id');
if (ref $where eq 'HASH') {
$where->{tenant_id} = $self->tenant_id;
}
else {
$where = { -and => [ tenant_id => $self->tenant_id, $where ] };
}
$where;
}
sub _do {
my ($self, $stmt, $bind) = @_;
if (SQL_DEBUG) {
my $i = 0;
printf STDERR "$stmt: %s\n",
join(' ', map { $i++.'='.$_ } @$bind);
}
my $sth = $self->_dbh->prepare($stmt);
my $rv = $sth->execute(ref $bind eq 'ARRAY' ? @$bind : ());
die $sth->errstr unless defined $rv;
return ($rv, $sth);
}
1;
__END__
=encoding utf-8
=head1 NAME
DBIx::EAV::Table - Abstracts common operations on a database table.
=head1 SYNOPSIS
my $table = DBIx::EAV::Table->new(
dbh => $dbh,
name => 'eav_entities',
columns => [qw/ id entity_type_id ... /],
tenant_id => ... # optional
)
=head1 DESCRIPTION
This class provides a simple abstraction for the most common operations on a database table.
You probably will never need to use this class (or objects) directly.
=head1 TENANT ID
=head1 METHODS
=head2 new
=head2 name
=head2 tenant_id
=head2 columns
=head2 has_column
=head2 select
=head2 select_one
=head2 insert
=head2 update
=head2 delete
=head1 LICENSE
Copyright (C) Carlos Fernando Avila Gratz.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Carlos Fernando Avila Gratz E<lt>cafe@kreato.com.brE<gt>
=cut
name = "DBIx-EAV"
badges = ["travis", "coveralls"]
module_maker="ModuleBuildTiny"
t/connect.t view on Meta::CPAN
#!/usr/bin/perl -w
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::DBIx::EAV;
my $eav = DBIx::EAV->connect('dbi:SQLite:database=:memory:', undef, undef, { RaiseError => 1 }, { tenant_id => 42 });
isa_ok $eav, 'DBIx::EAV';
isa_ok $eav->dbh, 'DBI::db';
is $eav->dbh->{RaiseError}, 1, 'DBI attrs';
done_testing;
#!/usr/bin/perl -w
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::DBIx::EAV;
my $eav = DBIx::EAV->new(
dbh => get_test_dbh,
tenant_id => 42,
static_attributes => [qw/ is_deleted:bool::0 is_active:bool::1 is_published:bool::1 /]
);
$eav->schema->deploy( add_drop_table => $eav->schema->db_driver_name eq 'mysql');
$eav->declare_entities(read_yaml_file("$FindBin::Bin/entities.yml"));
test_query();
test_next();
test_reset();
test_first();
done_testing;
sub test_query {
my $artists = $eav->resultset('Artist');
my $name_attr = $artists->type->attribute('name');
my $rating_attr = $artists->type->attribute('rating');
my $cursor = $artists->search_rs({
name => 'Bob',
rating => { '>' => 5 },
is_deleted => 1
},
{
limit => 10,
offset => 5,
order_by => { -asc => 'name' },
group_by => ['id', 'name']
})->cursor;
my $as_query = $cursor->as_query;
ref_ok $$as_query, 'ARRAY';
my ($sql_query, $bind) = @{$$as_query};
isa_ok $cursor->_sth, 'DBI::st';
ref_ok $bind, 'ARRAY';
# diag $sql_query;
ok index($sql_query, 'SELECT me.id, me.entity_type_id, me.is_deleted, me.is_active, me.is_published FROM eav_entities') != -1,
'sql query: SELECT part';
ok index($sql_query, "LEFT JOIN eav_value_int AS rating ON (rating.entity_id = me.id AND rating.attribute_id = $rating_attr->{id})") >= 0,
'sql query: JOIN rating part';
ok index($sql_query, "LEFT JOIN eav_value_varchar AS name ON (name.entity_id = me.id AND name.attribute_id = $name_attr->{id})") >= 0,
'sql query: JOIN name part';
ok index($sql_query, "entity_type_id = ?") >= 0,
'sql query: WHERE entity_type_id part';
ok index($sql_query, "name.value = ?") >= 0,
'sql query: WHERE name part';
ok index($sql_query, "rating.value > ?") >= 0,
'sql query: WHERE rating part';
ok index($sql_query, "me.is_deleted = ?") >= 0,
'sql query: WHERE is_deleted part';
ok index($sql_query, "ORDER BY name.value ASC LIMIT 10 OFFSET 5") >= 0,
'sql query: ORDER BY, LIMIT, OFFSET parts';
like $sql_query, qr(GROUP BY me.id, name.value),
'sql query: GROUP BY part';
# arrayref query
$as_query = $artists->search([{ name => 'Bob' }, { rating => { '>' => 5 } }])->cursor->as_query;
($sql_query, $bind) = @{$$as_query};
like $sql_query, qr/me\.entity_type_id = \? AND \( name\.value = \? OR rating\.value > \? \)/,
'arrayref query format';
# select function + having + order
$as_query = $artists->search(undef, {
select => ['id', { count => 'cds' }],
having => { count_cds => { '>' => 3 } },
order_by => { -asc => 'count_cds' }
})->as_query;
($sql_query, $bind) = @{$$as_query};
# diag $sql_query;
ok index($sql_query, "SELECT me.id, COUNT( cds_link.right_entity_id ) AS count_cds") >= 0,
'sql query: select function';
ok index($sql_query, "HAVING ( count_cds > ? )") >= 0,
'sql query: having';
ok index($sql_query, "ORDER BY count_cds ASC") >= 0,
'sql query: order by alias';
}
sub test_next {
my $artists = $eav->resultset('Artist');
my $name_attr = $artists->type->attribute('name');
my $rating_attr = $artists->type->attribute('rating');
my $bob = $artists->insert({ name => 'Bob', rating => 10 });
my $peter = $artists->insert({ name => 'Peter', rating => 9 });
$artists->insert({ name => 'Edson', rating => 7 });
my $cursor = $artists->search({ rating => { '>' => 8 } }, { order_by => { -asc => 'rating' }})->cursor;
is $cursor->next->{id}, $peter->id, '1st next()';
is $cursor->next->{id}, $bob->id, '2nd next()';
is $cursor->next, undef, '3rd next()';
}
sub test_reset {
empty_database($eav);
my $artists = $eav->resultset('Artist');
$artists->populate([ map { +{ name => 'A'.$_ }} 1..2 ]);
my $c = $artists->search->cursor;
cmp_ok $c->next->{id}, 'eq', $c->reset->next->{id}, 'reset';
}
sub test_first {
empty_database($eav);
my $artists = $eav->resultset('Artist');
$artists->populate([ map { +{ name => 'A'.$_ }} 1..2 ]);
my $c = $artists->search->cursor;
cmp_ok $c->first->{id}, 'eq', $c->first->{id}, 'first resets cursor';
}
t/ecommerce.yml view on Meta::CPAN
Product:
many_to_many: Tag
attributes: [ name, 'price:int', 'description:text' ]
HardDisk:
extends: Product
attributes: [ 'capacity:int', 'rpm:int' ]
Monitor:
extends: Product
attributes: [ resolution, 'contrast_ratio:int' ]
CurvedMonitor:
extends: Monitor
attributes: [ 'angle:int' ]
FancyMonitor:
extends: CurvedMonitor
attributes: [ foobar ]
Tag:
attributes: [ name ]
t/entities.yml view on Meta::CPAN
Artist:
many_to_many: [CD]
has_many:
- [ compositions, Track, composer]
attributes:
- { name: 'name' }
- { name: 'birth_date', type: 'datetime' }
- description:text
- rating:int
CD:
has_many: Track
attributes:
- title
- description:text
- { name: 'review', type: 'text' }
- rating:int
Track:
has_one: Lyric
attributes:
- { name: 'title' }
- { name: 'description', type: 'text' }
- { name: 'duration', type: 'int' }
Lyric:
attributes:
- { name: 'content', type: 'text' }
t/entity-class.t view on Meta::CPAN
#!/usr/bin/perl -w
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::DBIx::EAV;
use DBIx::EAV::Entity;
use My::Entity::Artist;
my $dbh = get_test_dbh;
my $eav = DBIx::EAV->new(
dbh => $dbh,
tenant_id => 42,
entity_namespaces => ['My::Entity'],
resultset_namespaces => ['My::ResultSet'],
);
$eav->schema->deploy( add_drop_table => $eav->schema->db_driver_name eq 'mysql');
subtest 'is_custom_class' => sub {
is 'DBIx::EAV::Entity'->is_custom_class, '';
is 'My::Entity::Artist'->is_custom_class, 1;
};
subtest 'type_definition' => sub {
is 'My::Entity::Artist'->type_definition, {
'attributes' => [
'name',
{ 'name' => 'birth_date', 'type' => 'datetime' },
'description:text',
'rating:int'
],
'many_to_many' => ['CD']
};
};
subtest 'Artist type' => sub {
my $type = $eav->type('Artist');
is $type->name, 'Artist';
ok $type->has_attribute($_) for qw/ name birth_date description rating /;
ok $type->has_relationship('cds');
};
subtest 'CD type' => sub {
my $type = $eav->type('CD');
is $type->name, 'CD';
ok $type->has_attribute($_) for qw/ name /;
ok $type->has_relationship('artists');
};
subtest 'subclass' => sub {
my $type = $eav->type('PopArtist');
is $type->name, 'PopArtist';
ok $type->is_type('PopArtist');
ok $type->is_type('Artist');
ok $type->has_attribute($_) for qw/ pop_name /;
ok $type->has_inherited_attribute($_) for qw/ name birth_date description rating /;
ok $type->has_relationship('cds');
};
subtest 'entity instance class' => sub {
my $artist = $eav->resultset('Artist')->create({ name => 'Bob' });
isa_ok $artist, 'My::Entity::Artist';
is $artist->uc_name, 'BOB';
isa_ok $eav->resultset('Artist'), 'My::ResultSet::Artist';
};
subtest 'inexistent class' => sub {
like dies { $eav->type('Unknown') }, qr/^Can't locate/;
};
done_testing;
#!/usr/bin/perl -w
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::DBIx::EAV;
my $dbh = get_test_dbh;
my $eav = DBIx::EAV->new(
dbh => $dbh,
tenant_id => 42,
static_attributes => [qw/ is_deleted:bool::0 is_active:bool::1 is_published:bool::1 /]
);
$eav->schema->deploy( add_drop_table => $eav->schema->db_driver_name eq 'mysql');
$eav->declare_entities(read_yaml_file("$FindBin::Bin/entities.yml"));
test_common();
test_save();
test_load_attributes();
test_delete();
done_testing;
sub test_common {
my $bob = $eav->resultset('Artist')->new_entity({ name => 'Bob Marley' });
isa_ok $bob, 'DBIx::EAV::Entity';
is $bob->in_storage, '', 'in_storage';
is $bob->raw->{name}, 'Bob Marley', 'get';
is exists $bob->raw->{'rating'}, '', 'get (undef)';
$bob->set('rating', 10);
is $bob->raw->{rating}, 10, 'set($attr, $val)';
$bob->set({ name => 'Robert Marley', rating => 100 });
is $bob->raw, { name => 'Robert Marley', rating => 100 }, 'set(\%attrs)';
}
sub test_save {
diag 'testing save()';
my $bob = $eav->resultset('Artist')->new_entity({ name => 'Bob Marley', rating => 10 });
$bob->save();
is $bob->in_storage, 1, 'in_storage';
is $dbh->selectrow_hashref('SELECT * from eav_entities WHERE id = '.$bob->id),
{
id => $bob->id,
entity_type_id => $eav->type('Artist')->id,
is_published => 1,
is_active => 1,
is_deleted => 0,
},
'entity row';
is $dbh->selectrow_hashref(sprintf 'SELECT value from eav_value_varchar WHERE entity_id = %d AND attribute_id = %d', $bob->id, $bob->type->attribute('name')->{id}),
{ value => 'Bob Marley' },
"'name' attribute row";
is $dbh->selectrow_hashref(sprintf 'SELECT value from eav_value_int WHERE entity_id = %d AND attribute_id = %d', $bob->id, $bob->type->attribute('rating')->{id}),
{ value => 10 },
"'rating' attribute row";
# create with static attributes
diag 'create with static attributes';
my $peter = $eav->resultset('Artist')->new_entity({ name => 'Peter Tosh', is_published => 0 });
$peter->save();
is $dbh->selectrow_hashref('SELECT * from eav_entities WHERE id = '.$peter->id)->{is_published}, 0, 'create with static attrs';
is $dbh->selectrow_hashref(sprintf 'SELECT value from eav_value_varchar WHERE entity_id = %d AND attribute_id = %d', $peter->id, $peter->type->attribute('name')->{id}),
{ value => 'Peter Tosh' },
"'name' attribute row";
# update
$peter->set('name', 'Peter Machintosh')->save;
is $dbh->selectrow_hashref(sprintf 'SELECT value from eav_value_varchar WHERE entity_id = %d AND attribute_id = %d', $peter->id, $peter->type->attribute('name')->{id}),
{ value => 'Peter Machintosh' },
"name updated";
# update static and dynamic attrs
$peter->set({ rating => 10, is_published => 1, is_deleted => 1 })->save;
is $dbh->selectrow_hashref(sprintf 'SELECT value from eav_value_int WHERE entity_id = %d AND attribute_id = %d', $peter->id, $peter->type->attribute('rating')->{id})->{value},
10, "dynamic attr updated";
is $dbh->selectrow_hashref(sprintf 'SELECT is_published, is_deleted from eav_entities WHERE id = %d', $peter->id),
{ is_published => 1, is_deleted => 1 },
"static attrs updated";
# set attr to undef
$peter->set({ rating => undef })->save;
is $dbh->selectrow_hashref(sprintf 'SELECT value from eav_value_int WHERE entity_id = %d AND attribute_id = %d', $peter->id, $peter->type->attribute('rating')->{id}),
undef, "set attr to undef";
$peter->set({ rating => 10 })->save;
is $dbh->selectrow_hashref(sprintf 'SELECT value from eav_value_int WHERE entity_id = %d AND attribute_id = %d', $peter->id, $peter->type->attribute('rating')->{id})->{value},
10, "set undef back to a value";
}
sub test_load_attributes {
diag 'testing load_attributes()';
my $entity = $eav->resultset('Artist')->new_entity({ name => 'Elvis', rating => 10 });
$entity->save();
# sabotate
delete $entity->raw->{name};
delete $entity->raw->{rating};
# load
is $entity->load_attributes, 4, 'load_attributes retval';
is $entity->get('name'), 'Elvis', 'name is there';
is $entity->get('rating'), 10, 'rating is there';
}
sub test_delete {
my $entity = $eav->resultset('Artist')->new_entity({ name => 'Cafe' });
$entity->save();
my $id = $entity->id;
is $entity->delete, 1, 'delete()';
is $dbh->selectrow_hashref('SELECT * from eav_entities WHERE id = '.$id), undef, 'entity row deleted';
is $entity->in_storage, '', 'not in_storage after delete';
}
t/inheritance.t view on Meta::CPAN
#!/usr/bin/perl -w
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::DBIx::EAV;
my $eav = DBIx::EAV->new(
dbh => get_test_dbh, tenant_id => 42,
static_attributes => [qw/ is_deleted:bool::0 is_active:bool::1 is_published:bool::1 /]
);
$eav->schema->deploy( add_drop_table => $eav->schema->db_driver_name eq 'mysql');
$eav->declare_entities(read_yaml_file("$FindBin::Bin/ecommerce.yml"));
my $product = $eav->type('Product');
my $harddisk = $eav->type('HardDisk');
my $monitor = $eav->type('Monitor');
my $curved_monitor = $eav->type('CurvedMonitor');
# parent
is $product->has_parent, '', 'type->has_parent';
is $monitor->has_parent, 1, 'subtype->has_parent';
is $monitor->parent->name, 'Product', 'subtype->parent';
is $curved_monitor->parent->name, 'Monitor', 'subtype2->parent';
is [map { $_->name } $curved_monitor->parents],
[qw/ Monitor Product /], 'parents';
ok $product->is_type('Product'), 'is_type';
ok $monitor->is_type('Product'), 'is_type';
ok $curved_monitor->is_type('Product'), 'is_type';
ok $curved_monitor->is_type('Monitor'), 'is_type';
ok $curved_monitor->is_type('CurvedMonitor'), 'is_type';
# inherited relationship
is $harddisk->relationship('tags')->{id}, $product->relationship('tags')->{id}, 'child type shares parent relationship';
# inherited attributes
is $harddisk->has_inherited_attribute('name'), 1, 'has_inherited_attribute';
is $harddisk->has_own_attribute('capacity'), 1, 'has_own_attribute';
is $harddisk->attribute('name')->{id}, $product->attribute('name')->{id}, 'child type1 shares attr1 with parent type';
is $harddisk->attribute('description')->{id}, $product->attribute('description')->{id}, 'child type1 shares attr2 with parent type';
is $monitor->attribute('name')->{id}, $product->attribute('name')->{id}, 'child type2 shares attr1 with parent type';
is $monitor->attribute('description')->{id}, $product->attribute('description')->{id}, 'child type2 shares attr2 with parent type';
is $curved_monitor->attribute('name')->{id}, $product->attribute('name')->{id}, 'child type3 shares attr1 with root parent type';
is $curved_monitor->attribute('description')->{id}, $product->attribute('description')->{id}, 'child type3 shares attr2 with root parent type';
is $curved_monitor->attribute('resolution')->{id}, $monitor->attribute('resolution')->{id}, 'child type3 shares attr1 with parent type';
is $curved_monitor->attribute('contrast_ratio')->{id}, $monitor->attribute('contrast_ratio')->{id}, 'child type3 shares attr2 with parent type';
is [sort $harddisk->attributes( names => 1 )],
[qw/ capacity description entity_type_id id is_active is_deleted is_published name price rpm /],
'attributes( names => 1)';
# inheritance table
ok $eav->table('type_hierarchy')->select_one({ parent_type_id => $product->id, child_type_id => $harddisk->id }), 'harddisk entry on hierarchy table';
ok $eav->table('type_hierarchy')->select_one({ parent_type_id => $product->id, child_type_id => $monitor->id }), 'monitor entry on hierarchy table';
ok $eav->table('type_hierarchy')->select_one({ parent_type_id => $monitor->id, child_type_id => $curved_monitor->id }), 'curvedmonitor entry on hierarchy table';
# populate
my @tags = $eav->resultset('Tag')->populate([map { +{ name => 'Tag'.$_ } } 1..3 ]);
$eav->resultset('HardDisk')->populate([
{ name => 'HardDisk1', price => 100, capacity => 1000, tags => \@tags },
{ name => 'HardDisk2', price => 200, capacity => 2000, tags => \@tags },
{ name => 'HardDisk3', price => 300, capacity => 3000, tags => \@tags }
]);
$eav->resultset('Monitor')->populate([
{ name => 'Monitor1', price => 100, contrast_ratio => 10000, tags => \@tags },
{ name => 'Monitor2', price => 200, contrast_ratio => 20000, tags => \@tags },
{ name => 'Monitor3', price => 300, contrast_ratio => 30000, tags => \@tags }
]);
$eav->resultset('CurvedMonitor')->populate([
{ name => 'CurvedMonitor1', price => 100, contrast_ratio => 10000, angle => 10000 },
{ name => 'CurvedMonitor2', price => 200, contrast_ratio => 20000, angle => 20000 },
{ name => 'CurvedMonitor3', price => 300, contrast_ratio => 30000, angle => 30000 }
]);
$eav->resultset('FancyMonitor')->populate([
{ name => 'FancyMonitor1', price => 100 },
{ name => 'FancyMonitor2', price => 200 },
{ name => 'FancyMonitor3', price => 300 }
]);
# find subproducts
my $products = $eav->resultset('Product');
my @result = $products->search({ price => { '>' => 200 } }, { order_by => 'name', subtype_depth => 1 })->all;
is [map { $_->get('name') } @result], [qw/ HardDisk3 Monitor3 /], 'find subtypes';
is $result[0]->type->name, 'HardDisk', 'result item0 inflated to correct subtype';
@result = $products->search({ price => { '>' => 200 } }, { order_by => 'name', subtype_depth => 2 })->all;
is [map { $_->get('name') } @result], [qw/ CurvedMonitor3 HardDisk3 Monitor3 /], 'find subtypes depth 2';
@result = $products->search({ price => { '>' => 200 } }, { order_by => 'name', subtype_depth => 3 })->all;
is [map { $_->get('name') } @result], [qw/ CurvedMonitor3 FancyMonitor3 HardDisk3 Monitor3 /], 'find subtypes depth 3';
# resultset->delete on subtype
$eav->resultset('Monitor')->delete;
my $hd = $eav->resultset('HardDisk')->search->next;
is $hd->get('name'), 'HardDisk1', 'resultset->delete keeps sibiling attrs';
my $cm = $eav->resultset('CurvedMonitor')->search->next;
is $cm->get('contrast_ratio'), 10000, 'resultset->delete keeps subtype attrs';
is $hd->get('tags')->count, 3, 'resultset->delete on subtype (rels)';
done_testing;
t/lib/My/Entity/Artist.pm view on Meta::CPAN
package My::Entity::Artist;
use Moo;
BEGIN { extends 'DBIx::EAV::Entity' }
__PACKAGE__->attribute('name');
__PACKAGE__->attribute({ name => 'birth_date', type => 'datetime' });
__PACKAGE__->attribute('description:text');
__PACKAGE__->attribute('rating:int');
__PACKAGE__->many_to_many('CD');
sub uc_name {
uc shift->get('name');
}
1;
t/lib/My/Entity/CD.pm view on Meta::CPAN
package My::Entity::CD;
use Moo;
BEGIN { extends 'DBIx::EAV::Entity' }
__PACKAGE__->attribute('name');
1;
t/lib/My/Entity/PopArtist.pm view on Meta::CPAN
package My::Entity::PopArtist;
use Moo;
BEGIN { extends 'My::Entity::Artist' }
__PACKAGE__->attribute('pop_name');
1;
t/lib/My/ResultSet/Artist.pm view on Meta::CPAN
package My::ResultSet::Artist;
use Moo;
extends 'DBIx::EAV::ResultSet';
1;
t/lib/Test/DBIx/EAV.pm view on Meta::CPAN
package Test::DBIx::EAV;
use strict;
use warnings;
use DBI;
use FindBin;
use parent qw(Exporter);
use Test2::Bundle::Extended;
use Data::Dumper;
use lib 'lib';
use DBIx::EAV;
use YAML;
our @EXPORT = (
@Test2::Bundle::Extended::EXPORT,
qw/ Dumper get_test_dbh empty_database read_file read_yaml_file /
);
our @EXPORT_OK = (
@Test2::Bundle::Extended::EXPORT_OK,
qw/ /
);
sub import {
my ($pkg) = @_;
# modern perl
$_->import for qw(strict warnings utf8);
feature->import(':5.10');
# our stuff, via Exporter::export_to_level
$pkg->export_to_level(1, @_);
}
sub empty_database {
my $eav = shift;
$eav->table('entity_relationships')->delete;
$eav->table('value_'.$_)->delete for @{$eav->schema->data_types};
$eav->table('entities')->delete;
}
sub get_test_dbh {
my (%options) = @_;
my $driver = $ENV{TEST_DBIE_MYSQL} ? 'mysql' : 'SQLite';
my $dbname = $driver eq 'mysql' ? $ENV{TEST_DBIE_MYSQL} : ':memory:';
my $dbh = DBI->connect("dbi:$driver:dbname=$dbname",
$ENV{TEST_DBIE_MYSQL_USER},
$ENV{TEST_DBIE_MYSQL_PASSWORD});
$dbh->{sqlite_see_if_its_a_number} = 1;
$dbh;
}
sub read_file {
my $filename = shift;
open my $fh, '<', $filename or die "$!";
return join '', <$fh>;
}
sub read_yaml_file {
Load(read_file(shift))
}
1;
( run in 0.765 second using v1.01-cache-2.11-cpan-73692580452 )