Rose::DB ORM and Perl
#perl#orm
DragosTrif

DragosTrif @dragostrif

Location:
Cluj-Napoca, Romania
Joined:
Jul 17, 2021

Rose::DB ORM and Perl

Publish Date: Jan 12
5 11

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
Enter fullscreen mode Exit fullscreen mode

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;
Enter fullscreen mode Exit fullscreen mode

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;
Enter fullscreen mode Exit fullscreen mode

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
Enter fullscreen mode Exit fullscreen mode

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 };
Enter fullscreen mode Exit fullscreen mode 
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;
Enter fullscreen mode Exit fullscreen mode 
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;
Enter fullscreen mode Exit fullscreen mode

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();
}
Enter fullscreen mode Exit fullscreen mode

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();
Enter fullscreen mode Exit fullscreen mode

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
Enter fullscreen mode Exit fullscreen mode

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;
Enter fullscreen mode Exit fullscreen mode

This class will open your add to your code the following methods:


get_media
get_media_iterator
get_media_count
update_media
delete_media
Enter fullscreen mode Exit fullscreen mode

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,
    ]
);
Enter fullscreen mode Exit fullscreen mode

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
Enter fullscreen mode Exit fullscreen mode

Bibliography

  1. Beginning Perl by Curtis 'Ovid' Poe
  2. Rose::DB
  3. Rose::DB::Object

Comments 11 total

  • Mohammad S Anwar
    Mohammad S AnwarJan 12, 2025

    It reminds me of my post on similar topic published in the year 2011.
    blogs.perl.org/users/mohammad_s_an...

  • Laurent Dami
    Laurent DamiJan 13, 2025

    If you are looking for alternative ORMs in Perl, see also metacpan.org/pod/DBIx::DataModel (shameless self-promotion)

  • Karen Etheridge
    Karen EtheridgeJan 13, 2025

    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.

    • DragosTrif
      DragosTrifJan 14, 2025

      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.

      • Aristotle Pagaltzis
        Aristotle PagaltzisJan 14, 2025

        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.

        • DragosTrif
          DragosTrifJan 14, 2025

          Please read this thread:
          reddit.com/r/perl/comments/1eddi9n...

          • Aristotle Pagaltzis
            Aristotle PagaltzisJan 14, 2025

            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.

            • DragosTrif
              DragosTrifJan 15, 2025

              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.

              • brian d foy
                brian d foyJan 16, 2025

                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.

                • DragosTrif
                  DragosTrifJan 16, 2025

                  Very sorry for the typo in your name I did no mean to offend. When I read you comment I understand this things:

                  1. That ribasushi's position deserves some understating.
                  2. Even though you understand his position you do not think his necessarily right.
                  3. DBIx::Class has a real problem which specific to large open source projects which span over long periods of time (this the I part think you agree with from Ovid's initial blog).
  • Miguel Prz
    Miguel PrzJan 15, 2025

    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.

Add comment