A while ago I found out from a post that Dbix::Class Perls default ORM is abandoned dbixclass not updated. So I started to look around to see what else is out there on metacpan and can be used as an alternative.
This is how I found Rose::DB an ridiculously fast and fun ORM.
In this post I plan to show to you how get started with this.
The first step is to create a DB for this I will use SQLite.
So lets start by installing dependenceies:
# install sqlite3
sudo apt install sqlite3
# verify Installation
sqlite3 --version
cpanm Rose::DB
cpanm Rose::DB::Object
cpanm Rose::DB::Object::Manager
Now create a lib directory an place in it a file namedDB.pm with the following content:
package DB;
use strict;
use warnings;
use Rose::DB;
use base qw(Rose::DB);
# Use a private registry for this class
__PACKAGE__->use_private_registry;
# Register your lone data source using the default 'main' and domain 'development'
__PACKAGE__->register_db(
domain => 'development',
type => 'main',
driver => 'sqlite',
database => './file.db',
connect_options =>
{
RaiseError => 1,
AutoCommit => 1,
PrintError => 0,
sqlite_trace => 1,
}
);
1;
At this point we can use the DB.pm package to build our database.
So create a db file and to it this content:
use strict;
use warnings;
use lib 'lib';
use DB;
my $db = DB->new(domain => 'development', type => 'main');
my $sql_media_type = <<"SQL";
CREATE TABLE IF NOT EXISTS media_types (
id INTEGER PRIMARY KEY,
media_type VARCHAR(10) NOT NULL
);
SQL
my $sql_license = <<"SQL";
CREATE TABLE IF NOT EXISTS licenses (
id INTEGER PRIMARY KEY,
name VARCHAR(255) NOT NULL,
allows_commercial BOOLEAN NOT NULL
);
SQL
my $sql_media = <<"SQL";
CREATE TABLE IF NOT EXISTS media (
id INTEGER PRIMARY KEY,
name VARCHAR(255) NOT NULL,
location VARCHAR(255) NOT NULL,
source VARCHAR(511) NOT NULL,
attribution VARCHAR(255) NOT NULL,
media_type_id INTEGER NOT NULL,
license_id INTEGER NOT NULL,
FOREIGN KEY (media_type_id) REFERENCES media_types(id),
FOREIGN KEY (license_id)
REFERENCES licenses(id)
);
SQL
# create db;
$db->dbh->do($sql_media_type) or die $db->dbh->errstr;
$db->dbh->do($sql_license) or die $db->dbh->errstr;
$db->dbh->do($sql_media) or die $db->dbh->errstr;
Now the db is created we need to define the DB objects and insert some data to play around with it. So we need to created this files structure:
── lib
├── DB
├── Licenses.pm
├── Media.pm
└── Media_Types.pm
Each class corresponds to a table and we need to add the code to make this work for each of them. So lets start:
package DB::Media;
use strict;
use warnings;
use DB;
use base qw(Rose::DB::Object);
my $db = DB->new(domain => 'development', type => 'main');
__PACKAGE__->meta->setup
(
table => 'media',
columns => [
id => { type => 'serial', primary_key => 1 },
name => { type => 'varchar', length => 255 },
location => { type => 'varchar', length => 255 },
source => { type => 'varchar', length => 511 },
attribution => { type => 'varchar', length => 255 },
media_type_id => { type => 'integer' },
license_id => { type => 'integer' },
],
relationships => [
media_type => {
type => 'one to one',
class => 'DB::Media_Types',
column_map => { media_type_id => 'id' },
},
licenses => {
type => 'one to one',
class => 'DB::Licenses',
# media.media_id -> license.id
column_map => { license_id => 'id' },
},
]
);
sub init_db { $db };
package DB::Licenses;
use strict;
use warnings;
use DB;
use base qw(Rose::DB::Object);
my $db = DB->new(domain => 'development', type => 'main');
__PACKAGE__->meta->setup
(
table => 'licenses',
columns => [
id => { type => 'serial', primary_key => 1 },
name => { type => 'varchar', length => 255 },
allows_commercial => { type => 'varchar', length => 255 },
],
relationships => [
licenses => {
type => 'one to many',
class => 'DB::Media',
# licenses.id -> media.license_id
column_map => { id => 'license_id' },
},
]
);
sub init_db { $db };
1;
package DB::Media_Types;
use strict;
use warnings;
use DB;
use base qw(Rose::DB::Object);
my $db = DB->new(domain => 'development', type => 'main');
__PACKAGE__->meta->setup
(
table => 'media_types',
columns => [
id => { type => 'serial', primary_key => 1 },
media_type => { type => 'varchar', length => 10 },
],
relationships => [
media_type => {
type => 'one to many',
class => 'DB::Media',
column_map => { id => 'media_type_id' },
},
]
);
sub init_db { $db };
1;
With this step done we can start to insert data into our tables using this script:
use strict;
use warnings;
use lib 'lib';
use DB::Media_Types;
use DB::Licenses;
use DB::Media;
my @types = qw(video audio image);
my %media_type_id_for;
my %license_id_for;
foreach my $media (@types) {
my $media_obj = DB::Media_Types->new(media_type => $media);
$media_obj->save();
$media_type_id_for{$media} = $media_obj->id();
}
my @licenses =
(['Public Domain', 1], ['Attribution CC BY', 1], ['Attribution CC BY-SA', 1], ['Attribution-NonCommercial CC BY-NC', 0],);
foreach my $license (@licenses) {
my $license_obj = DB::Licenses->new(
name => $license->[0],
allows_commercial => $license->[1]
);
$license_obj->save();
$license_id_for{$license->[0]} = $license_obj->id();
}
my @media = ([
'Anne Frank Stamp',
'/data/images/anne_fronk_stamp.jpg',
'http://commons.wikimedia.org/wiki/File:Anne_Frank_stamp.jpg',
'Deutsche Post',
$media_type_id_for{'image'},
$license_id_for{'Public Domain'},
],
[
'Clair de Lune',
'/data/audio/claire_de_lune.ogg',
'http://commons.wikimedia.org/wiki/File:Sonate_Clair_de_lune.ogg',
'Schwarzer Stern',
$media_type_id_for{'audio'},
$license_id_for{'Public Domain'},
],
);
foreach my $media (@media) {
my $media_record_object = DB::Media->new(
name => $media->[0],
location => $media->[1],
source => $media->[2],
attribution => $media->[3],
media_type_id => $media->[4],
license_id => $media->[5],
);
$media_record_object->save();
}
With data inserted into our data base we can now try a select:
use strict;
use warnings;
use Data::Dumper;
use lib 'lib';
use feature 'say';
use DB::Media;
my $media = DB::Media->new(id => 1);
$media->load or die $media->error;
say "Media Name: ", $media->name;
say "Media Type: ", $media->media_type->media_type();
say "Allows_commercial: ", $media->licenses->allows_commercial();
Please notice how the Media object has access to data from media_type and licenses table.
In the background it will run this queries to fetch the data
SELECT id, name, location, source, attribution, media_type_id, license_id FROM media WHERE id = 1
SELECT id, media_type FROM media_types WHERE id = 3
SELECT id, name, allows_commercial FROM licenses WHERE id = 1
How ever the recommended approach is to created an manger class.
package DB::Media::Manager;
use strict;
use warnings;
use base 'Rose::DB::Object::Manager';
sub object_class { 'DB::Media' };
__PACKAGE__->make_manager_methods('media');
1;
This class will open your add to your code the following methods:
get_products
get_products_iterator
get_products_count
update_products
delete_products
This will also allow to create more complicated queries:
my $products = DB::Media::Manager->get_media(
with_objects => [ 'media_type', 'licenses' ],
query => [
't2.id' => 2,
]
);
This will result in this select:
SELECT
t1.id,
t1.name,
t1.location,
t1.source,
t1.attribution,
t1.media_type_id,
t1.license_id,
t2.id,
t2.media_type,
t3.id,
t3.name,
t3.allows_commercial
FROM
media t1
LEFT OUTER JOIN media_types t2 ON
(t1.media_type_id = t2.id)
LEFT OUTER JOIN licenses t3 ON
(t1.license_id = t3.id)
WHERE
t2.id = 2
Bibliography
- Beginning Perl by Curtis 'Ovid' Poe
- Rose::DB
- Rose::DB::Object
Top comments (11)
DBIx::Class is doing just fine, and is still being used in many production environments. You can get lots of support from its mailing list (lists.perl.org/list/dbix-class.html) or on irc (irc.perl.org #dbix-class). Please don't spread FUD.
DBIx::Class still works and its used by a lot of people and I get that. How ever it has a a bus factor of 0 on metacpan this is a fact. This is means that at some point some it needs some kind of community response. Until that happens a lot of projects will look for alternatives ORMS. If you have any way to reach to Peter Rabbitson (RIBASUSHI) and convince him to address by either accepting Ovid proposal or doing the work him self this please do so. I would be very happy to see DBIx::Class maintained again.
The bus factor on MetaCPAN is not a fact, it’s a heuristic, which, as we know, is a fancy way of saying that it doesn’t work. Namely, it is based on whether the author has released anything to CPAN in 2 years. This is not a bad heuristic for “is the author going to be around and responsive if new problems crop up that need fixing” – it just doesn’t actually tell you whether the author is in fact going to be around and responsive if new problems crop up that need fixing. It only tells you whether they have released anything in the last two years.
In the case of RIBASUSHI, he very much is still around in case something actually important needs done, e.g. not long ago when a tentative upcoming change in Perl itself would have required action on his part. The change in Perl will happen in a different way which will not require action on his part, so MetaCPAN will continue to regard him as “inactive”, regardless of the fact that he was and continues to be ready to keep the distribution in good working order.
So if you see “bus factor 0”, you can’t turn off your judgement and just take it as fact.
Just because a distribution isn’t making its users constantly make lots of changes to their code doesn’t mean it’s unreliable, in fact it means the opposite.
Please read this thread:
reddit.com/r/perl/comments/1eddi9n...
Yes, that thread is ultimately why I’m posting here. That’s just Ovid’s opinion, not fact. He is not the maintainer (who is a known quantity with a proven record of fixing actual problems), just a user with big ideas (who is free to talk a big game as long as he has no track record). A version of what he is proposing was tried before and only caused problems while “solving” nothing (not that anything needed solving; it was all down to a fundamental misunderstanding of RIBASUSHI’s position). DBIC has a long and bitter history of other people coming in to fix what isn’t broken, to the point that it was even the impetus for having a formal written PAUSE Operating Model. Years after all of that went down, along comes Ovid and tries to beat the same dead horse all over again, expecting different results; let’s just say I’m not a fan.
It Ovid’s opinion backed by Dave Cross, Brian D'Foy and to some extent John Napiorkowski jugging by the comments on facebook
The fact is that DBIx::Class has 63 open pull requests and 130 open issues. Instead of being upset with me for signalling this you should address this to RIBASUSHI.
Ask him directly and plainly if it has any plans to address this.
I (brian d foy, no punctuation) certainly don't back Ovid's opinion, but I'm also not sure which opinion you think I'm backing.
For this, you might be referring to reddit.com/r/perl/comments/1eddi9n... , but my position there is that I understand ribasushi's position.
As I noted in my comment, anyone qualified to take over DBIx::Class could have forked it already. Yet, nobody has. If Ovid really wanted to handle this, he could have without asking anyone's permission.
Very sorry for the typo in your name I did no mean to offend. When I read you comment I understand this things:
If you are looking for alternative ORMs in Perl, see also metacpan.org/pod/DBIx::DataModel (shameless self-promotion)
It reminds me of my post on similar topic published in the year 2011.
blogs.perl.org/users/mohammad_s_an...
It seems that this post has had the ability to get the bus moving. Whether it moves a lot or a little is something that will have to be waited for. Good article in any case.