Copyright Notice

This text is copyright by InfoStrada Communications, Inc., and is used with their permission. Further distribution or use is not permitted.

This text has appeared in an edited form in Linux Magazine magazine. However, the version you are reading here is as the author originally submitted the article for publication, not after their editors applied their creativity.

Please read all the information in the table of contents before using this article.
Download this listing!

Linux Magazine Column 87 (Nov 2006)

[suggested title: ``Setting up Rose::DB::Object Metadata'']

Last month, I introduced Rose::DB::Object as the current ``best of breed'' Object-Relational mappers, allowing Perl programmers to avoid nearly all the boring routine SQL crafting. This month, I'll continue my presentation, by showing a simple database and how to set up the metadata of Rose::DB::Object so that proper accesses may be made.

My example is a common one: a list of films, the people involved in making them, and the studios that produce the films. To keep it simple, I've discarded most of the unique-to-a-row data, keeping only a representative sample along with the linking columns.

Thus for each person, I'll use a name, birthdate, and a unique identifier (to distinguish name collisions). Each film will have only a title and release date along with its unique identifier. To show that we don't need to create unique identifiers for everything, we'll use the studio name as its own natural primary key.

Of course, unrelated data is uninteresting, so I'll include the roles that each person played on a film (possibly more than one), including both a broad category (actor, director) along with specific details (the name of the character for an actor, for example).

For film-to-studio mapping, I'll use a minimal many-to-many mapping table consisting entirely of the two foreign key columns, and name it in such a way that Rose::DB::Object will provide some additional support.

To begin my exploration, I created the minimal support structure for Rose::DB::Object to understand my database, which I included in [Listing one, below].

Lines 6 through 9 create the My::RDBO class, which will be used as the base class for all of my Rose::DB::Object classes. These classes represent a single row of the database. For each class, I'll also have a class with ::Manager appended to perform tasks that are related to the table as a whole. In this case, the only needed information piece is how to create a Rose::DB-derived object if one isn't provided. The init_db method returns a new My::RDB object, defined in the remainder of this code snippet.

I fake up an entry in %INC for this class because apparently Rose::DB tries to require My::RDBO, even though the class is already defined. The %INC mangling keeps this from being an error. Of course, by the time you read this, John Siracusa will likely have also read this and fixed Rose::DB to no longer trigger an error on that.

Line 15 sets up the name of the SQLite file that I'll be using for my testing, by concatenating the name of this file with .sqlite. Lines 17 to 20 define the default database parameters, including this just-computed name.

Lines 22 to 24 initialize this database unless the database already exists. I've added 0 and for testing, causing the database to be always initialized while I was changing the database schema.

Lines 26 to 67 describe how to initialize the database. For an SQLite database, we merely need to remove the single database file, and then connect to the database and issue the appropriate DDL statements.

Line 28 creates the My::RDB object. This object maintains the metadata about the desired database. For example, in line 29 we can verify that this is indeed the SQLite database that we defined earlier (or at least some SQLite database). Line 30 removes the existing database.

Lines 31 to 33 create a DBI database handle, commonly called $dbh in the DBI documentation, and set it up to be quiet on errors, because we'll be printing our own errors. Lines 34 and 35 (and the subsequent ``here'' document) provide the DDL to create the tables. Each blank-line-separated statement is executed independently, aborting the entire process on failure.

Lines 36 to 65 define the five tables, using standard SQL (as understood by SQLite). The tables and columns follow the default naming conventions of Rose::DB::Object::ConventionManager, which makes it easy for us to automatically extract the metadata, starting in line 69.

The true value of the string "use loader" triggers the Rose::DB::Object::Loader as the means of providing the metadata. Lines 71 to 75 create the loader, again defining the minimal overrides for the defaults to match our scenario. Line 76 triggers the probing, resulting in metadata for the five tables and the corresponding 10 classes (five for the rows, and five for the tables). The resulting 10-element list ends up in @classes.

At this point, we could begin creating rows and soliciting queries against the database. However, to see the handiwork that the probing has generated, we'll continue into line 78, which loops over each created class to dump the equivalent Perl code for the metadata. The result of that output (from running the program) is in [listing two, below].

Ultimately, we can capture that Perl text into the correct modules (using make_modules instead of make_classes), and completely avoid the probing step. In the long run, this is the best strategy, but for rapid development, letting the metadata come from probing the database provides the best flexibility.

