May 2009 Archives

Textmate + Perl + New Package

| | Comments (0) | TrackBacks (0)
Everytime you create a new file in your project you need to type the package name:
lib/My/Project/DB/Result/Person.pm => My::Project::DB::Result::Person
That's really annoying, boring and prone to error. For Textmate users there's a simple solution (notice: the script expects your modules in directory "lib"):
#!/usr/bin/env perl
use strict;
use warnings;

my $package = get_package( path => $ENV{TM_FILEPATH}, walk_up_to => 'lib' );
my $content = get_content();

if ($content) {
    $content =~ s/^package (.*?);/package $package;/;
    print $content;
}
else {
    print "package $package;\n\nuse strict;\nuse warnings;\n\n1;";
}

sub get_content {
    local $/ = undef;
    return <>;
}

sub get_package {
    my (%args) = @_;
    my @chunks = split qr~/~, $args{path};
    while ( @chunks > 0 ) {
        last if $chunks[0] eq $args{walk_up_to};
        shift @chunks;
    }
    shift @chunks;
    my $pkg = join '::', @chunks;
    $pkg =~ s/\.pm//g;
    return $pkg;
}

Save that script and setup a new command in Textmates bundle editor as shown in the screenshot:
bundle editor
Next time you create a new perl module just hit Cmd + Ctrl + p and select "Filename to Package":
context menu
If the file is empty the script will insert following code:
package My::Project::DB::Result::Person;

use strict;
use warnings;

1;
If the file contained code already the script will just update the "package ...;" line with the new value. This is very handy if you move a file around and just want to update the package name.

Catalyst + DBIC + DAO

| | Comments (0) | TrackBacks (0)
Recently there was a question on the Catalyst mailing list which i've been asked by some teammate too: "How do i create DataAccessObjects with methods i can use in Catalyst as well as in CronJobs or other scripts?"

You're too lazy to read the full entry, you just want to see the code? It's available on GitHub: http://github.com/plu/dao-example/tree/master
It's quite easy, all you need is custom DBIx::Class ResultSets. I guess you've already setup a model in your Catalyst app:

package DAO::Example::Model::DB;

use strict;
use warnings;
use base 'Catalyst::Model::DBIC::Schema';

1;

...and a config file that might look like:
# rename this file to DAO::Example.yml and put a : in front of "name" if
# you want to use yaml like in old versions of Catalyst
name DAO::Example


    schema_class    DAO::Example::DB
    connect_info    dbi:SQLite:dao_example.db
    connect_info    username
    connect_info    password

To get custom resultsets for all of your result classes setup the schema using load_namespaces:
package DAO::Example::DB;

use strict;
use warnings;
use base qw/DBIx::Class::Schema/;

__PACKAGE__->load_namespaces( default_resultset_class => '+DAO::Example::DB::Base::ResultSet' );

1;

Going that way your result classes will be expected in DAO::Example::DB::Result:: namespace, resultsets in DAO::Example::DB::ResultSet::. If you create a class DAO::Example::DB::Result::Person DBIC will look if DAO::Example::DB::ResultSet::Person exists and inherit all person resultsets from that class. If there's no such class the resultset will be inherited from DAO::Example::DB::Base::ResultSet.

Let's add some methods to the person resultset:
package DAO::Example::DB::ResultSet::Person;

use strict;
use warnings;
use base qw/DAO::Example::DB::Base::ResultSet/;

sub by_username {
    my ( $rs, $username ) = @_;
    return $rs->search( { 'me.username' => $username }, { key => 'unique_username' } );
}

sub prefetch_all {
    my ($rs) = @_;
    return $rs->search( {}, { prefetch => [ { personroles => [qw/role/] } ] } );
}

1;

And to the default resultset:
package DAO::Example::DB::Base::ResultSet;

use strict;
use warnings;
use base qw/DBIx::Class::ResultSet::HashRef DAO::Example::DB::Base::Any/;

sub active {
    my ($rs) = @_;
    return $rs->search( { 'me.active' => 1 } );
}

sub inactive {
    my ($rs) = @_;
    return $rs->search( { 'me.active' => { '!=' => 1 } } );
}

1;

In catalyst you would call these methods that way:
package DAO::Example::Controller::Root;

use strict;
use warnings;
use parent 'Catalyst::Controller';
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

__PACKAGE__->config->{namespace} = '';

sub index : Path : Args(0) {
    my ( $self, $c ) = @_;

    unless ( -e $c->path_to('dao_example.db') ) {
        $c->model('DB')->schema->deploy;
        $c->model('DB')->schema->init;
    }

    $c->res->print('
');
    $c->res->print( Dumper $c->config );
    $c->res->print( Dumper $c->model('DB')->resultset('Person')->active->hashref_array );
    $c->res->print( Dumper $c->model('DB')->resultset('Person')->inactive->hashref_array );
    $c->res->print( Dumper $c->model('DB')->resultset('Person')->by_username('plu')->prefetch_all->hashref_array );
    $c->res->print('
'); }

The method hashref_array comes from DBIx::Class::ResultSet::HashRef. How would you call that from a CronJob / without Catalyst?
#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use DAO::Example::Utils qw/schema config/;
use Data::Dumper;
$Data::Dumper::Sortkeys=1;

unless (-e "$FindBin::Bin/../dao_example.db") {
    schema->deploy;
    schema->init;
}

print Dumper config;

print Dumper schema->resultset('Person')->active->hashref_array;

print Dumper schema->resultset('Person')->inactive->hashref_array;

print Dumper schema->resultset('Person')->by_username('plu')->prefetch_all->hashref_array;

The "magic" thing is to instantiate a DBIx::Class::Schema object using your Catalyst config file. I tend to write a small utility class to achieve that:
package DAO::Example::Utils;

use strict;
use warnings;
use base 'Exporter';
use Config::JFDI;
use DAO::Example::DB;

use vars qw/@EXPORT_OK $schema $config/;

@EXPORT_OK = qw/
  schema
  config
  /;

sub config {
    return $config if defined $config;
    $config = Config::JFDI->new( name => "DAO::Example" )->get;
    return $config;
}

sub schema {
    return $schema if defined $schema;
    $schema = DAO::Example::DB->connect( @{ config->{'Model::DB'}{connect_info} || [] } );
    return $schema;
}

1;

About this Archive

This page is an archive of entries from May 2009 listed from newest to oldest.

February 2009 is the previous archive.

January 2010 is the next archive.

Find recent content on the main index or look in the archives to find all content.