As we look at each of the generated classes, we can see how the metadata corresponds to the table schema. For example, in lines 2 to 28, we see that My::RDBO::Person describes the persons table (as noted in line 9). The three columns are described in lines 11 to 15, along with their type. Rose::DB::Object provides special support for date-type columns, pulling in the DateTime modules for easy manipulation. Line 17 correctly labels the id column as the primary key for this table.

Lines 20 to 23 describe the roles relationship. As the loader pieces together the foreign keys, it can discover the classic ``one to many'', ``many to one'', and (under certain circumstances) ``many to many'' relationships. This means that we can call the roles method on a person object, and we'll get back a list of the roles that they played as a series of roles objects. This request is translated into a database call to find all rows of the roles table that refer to the person table. We also get an add_roles method to add to the existing roles.

The My::RDBO::Person::Manager class comes next in lines 30 to 40. The make_manager_methods call defines a number of class-specific methods, such as delete_persons, get_persons, get_persons_count, and update_persons, to provide table-wide queries and updates.

Similarly, the My::RDBO::Film class defined in lines 43 to 78. And like the persons table, we have a ``one to many'' relationship with the roles table (lines 61 to 65). However, we also see the discovered many-to-many mapping with the studios table, described in lines 67 to 74. With this mapping, we get direct support for adding and deleting any arbitrary connections between films and studios as needed, as well as simple queries in both directions.

The My::RDBO::Role class is defined in lines 93 to 125. This table has foreign keys, which are described in lines 112 to 122. Calling film returns the appropriate film row object by linking through the film_id column, with person working similarly.

The My::RDBO::Studio class (lines 140 to 167) also participates in a many-to-many mapping, which we've already seen described in the film table class.

Finally, My::RDBO::FilmStudioMap (lines 182 to 211) completes the description, defining the foreign keys as needed.

That's about all I have room for in this month's installment. Next month, I'll show some code that uses the resulting classes to create, report on, update, and delete our table rows. Until then, enjoy!

Listings

        =0=     ##### LISTING ONE #####
        =1=     #!/usr/bin/perl
        =2=     use strict;
        =3=     use warnings;
        =4=     
        =5=     BEGIN {
        =6=       package My::RDBO; $INC{"My/RDBO.pm"} = __FILE__;
        =7=       use base qw(Rose::DB::Object);
        =8=       sub init_db { shift; My::RDB->new }
        =9=     }
        =10=    
        =11=    BEGIN {
        =12=      package My::RDB; $INC{"My/RDB.pm"} = __FILE__;
        =13=      use base qw(Rose::DB);
        =14=    
        =15=      our $FILENAME = __FILE__ . ".sqlite";
        =16=    
        =17=      __PACKAGE__->register_db
        =18=        (driver => 'sqlite',
        =19=         database => $FILENAME,
        =20=        );
        =21=    
        =22=      unless (0 and -f $FILENAME) {
        =23=        __PACKAGE__->initialize_database;
        =24=      }
        =25=    
        =26=      sub initialize_database {
        =27=        my $class = shift;
        =28=        my $db = $class->new;
        =29=        die unless $db->driver eq "sqlite";
        =30=        unlink $db->database;
        =31=        my $dbh = $db->dbh;
        =32=        $dbh->{RaiseError} = 0;
        =33=        $dbh->{PrintError} = 0;
        =34=        $dbh->do($_) or die "$DBI::errstr
        =35=          for $_" for split /\n{2,}/, <<'END_OF_SQL';
        =36=    CREATE TABLE persons (
        =37=      id INTEGER PRIMARY KEY AUTOINCREMENT,
        =38=      name TEXT,
        =39=      birthdate DATE
        =40=    )
        =41=    
        =42=    CREATE TABLE films (
        =43=      id INTEGER PRIMARY KEY AUTOINCREMENT,
        =44=      title TEXT,
        =45=      release_date DATE
        =46=    )
        =47=    
        =48=    CREATE TABLE roles (
        =49=      id INTEGER PRIMARY KEY AUTOINCREMENT,
        =50=      person_id INTEGER REFERENCES persons(id),
        =51=      film_id INTEGER REFERENCES films(id),
        =52=      category TEXT,
        =53=      detail TEXT
        =54=    )
        =55=    
        =56=    CREATE TABLE studios (
        =57=      name TEXT PRIMARY KEY
        =58=    )
        =59=    
        =60=    CREATE TABLE film_studio_map (
        =61=      film_id INTEGER REFERENCES films(id),
        =62=      studio_name TEXT REFERENCES studios(name),
        =63=      PRIMARY KEY (film_id, studio_name)
        =64=    )
        =65=    
        =66=    END_OF_SQL
        =67=      }
        =68=    
        =69=      if ("use loader") {
        =70=        require Rose::DB::Object::Loader;
        =71=        my $loader = Rose::DB::Object::Loader->new
        =72=          (db_class => __PACKAGE__,
        =73=           base_class => 'My::RDBO',
        =74=           class_prefix => 'My::RDBO',
        =75=          );
        =76=        my @classes = $loader->make_classes;
        =77=    
        =78=        if ("show resulting classes") {
        =79=          foreach my $class (@classes) {
        =80=            print "#" x 70, "\n";
        =81=            if ($class->isa('Rose::DB::Object')) {
        =82=              print $class->meta->perl_class_definition;
        =83=            } else {                # Rose::DB::Object::Manager subclasses
        =84=              print $class->perl_class_definition, "\n";
        =85=            }
        =86=          }
        =87=        }
        =88=      }
        =89=    }
        =0=     ##### LISTING TWO #####
        =1=     ######################################################################
        =2=     package My::RDBO::Person;
        =3=     
        =4=     use strict;
        =5=     
        =6=     use base qw(My::RDBO);
        =7=     
        =8=     __PACKAGE__->meta->setup(
        =9=         table   => 'persons',
        =10=    
        =11=        columns => [
        =12=            id        => { type => 'integer' },
        =13=            name      => { type => 'text' },
        =14=            birthdate => { type => 'date' },
        =15=        ],
        =16=    
        =17=        primary_key_columns => [ 'id' ],
        =18=    
        =19=        relationships => [
        =20=            roles => {
        =21=                class      => 'My::RDBO::Role',
        =22=                column_map => { id => 'person_id' },
        =23=                type       => 'one to many',
        =24=            },
        =25=        ],
        =26=    );
        =27=    
        =28=    1;
        =29=    ######################################################################
        =30=    package My::RDBO::Person::Manager;
        =31=    
        =32=    use base qw(Rose::DB::Object::Manager);
        =33=    
        =34=    use My::RDBO::Person;
        =35=    
        =36=    sub object_class { 'My::RDBO::Person' }
        =37=    
        =38=    __PACKAGE__->make_manager_methods('persons');
        =39=    
        =40=    1;
        =41=    
        =42=    ######################################################################
        =43=    package My::RDBO::Film;
        =44=    
        =45=    use strict;
        =46=    
        =47=    use base qw(My::RDBO);
        =48=    
        =49=    __PACKAGE__->meta->setup(
        =50=        table   => 'films',
        =51=    
        =52=        columns => [
        =53=            id           => { type => 'integer' },
        =54=            title        => { type => 'text' },
        =55=            release_date => { type => 'date' },
        =56=        ],
        =57=    
        =58=        primary_key_columns => [ 'id' ],
        =59=    
        =60=        relationships => [
        =61=            roles => {
        =62=                class      => 'My::RDBO::Role',
        =63=                column_map => { id => 'film_id' },
        =64=                type       => 'one to many',
        =65=            },
        =66=        
        =67=            studios => {
        =68=                column_map    => { film_id => 'id' },
        =69=                foreign_class => 'My::RDBO::Studio',
        =70=                map_class     => 'My::RDBO::FilmStudioMap',
        =71=                map_from      => 'film',
        =72=                map_to        => 'studio',
        =73=                type          => 'many to many',
        =74=            },
        =75=        ],
        =76=    );
        =77=    
        =78=    1;
        =79=    ######################################################################
        =80=    package My::RDBO::Film::Manager;
        =81=    
        =82=    use base qw(Rose::DB::Object::Manager);
        =83=    
        =84=    use My::RDBO::Film;
        =85=    
        =86=    sub object_class { 'My::RDBO::Film' }
        =87=    
        =88=    __PACKAGE__->make_manager_methods('films');
        =89=    
        =90=    1;
        =91=    
        =92=    ######################################################################
        =93=    package My::RDBO::Role;
        =94=    
        =95=    use strict;
        =96=    
        =97=    use base qw(My::RDBO);
        =98=    
        =99=    __PACKAGE__->meta->setup(
        =100=       table   => 'roles',
        =101=   
        =102=       columns => [
        =103=           id        => { type => 'integer' },
        =104=           person_id => { type => 'integer' },
        =105=           film_id   => { type => 'integer' },
        =106=           category  => { type => 'text' },
        =107=           detail    => { type => 'text' },
        =108=       ],
        =109=   
        =110=       primary_key_columns => [ 'id' ],
        =111=   
        =112=       foreign_keys => [
        =113=           film => {
        =114=               class       => 'My::RDBO::Film',
        =115=               key_columns => { film_id => 'id' },
        =116=           },
        =117=       
        =118=           person => {
        =119=               class       => 'My::RDBO::Person',
        =120=               key_columns => { person_id => 'id' },
        =121=           },
        =122=       ],
        =123=   );
        =124=   
        =125=   1;
        =126=   ######################################################################
        =127=   package My::RDBO::Role::Manager;
        =128=   
        =129=   use base qw(Rose::DB::Object::Manager);
        =130=   
        =131=   use My::RDBO::Role;
        =132=   
        =133=   sub object_class { 'My::RDBO::Role' }
        =134=   
        =135=   __PACKAGE__->make_manager_methods('roles');
        =136=   
        =137=   1;
        =138=   
        =139=   ######################################################################
        =140=   package My::RDBO::Studio;
        =141=   
        =142=   use strict;
        =143=   
        =144=   use base qw(My::RDBO);
        =145=   
        =146=   __PACKAGE__->meta->setup(
        =147=       table   => 'studios',
        =148=   
        =149=       columns => [
        =150=           name => { type => 'text' },
        =151=       ],
        =152=   
        =153=       primary_key_columns => [ 'name' ],
        =154=   
        =155=       relationships => [
        =156=           films => {
        =157=               column_map    => { studio_name => 'name' },
        =158=               foreign_class => 'My::RDBO::Film',
        =159=               map_class     => 'My::RDBO::FilmStudioMap',
        =160=               map_from      => 'studio',
        =161=               map_to        => 'film',
        =162=               type          => 'many to many',
        =163=           },
        =164=       ],
        =165=   );
        =166=   
        =167=   1;
        =168=   ######################################################################
        =169=   package My::RDBO::Studio::Manager;
        =170=   
        =171=   use base qw(Rose::DB::Object::Manager);
        =172=   
        =173=   use My::RDBO::Studio;
        =174=   
        =175=   sub object_class { 'My::RDBO::Studio' }
        =176=   
        =177=   __PACKAGE__->make_manager_methods('studios');
        =178=   
        =179=   1;
        =180=   
        =181=   ######################################################################
        =182=   package My::RDBO::FilmStudioMap;
        =183=   
        =184=   use strict;
        =185=   
        =186=   use base qw(My::RDBO);
        =187=   
        =188=   __PACKAGE__->meta->setup(
        =189=       table   => 'film_studio_map',
        =190=   
        =191=       columns => [
        =192=           film_id     => { type => 'integer' },
        =193=           studio_name => { type => 'text' },
        =194=       ],
        =195=   
        =196=       primary_key_columns => [ 'film_id', 'studio_name' ],
        =197=   
        =198=       foreign_keys => [
        =199=           film => {
        =200=               class       => 'My::RDBO::Film',
        =201=               key_columns => { film_id => 'id' },
        =202=           },
        =203=       
        =204=           studio => {
        =205=               class       => 'My::RDBO::Studio',
        =206=               key_columns => { studio_name => 'name' },
        =207=           },
        =208=       ],
        =209=   );
        =210=   
        =211=   1;
        =212=   ######################################################################
        =213=   package My::RDBO::FilmStudioMap::Manager;
        =214=   
        =215=   use base qw(Rose::DB::Object::Manager);
        =216=   
        =217=   use My::RDBO::FilmStudioMap;
        =218=   
        =219=   sub object_class { 'My::RDBO::FilmStudioMap' }
        =220=   
        =221=   __PACKAGE__->make_manager_methods('film_studio_map');
        =222=   
        =223=   1;

Randal L. Schwartz is a renowned expert on the Perl programming language (the lifeblood of the Internet), having contributed to a dozen top-selling books on the subject, and over 200 magazine articles. Schwartz runs a Perl training and consulting company (Stonehenge Consulting Services, Inc of Portland, Oregon), and is a highly sought-after speaker for his masterful stage combination of technical skill, comedic timing, and crowd rapport. And he's a pretty good Karaoke singer, winning contests regularly.

Schwartz can be reached for comment at merlyn@stonehenge.com or +1 503 777-0095, and welcomes questions on Perl and other related topics.