Announcing Catalyst::Action::FromPSGI

At YAPC this year I spoke with Stevan Little about his new module, Web::Machine. He mentioned that ultimately he wanted to figure out how to shim it into Catalyst. mst actually implemented something like that exactly a month ago, and I actually want to use it to make little redistributable apps that are the backend implementations of the gadgets for our dashboards at work. So I took Matt’s code and made a module!

Catalyst::Action::FromPSGI

Here’s the stupid obvious mostly worthless example:

sub from_plack :Path('/lol') :ActionClass('FromPSGI') {
   sub {
     [ 200,
        [ 'Content-type' => 'text/plain' ],
        [ 'lololol' ],
     ]
   }
}

So that’s neat, but who cares? What’s really nice is that you can pass stuff from Catalyst into the PSGI app. Here’s an example of something like that:

sub from_plack :Path('/my_lol') :ActionClass('FromPSGI') {
   my $username = $_[1]->user->obj->name;
   sub {
     [ 200,
        [ 'Content-type' => 'text/plain' ],
        [ "lol: $username" ],
     ]
   }
}

Anyway, I’ll have another post in a few days of how I am looking forward to using this. Have fun!

Posted Mon, Jun 25, 2012

DBIx::Class::DeploymentHandler Backup based workflow

In my last post I wrote about how to make a backup for each migration you run. That’s a great trick that opens the door for this next tip.

I’ve never really trusted or been comfortable with downgrade scripts. If your downgrade script truly is the reverse of your upgrade script it’s almost inevitable that your upgrade script will be archiving changed data so that the downgrade script can undo said change. That’s why I’ve basically decided to not ever use downgrade scripts and instead just restore backups. Sure, there are times when a downgrade might make more sense, like someone upgraded the live site to delete an important but rarely used table and didn’t realize it till a week later. But I honestly don’t trust the guy who does that to the live site to write a legitimate downgrade script for his stupid change anyway.

As the code for this isn’t written yet, I’ll just have to describe the algorithm to you, but it’s really pretty simple, and opens up the path to sensible, dead easy branching with DBICDH.

First, we need another column in the version storage representing the current git sha1 when each migration was run. Note that this column is not the version of the database, though it could be. So let’s handwave away the idea that we added a column to our version storage. That can’t be hard to implement. We’ll get to why we need that later.

When running our migrations I have our system run the upgrade method every time. The first thing that needs to be added is, if the deployed version is greater than the schema version, we need to restore the backup from the schema version. Next, if the deployed version is less than or equal to the schema version, and the git version in the database is not in the history of our current branch, we need to restore the current database version - 1. Basically keep doing the above until the current database version is less than the current schema version and the git version stored in the database is in the history of the current branch, and then run upgrade. To use more variables and fewer words:

while (
  $database_version > $schema_version ||
  $database_version <= $schema_version && !HEAD_contains($db_git_version)
) {
  if ($database_version > $schema_version) {
    restore($schema_version)
  } else {
    restore($database_version - 1)
  }
}
$dbicdh->upgrade;

Clearly there is some handwaving there, and the algorithm could be simplified (we could always restore $database_version - 1, for example, and thus remove the if block) or sped up (store backups based on git rev instead of schema version then you can do it in a single step) but until I actually implement it that’s all a moot point.

So there you have it. If you implement this you should have stable downgrades and a branching model that actual works with your schema. Of course I’m assuming the developers each have their own sandbox database, but if they don’t have that then of course you have more serious problems.

Posted Fri, Jun 8, 2012

DBIx::Class::DeploymentHandler + Backups

Given that DBIx::Class::DeploymentHandler is a widely misunderstood and confusing module to the point that a friend of mine wrote DBIx::Class::Migration a module to wrap it up more nicely, I’ve decided that some blog posts showcasing how I use DBICDH are in order. If you don’t already know, DBICDH was written by me, and designed my mst, myself, ribasushi, and Rob Kinyon. The latter two claim to barely remember our discussions early on, but I’ll credit them as having helped me design what I made.

“Ancient” History

The application I almost exclusively work on is a turnkey security (ish) “thing.” Historically the way our database deployments worked was as follows; one of our engineers puts the latest version of the software on the customer’s server. Next the engineer runs a script that updates the database, amongst other things. The way the script works is that it has a list of all columns along with their types that are in our schema. If the script finds that a column is not in a given table, it creates it; if the column has the wrong type, it changes it; if there are extra columns, it makes them nullable.

For the most part that works extremely nicely. There are no database versions. There are no version collisions. Branching is easy, etc. The first problem is that the tool had no way to make any kind of constraints, including the primary key kind. I can’t speak for MySQL, but SQL Server, which is what we use, really suffers when it doesn’t know about primary or unique columns. If id is primary, where id = 1 should be a row lock. If the engine doesn’t know id is primary, it has to do larger locks, which cause slowness and other problems.

The second, more major problem with our tool was that our customers’ databases were almost entirely in an unknown state. One customer even had hand deployed foreign key constraints that cause our app to do all kinds of silly things. The upshot of this is that I tend to be pretty paranoid when it comes to our database migrations. You’ll see more of that in one of my other DBICDH posts, but that brings me to the topic of the post at hand…

DBIx::Class::DeploymentHandler and Backups

For our very first migration, which I’ve dubbed pre-modern, or 0, I made it so that our tool would make a backup of the data. Because we don’t know what our customers’ database looks like, it is imperitive that we ensure that their data is safe by backing it up before running our giant (596 lines Perl + 197 lines DDL) initial migration.

When we made our second migration, I decided it wouldn’t hurt to just make a backup for every migration. Doing this required me to subclass DeploymentHandler and even copy/paste/mutate some code, but it works fine and I’ll eventually factor out the redundant bits anyway. Here’s what I came up with:

package Lynx::DeploymentHandler;

use strict;
use warnings;

use DateTime;
use Lynx::Util;

use base 'DBIx::Class::DeploymentHandler';

sub upgrade {
  my $self = shift;
  while ( my $version_list = $self->next_version_set ) {
     $self->upgrade_single_step({ version_set => $version_list })
  }
}

sub upgrade_single_step {
   my $self = shift;

   my ( $from, $to ) = @{$_[0]->{version_set}};
   Lynx::Util::backup_database({
      schema => $self->schema,
      backup_file => DateTime->now->ymd . "-upgrade-$from-$to"
   });

   my $g = $self->schema->txn_scope_guard;

   my $ret = $self->next::method(@_);
   my ($ddl, $upgrade_sql) = @{$ret||[]};

   $self->add_database_version({
     version     => $to,
     ddl         => $ddl,
     upgrade_sql => $upgrade_sql,
   });

   $g->commit;
   $ret
}

1;

I’ve left out the downgrade code, but you can probably figure out what it looks like based on the code above. It’s pretty simple. The main change I made in my copy pasta was to move the transaction into the single step method. The reason for this is that SQL Server does not allow backups to take place within a transaction.

So that’s protip 1 for DBIx::Class::DeploymentHandler. Expect more to come, hope this helps, etc.

Posted Wed, Jun 6, 2012

Introducing DBIx::Class::Helper::Schema::LintContents

Surprisingly recently we decided to actually clean up our database in my current project at work and add primary, unique, and foreign key constraints. For most projects that’s really not that hard, but because our project is a turn key server and it’s deployed on hundreds of customers’ sites we can’t just fire up a database shell and fix any broken constraints before we deploy them. So I made a tool that would quickly and correctly delete all but one of the duplicates of primary and unique constraints, and would delete the dangling children of broken foreign keys. In the process I also had to make a lot of things non-nullable, which should explain what that’s part of this module.

Introducing DBIx::Class::Helper::Schema::LintContents

LintContents is a fairly simple tool to find “broken” constraints in your database. I can imagine two major use cases for it. The first, which I hope is less common, is when people do not deploy constraints to their database because “constraints are slow.” You can use this tool and the auto methods to generate a report of rows that violate your pseudo-constraints. The other use case is what I used it for: automated fixing of various constraints before such constraints are actually deployed. Because I actually used it with Schema::Loader it does not require you to even make DBIC relationships, though using relationships is certainly supported.

Here is a simplified example of how I used this to pre-clean our database for deployment of such constraints:

my %pks = (
   Users  => [qw(id)],
  ...
);

my %ucs = (
   Users => [qw(name)],
   ...
);

my @fks = ({
   from => 'Users',
   columns => {
      group_id => 'id',
   },
   to   => 'Groups',
},{
   ...
});

my %non_nullable = (
   Users => [qw(id name)],
   ...
);

sub null_check {
   my ($schema, $table, $non_nullable_columns) = @_;

   my $rs = $schema->null_check_source($table, $non_nullable_columns);
   _delete_row($schema, $table_from, $_) for $rs->all
}

sub dup_check {
   my ($schema, $table, $unique_columns, $type) = @_;

   my $rs = $schema->dup_check_source($table, $unique_columns));
   for my $row ($rs->all) {
      my $x;
      if ($x) {
         _delete_row($schema, $table, $sub_row);
      }
      $x++;
   }
}

sub fk_check {
   my ($schema, $table_from, $table_to, $columns) = @_;

   my $rs = $schema->fk_check_source($table_from, $table_to, $columns);
   _delete_row($schema, $table_from, $_) for $rs->all
}

   null_check($schema, $_, $non_nullable{$_}) for sort keys %non_nullable;
   dup_check($schema, $_, $pks{$_}, 'pk') for sort keys %pks;
   dup_check($schema, $_, $ucs{$_}, 'uc') for sort keys %ucs;
   do {
      $change_made = undef;
      fk_check($schema, $_->{from}, $_->{to}, $_->{columns}) for @fks;
   } while $change_made;

Of course there was a lot more there in the real thing, because I logged everything that happened, but this should certainly make it clear how you can use this module for awesome.

Posted Mon, Jun 4, 2012

Introducing DBIx::Class::Helper::ResultSet::SearchOr

Arguably the most important design decision that mst made when first writing DBIx::Class was the choice to make chainable resultsets. A fundamental part of that design is that when you chain off of a resultset you should always get a subset of what you started with. This is important because it’s what makes searching from a user object or similarly using DBIx::Class::Schema::RestrictWithObject work in a safe manner.

Most everyone should know at this point that the best way to use DBIx::Class it to make various ResultSet methods that return named subsets of data. For example, for our Test resultset I have three methods, failed, succeeded, and untested. For some purposes though, we want to get all tests that are failed and untested. I could write a new method and copy paste the contents of failed and untested into it, but that’s not good programming practice in general. What I did in the past was actually unioned the two resultsets. That works, but it generates much more complicated SQL and is possibly slower than it could be.

Introducing DBIx::Class::Helper::ResultSet::SearchOr

SearchOr gives your resultset a search_or method. It works similarly to union, but instead of an actual union it’s just an expression union, also know as “or.” Here’s an example of it in action for the above example:

my $rs = $schema->resultset('Test')->search_or([
   $schema->resultset('Test')->failed,
   $schema->resultset('Test')->untested
]);

Unfortunately that misses a fairly major point of the module; it works correctly with chaining, as discussed above. So here’s a better example:

my $rs = $schema->resultset('Test')->complete->search_or([
   $schema->resultset('Test')->failed,
   $schema->resultset('Test')->untested
]);

To be clear, the above finds all tests that are complete AND ( failed OR untested ). Of course the expressions for complete, failed, and untested are more complicated than that, but it works.

The one fairly major caveat of this module is that it doesn’t Just Work with JOINs. Because it fundamentally ONLY puts ors between the passed expressions and looks at pretty much none of the rest of the passed resultsets, that’s your job to handle. So if you can get away with it, just add a join to the “root” search. If for some reason that won’t work, because of separate join paths for example, you’ll need to resort to a union.

Posted Fri, Jun 1, 2012

Introducing DBIx::Class::Helper::ResultSet::CorrelateRelationship

Recently at work we ran into an issue where a report was timing out. At first I thought it was because the server was overloaded, or the clients that were connecting to it were doing so improperly. Both of those things were true, but they weren’t the cause of the problem. The problem was this:

sub TO_JSON {
    my $self = shift;

    return {
       %{$self->next::method},
       failed_location_tests => $self->test_computer_links->failed->count,
       location_tests => $self->test_computer_links->count,
       device_tests => $self->test_device_links->count,
       total_pcs => $self->all_computers->count,
       total_pcs_failed => $self->failed_computers->count,
       total_pcs_succeeded => $self->succeeded_computers->count,
       total_pcs_untested => $self->untested_computers->count,
    }
 }

So to be clear, with our standard pagination of 25 rows per grid, this was doing the initial query to get the data, and then SEVEN additional queries per row. That’s not hard math, but I’ll do it for you, 176 queries, just to load this data. Fortunately, we can do better.

Introducing DBIx::Class::Helper::ResultSet::CorrelateRelationship

CorrelateRelationship gives you a single method, correlate. Basically you can treat it like related_resultset except that instead of a simple join it creates a correlated subquery. To be clear, here is the code and SQL of a correlated subquery:

my $rs = $schema->resultset('Gnarly')->search(undef, {
   '+columns' => {
      old_gnarlies => $schema->resultset('Gnarly')
         ->correlate('gnarly_stations')
         ->search({ station_id => { '>' => 2 }})
         ->count_rs->as_query,
      new_gnarlies => $schema->resultset('Gnarly')
         ->correlate('gnarly_stations')
         ->search({ station_id => { '<=' => 2 }})
         ->count_rs->as_query,
   }
});

SELECT me.id, me.name, me.literature, me.your_mom, (
   SELECT COUNT( * )
     FROM Gnarly_Station gnarly_stations_alias
   WHERE station_id <= '2' AND gnarly_stations_alias.gnarly_id = me.id
  ), (
   SELECT COUNT( * )
     FROM Gnarly_Station gnarly_stations_alias
   WHERE station_id > '2' AND gnarly_stations_alias.gnarly_id = me.id
  )
 FROM Gnarly me

The above returns all the rows in the table called Gnarly, and the counts of the related Gnarly_Station rows. There are two things to note: first off, we don’t need to deal with group by; if it were only for this correlated subqueries would still be awesome. If you were to use the obvious approach here’s how it would look (assuming just one count:)

my $rs = $schema->resultset('Gnarly')->search(undef, {
   join => 'gnarly_stations',
   +columns => { gs_count => { COUNT => 'gnarly_stations.id' } },
   group_by => [qw( me.id me.name me.literature me.your_mom )],
})

  SELECT me.id, me.name, me.literature, me.your_mom, COUNT( gnarly_stations.id )
    FROM Gnarly me
    JOIN Gnarly_Station gnarly_stations
      ON gnarly_stations_alias.gnarly_id = me.id
GROUP BY me.id, me.name, me.literature, me.your_mom

As you can see, the additionally selected columns need to be managed. The other thing, which is certainly engine dependent, is that COUNT’s that aren’t COUNT(*) tend to be slow as they do table scans.

More importantly, there are things that you really just can’t do without correlated subqueries. Note that in my first example we are counting the same relationship, but we’re counting a different set of the related rows in a each correlated subquery. That just can’t be done in a single query any other way (as far as I know anyway.)

Once you have this a lot of possibilities are opened up to you for fast, powerful queries. Enjoy!

Posted Wed, May 30, 2012

Introducing JavaScript::Dependency::Manager

Nearly a year ago my grandfather passed away. He had some form of dementia for a long time and I personally wasn’t hit very hard by it, but as is the custom I went home to visit my family when it happened. On the drive down I listened to Childhood’s End and Rendezvous with Rama. At work I’d been tackling the problem of users with custom dashboards and possibly even the ability to have gadgets that we sell separately. The whole drive down I had trouble focusing on the audiobooks and instead was thinking about how to deal with this problem of loading the right JavaScript for the right users.

Of course it’s not a difficult problem and really once you realize what your problem is it’s a Simple Matter of Programming. So when I stopped for gas, energy drinks, and gas at the Tallulah Travel Center in Louisiana I went ahead and implemented my solution. I didn’t write docs, but I wrote tests and the basic API that hasn’t changed and has served me well so far. So here it is:

Introducing JavaScript::Dependency::Manager

In this modern age we have more and more JavaScript to deal with. The project I worked on before my current one was actually 5050 JavaScript and Perl. If you are ok with the number of requests required when using client side dependency management, check out RequireJS. Personally though I’d rather bundle, minify, and cache all my JavaScript on the server side.

Using JSDM is easy

All that you need to do to use JSDM is annotate the requirements and provisions in your JavaScript files and instantiate and use a JSDM object:

// provides: oldYeller
// requires: underscore
var oldYeller = _.throttle(function(voice) { alert(voice + "!!") }, 1000);

use JavaScript::Dependency::Manager;

my $mgr = JavaScript::Dependency::Manager->new(
  lib_dir => ['root/js/lib'],
  provisions => {
    underscore => ['root/js/lib/underscore/underscore.js'],
  },
);

my @files = $mgr->file_list_for_provisions(['oldYeller']);

The return value from file_list_for_provisions is an ordered list of files that provide the requested provisions, as well as all of the provisions’ dependencies, recursively. Basically it gives you a list of files you can load on the page and make it work.

There are a couple missing features I’d like to implement at some point. First off is cycle detection. At work we actually have a legitimate cycle and the best way to fix it was to just take out the requirement that makes it a cycle. Although this may not be the solution for everyone, at the very least I’d rather JSDM say “cycle detected” or something. The other thing is that sometimes JavaScript needs CSS to be loaded as well, so I might make a way to plug into JSDM and load other required resources.

This may seem like overkill compared to, say, a manifest of JS files to load, but once you use it it’s so much nicer due to automatically handling of load order and whatnot.

Posted Mon, May 28, 2012

Introducing DBIx::Class::UnicornLogger

More than a 1.5 years ago we added color coded, formatted SQL output to DBIx::Class. Since then I’ve tried adding various configurable logging facilities to the core, but I haven’t had much luck getting the API for that whipped into shape. So I’m giving up on getting it into the core for now and releasing it separately. It’s pretty rough around the edges, but it’s a logger, so it’s not like you could depend on it working a certain way and get into any kind of trouble with it (yet.)

Meet DBIx::Class::UnicornLogger

(Every time someone gets upset about a module called Dad I name a module named something actually ridiculous.) First off, here’s some of the output (after color has been stripped)

[2012-05-18 23:06:43]\[/home/frew/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/DBIx/Class/Storage/DBI.pm:1489]
 ** SELECT "me"."id", "me"."kind_of_id", "me"."materialized_path", "me"."name", "me"."description"
 --   FROM "ingredients" "me"
 --   LIMIT '3'

The above was generated by the following configuration:

my $pp = DBIx::Class::UnicornLogger->new({
   tree => { profile => 'console' },
   profile => 'console',
   format => '[%d]\[%F:%L]%n ** %m',
   multiline_format => ' -- %m',
});

First off, clearly I need to set up a good default “clan.” The code supports it, but for some reason I never got around to making a good default. Next, there’s a bug somewhere that makes the location logging (specifically the subroutine part) not work. That’s a hassle and desperately needs to be fixed. Anyway, the idea is to make a neat logger that gives more information than the default trace tool. Eventually I plan on including total time for SQL to execute as well.

If you’re interested in trying this out yourself put the following snippet in your schema:

use DBIx::Class::UnicornLogger;
my $pp = DBIx::Class::UnicornLogger->new({
   tree => { profile => 'console' },
   profile => 'console',
   format => '[%d]\[%F:%L]%n ** %m',
   multiline_format => ' -- %m',
});

sub connection {
   my $self = shift;

   my $ret = $self->next::method(@_);

   $self->storage->debugobj($pp);

   $ret
};

So please, try it out, send me patches and ideas, and we can realize our hopes and dreams of unicorn logging!

Posted Fri, May 25, 2012

Introducing Catalyst::ActionRole::DetachOnDie

In my last post I introduced Catalyst::Controller::Accessors, which is mostly aimed at users who do a lot of chaining. This module is similarly targeted for chaining users. Anyone who has used chaining for more than a few weeks will know that exceptions in chains are stupid; an exception will not stop the chain, but merely end the current part of the chain, add to $c->errors, and run the next part of the chain. I would understand this if it were something that you could choose to turn on in a per-chain basis or something, but as a default it’s horrible.

This module solves that problem. It just detaches the chain and sets $c->errors when an exception is thrown. To use it you just need to do the following in your controllers (base controller anyone?):

package MyApp::Controller::Foo;
use Moose;

BEGIN { extends 'Catalyst::Controller::ActionRole' }

__PACKAGE__->config(
   action_roles => ['DetachOnDie'],
);

...;

If for some reason you can’t use the excellent Catalyst::Controller::ActionRole you can use the ActionClass version as follows:

package MyApp::Controller::Foo;
use Moose;

BEGIN { extends 'Catalyst::Controller' }

__PACKAGE__->config(
   action => {
      '*' => { ActionClass => 'DetachOnDie' },
   },
);

...;
Posted Wed, May 23, 2012

Introducing Catalyst::Controller::Accessors

Ugh, I first released this eight months ago, but I fell off the blogging wagon pretty badly. It’s so hard to write when I could be writing code, docs, and tests! So anyway, I’m trying to get caught up on the eight announcements that need to be made as well as a few DBIx::Class::DeploymentHandler related PSA’s. I’ll schedule them to get auto posted with at least a few days between so I don’t melt your feed reader or bore you too much.

Do you use Catalyst chaining? I do and for the most part I really enjoy the structure it brings my applications. Here is a typical example of a chain based controller of mine, structure stolen and mutated from the inimitable t0m:

package Lynx::SMS::Controller::Accounts;

use Moose;
use namespace::autoclean;

use syntax 'method';

BEGIN { extends 'Lynx::SMS::RESTController' };

with 'Catalyst::TraitFor::Controller::DBIC::DoesPaging',
     'Catalyst::TraitFor::Controller::DoesExtPaging';

sub base : Chained('/') PathPart('accounts') CaptureArgs(0) {
   my ($self, $c) = @_;
   $c->stash->{+__PACKAGE__}{rs} = $c->model('DB::Account');
}

sub item : Chained('base') PathPart('') CaptureArgs(1) {
   my ($self, $c, $id) = @_;
   $c->stash->{+__PACKAGE__}{id} = $id;
   $c->stash->{+__PACKAGE__}{thing} =
      $c->stash->{+__PACKAGE__}{rs}->find($id);
}

sub accounts :Chained('base') PathPart('') Args(0) ActionClass('REST') {}

method accounts_POST($c) : RequiresRole('write') {
   my $params = $c->request->data->{data};

   my $foo = $c->stash->{+__PACKAGE__}{rs}->create($params);

   $c->stash->{rest} = { success => 1, data => $foo };
}

method accounts_GET($c) : RequiresRole('read') {
   $c->stash->{rest} = $self->ext_paginate(
      $self->search($c,
         $self->paginate($c,
            $self->sort($c, $c->stash->{+__PACKAGE__}{rs})
         )
      )
   );
}

sub account :Chained('item') PathPart('') Args(0) ActionClass('REST') {}

method account_GET($c) : RequiresRole('read') {
   $c->stash->{rest} = {
      success => 1,
      data => $c->stash->{+__PACKAGE__}{thing},
   };
}

method account_PUT($c) : RequiresRole('write') {
   my $foo = $c->stash->{+__PACKAGE__}{thing};
   my $params = $c->request->data->{data};
   $foo->update($params);

   $c->stash->{rest} = { success => 1, data => $foo };
}

method account_DELETE($c) : RequiresRole('delete') {
   $c->stash->{+__PACKAGE__}{rs}->search({
      id => $c->stash->{+__PACKAGE__}{id},
   })->delete;
   $c->stash->{rest} = { success => 1 };
}

1;

So the above works great and given the little idiom up there you get a safely namespaced stash. That’s all good, but we can do better.

Introducing Catalyst::Controller::Accessors

Catalyst::Controler::Accessors is a module to abstract the above idiom into actual controller methods. The great thing is that when you use actual methods not only is the result much more clear code, but you can change the method if you need to and have a much smaller ripple effect of changes. Without CCA, if you change where you store something in the stash you need to audit every single action that chains off the thing you chained. With CCA such audits should not be needed at all (with one caveat; I’ll get to that.)

Catalyst::Controller::Accessors gives you a cat_has export that works very similar to the has export from Moose. Here is the above example rewritten with CCA:

package Lynx::SMS::Controller::Accounts;

use Moose;
use Catalyst::Controller::Accessors;
use namespace::autoclean;

use syntax 'method';

BEGIN { extends 'Lynx::SMS::RESTController' };

with 'Catalyst::TraitFor::Controller::DBIC::DoesPaging',
     'Catalyst::TraitFor::Controller::DoesExtPaging';

cat_has rs => (
   is => 'rw',
);

cat_has id => (
   is => 'rw',
);

cat_has thing => (
   is => 'rw',
);

sub base : Chained('/') PathPart('accounts') CaptureArgs(0) {
   my ($self, $c) = @_;
   $self->rs($c, $c->model('DB::Account'));
}

sub item : Chained('base') PathPart('') CaptureArgs(1) {
   my ($self, $c, $id) = @_;
   $self->id($c, $id);
   $self->thing($c, $self->rs($c)->find($id));
}

sub accounts :Chained('base') PathPart('') Args(0) ActionClass('REST') {}

method accounts_POST($c) : RequiresRole('write') {
   my $params = $c->request->data->{data};

   my $foo = $self->rs($c)->create($params);

   $c->stash->{rest} = { success => 1, data => $foo };
}

method accounts_GET($c) : RequiresRole('read') {
   $c->stash->{rest} = $self->ext_paginate(
      $self->search($c,
         $self->paginate($c,
            $self->sort($c, $self->rs($c))
         )
      )
   );
}

sub account :Chained('item') PathPart('') Args(0) ActionClass('REST') {}

method account_GET($c) : RequiresRole('read') {
   $c->stash->{rest} = {
      success => 1,
      data => $self->thing($c),
   };
}

method account_PUT($c) : RequiresRole('write') {
   my $foo = $self->thing($c);
   my $params = $c->request->data->{data};
   $foo->update($params);

   $c->stash->{rest} = { success => 1, data => $foo };
}

method account_DELETE($c) : RequiresRole('delete') {
   $self->rs($c)->search({
      id => $self->id($c),
   })->delete;
   $c->stash->{rest} = { success => 1 };
}

1;

You still have to pass around $c, as the stash is still being used under the hood, but your access is now hidden and you are free to change that method later if you need to.

Catalyst::Controller::Accessors also has a few other handy features that. Due to the confusing nature of catalyst chaining I actually think that having validation on these accessors is much more helpful than in typical Moose objects, so type constraints are supported:

use Check::ISA;
cat_has resultset => (
   is => 'rw',
   isa => sub {
     die 'resultset needs to be a DBIx::Class::ResultSet, but you passed "$_[0]"'
        unless obj($_[0], 'DBIx::Class::ResultSet')
   }
);

The isa checks are Moo style, so you can use MooX::Types to generate your type subs.

Also note, when you’ve chained into another controller you probably want readonly access to the values from said controller. Here’s how that’s done:

cat_has other_user => (
  is => 'ro',
  namespace => 'MyApp::Controller::Users',
  slot => 'user',
);

Note that if you change what your stuff is chaining off of you’ll obviously need to change this as well.

Posted Mon, May 21, 2012

Using search.cpan.org AND metacpan

I appreciate the effort and openness of metacpan, but their search is still pretty bad. To be clear, compare the results of the search for DBIx:Class::Source on SCO and metacpan. That’s why I made the following greasemonkey/dotjs script:

$('a').each(function(i,x){
   var obj = $(this);
   var href = obj.attr('href');
   var re = new RegExp('^/~([^/]+)/(.*)$');
   this.href = href.replace(re, 'https://metacpan.org/module/$1/$2');
})

Put this in ~/.js/search.cpan.org.js to install it with dotjs. Feel free to extend it to work for more than just modules.

Posted Wed, May 16, 2012

The Rise and Fall of Event Loops (in one very small place of my code)

In the spirit of one of my other posts I’ve decided to chronicle my path with at least a couple event loops.

More than eighteen months ago I documented my decision to start using an event loop as it would handle things I may not have considered, the example mentioned specifically in that post being exceptions. Things went well! I used the code I documented in that post for a long time with no issues until recently. It turns out that the event loop I was using didn’t actually handle exceptions at all, thus completely nullifying my reason to use it.

So I looked elsewhere. I looked at the grandfather of event loops, POE. I like a lot of the components that have been written on top of POE, but POE itself is frustratingly low level. That’s a topic for another post though (yes I looked at Reflex.)

After my last post and speaking with Rocco Caputo, auther of our venerable POE, I came up with the following runner role:

package Lynx::SMS::DoesRun;

use Moose::Role;
use POE;

# this merely uses our logger etc
with 'Lynx::SMS::HandlesDieForPOE';

requires 'single_run';

has period => (
   is => 'ro',
   required => 1,
);

has schema => (
   is => 'ro',
);

sub run {
   my $self = shift;

   POE::Session->create(
      inline_states => {
         _start => sub {
            $_[KERNEL]->sig( DIE => 'sig_DIE' );
            $_[KERNEL]->yield('loop');
         },
         sig_DIE => \&die_handler,
         loop => sub {
            $_[KERNEL]->delay( loop => $self->period );
            $self->single_run;
         },
      },
   );

   POE::Kernel->run;
}

no Moose::Role;

1;

This works fine. It’s (to me) a little ugly, but I imagine that I’d get used to it if I were to write much more POE. But then Rocco pointed out that maybe I’m just wasting my time with event loops for this use case. Ultimately using POE as a glorified Try::Tiny is stupid and really not even the goal. So finally I’ve ended up just a few steps beyond where I started:

package Lynx::SMS::DoesRun;

use Moose::Role;
use Try::Tiny;
use Log::Contextual qw(:log :dlog);

requires 'single_run';

has period => (
   is => 'ro',
   required => 1,
);

has schema => (
   is => 'ro',
);

sub run {
   my $self = shift;

   while (1) {
      try {
         $self->single_run;
      } catch {
         my $error = $_;
         log_error { $error }
      };
      sleep($self->period)
   }
}

no Moose::Role;

1;

The observant reader will notice that despite me mentioning the above use case, which is really the only important one for me given that our actual server will run all of our services in separate processes, there is still the benefit of Event Loops mentioned in the first post for development purposes (starting all services in a single program.) I have indeed converted that to POE, but that probably doesn’t matter. I run my unified service script maybe once or twice a year at this point. Here it is if anyone is interested:

package Lynx::SMS::Runner;

use Moose;
use POE;

with 'Lynx::SMS::HandlesDieForPOE';

has tasks => (
   is => 'ro',
   default => sub { [] },
);

sub run {
   my $self = shift;

   POE::Session->create(
      inline_states => {
         _start => sub {
            $_[KERNEL]->sig( DIE => 'sig_DIE' );
            $self->create_children_sessions,
         },
         sig_DIE => \&die_handler,
      },
   );

   POE::Kernel->run;
}

sub create_children_sessions {
   my $self = shift;
   my $x = 0;
   my @tasks = @{$self->tasks};
   for my $task (@tasks) {
      POE::Session->create(
         inline_states => {
            _start => sub {
               $_[KERNEL]->delay(loop => ($x++ / @tasks ));
            },
            loop => sub {
               $_[KERNEL]->delay( loop => $task->period );
               $task->single_run;
            },
         },
      );
   }
}

no Moose;

__PACKAGE__->meta->make_immutable;

1;

I look forward to using POE for actual heavy-lifting in another one of our projects, and will post about the experience when I get there.

Posted Wed, Mar 7, 2012

Perl Event Loop

I have some extremely basic code using AnyEvent but I recently found out that I was doing it wrong. That is, the entire reason I am using an event loop is to catch errors, log them, and keep going. That’s one of the great benefits that Catalyst gives me; I override one thing and I get universal error logging. The problem is that AnyEvent specifically does not handle this use case.

I have a working solution, but as I am planning on rewriting our services in evented code this prohibition makes me really worried. The problem is that you can’t just know your code won’t die. Exceptions happen and as a developer of a language that’s not Java or C# I don’t know where they come from. My current solution is ok, but I don’t think it’s really viable long term. Here’s my current code:

#!/usr/bin/env perl

use strict;
use warnings;

use AnyEvent;
use Try::Tiny;

sub event {
   print "looped\n";
   die "lol" if rand() < .5;
}

sub NEVER_DIE {
   my $code = shift;
   return sub {
      try \&$code, catch { warn $_ } # <-- this should be logging, you get the idea
   }
}

my $cv = AE::cv;
my $w = AE::timer 0, 1, NEVER_DIE(\&event);
$cv->recv;

This works for simple cases, but if I chose to go down this route in the long term I’d have to wrap every single code ref in NEVER_DIE, which is pretty lame.

I looked at POE as it may support my use case better but as far as I can tell it’s support is WORSE. Here’s what I came up with:

#!/usr/bin/perl

use strict;
use warnings;

use POE;
use Try::Tiny;

sub handler_start {
  my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
  $kernel->yield('event');
}

sub NEVER_DIE {
   my $code = shift;
   return sub {
      try \&$code, catch { warn $_ } # <-- this should be logging, you get the idea
   }
}

sub event {
   print "looped\n";
   die "lol" if rand() < .5;
   $_[KERNEL]->delay_add('event', 1);
}

POE::Session->create(
 inline_states => {
   _start    => \&handler_start,
   event     => NEVER_DIE(\&event),
   _stop     => sub{},
 }
);

POE::Kernel->run();
exit;

So I still have to use NEVER_DIE, so that’s a lose, and worse, if event dies before the call to delay_add we end anyway. Sure, I could put delay_add at the beginning of event, but that brings me to another thing that really bothers me about the “POE Way” (my own terminology, I may just not be getting it), for my AnyEvent code I can add a bunch of things and they don’t have to know about each other. The loop handles calling the events. With POE it seems like I have to manually tell it “call this, now call this.” That seems to defeat the entire purpose! What am I missing here?

If anyone knows an event loop I should consider (MUST RUN WELL ON WINDOWS) or maybe some setting in POE and some kind of POE timer thing, or some way of safely overriding how AE calls it’s events, please, comment and let me know.

Posted Sun, Mar 4, 2012

Using Catalyst::Plugin::Authentication with an old setup

Recently I took it upon myself to make Catalyst::Plugin::Authentication know users had logged in after users had logged in in a completely non-Catalyst part of our app. After LOTS of frustration, code spelunking, and bugging a couple people in #catalyst (hobbs and t0m) I got it working.

Basically what I did was have the session plugin look at a different cookie and load information from our own strange brew of session table. It’s not perfect, but I’m much happier with it than I was before. Here’s the code:

First, you need to create your own Session Store, our app is called Lynx, so the namespace reflects that:

package Lynx::Session::Store;

use strict;
use warnings;

use base qw/Catalyst::Plugin::Session::Store/;

use DateTime::Format::MSSQL;
use Catalyst::Authentication::Store::DBIx::Class::User;
sub get_session_data {
   my ($c, $key) = @_;

   my ($k, $v) = split /:/, $key;

   if ($k eq 'session') {
      if (my $login = $c->model('DB::Login')->single({ access_num => $v })) {
         return {
            __user_realm => 'default',
            __user       => {
               # this must be the primary key
               user => $login->userid,
            },
         }
      }
   } elsif ($k eq 'expires') {
      if (my $cookie = $c->request->cookie('Access_Num')) {
         if (my $login = $c->model('DB::Login')->single({ access_num => $v })) {
            my $ex = DateTime::Format::MSSQL->parse_datetime($login->last_accessed)->epoch + 720 * 60 - DateTime->now(time_zone => 'local')->offset;
            return $ex;
         }
      }
   }
}

sub store_session_data { }
sub delete_session_data { }
sub delete_expired_sessions { }

1;

We have stub methods for the session stuff that we don’t support. Eventually I may fill those out, but what’s more likely is that we remove this code entirely and just use what’s provided by CPA.

Next is get_session_data, which gets arguments like session:1234 and expires:1234. They are meant to return the session data and the expiry time (seconds since epoch) respectively. Clearly I had to do a lot of really weird stuff with datetime to get that expiration date from our database, but it works, so that’s cool. You may store your expiration directly. Who knows.

So far, so weird. Then I had to figure out how to “inflate” the session. The keys __user_realm and __user are hardcoded in CPA, and I kinda think they should change to just current_user_realm and current_user, or maybe catalyst-plugin-authentication-user. Whatever. But the fact is they are what they are. The value for __user_realm is which realm is currently selected. I imagine the vast majority of people should have that set to default, as they typically only have a single realm (we actually have two, but I didn’t realize till this code broke in a special way.) The value for __user is not a user object, but instead what get’s passed to the auth store’s from_session method. Note that the DBIx::Class store actually will only use the primary key, so if you change the primary key of your user class this thing will break. I am mostly sure about that, but it’s a pretty deep stack trace at that point.

Next up I made a Session subclass:

package Lynx::Session;

use strict;
use warnings;

use base qw/Catalyst::Plugin::Session/;

sub sessionid {
   my $c = shift;

   my $access_num;
   if (my $cookie = $c->request->cookie('Access_Num')) {
      $access_num = $cookie->value;
   }

   return $access_num;
}

1

This is clearly pretty basic. I just overrode sessionid to look at our cookie to get the sessionid.

After that I just loaded the plugins I needed and configured CPA:

...
use Catalyst qw(
   Authentication
   +Lynx::Session
   Session::State::Cookie
   +Lynx::Session::Store
);
...
   'Plugin::Authentication' => {
      default => {
         credential => {
            class => 'Password',
            password_field => 'password',
            password_type => 'clear'
         },
         store => {
            class => 'DBIx::Class',
            user_model => 'DB::User',
         },
      },
   },
  ...

Note that the credential is unused in my use case as catalyst doesn’t do the actual authentication at all.

Hope this helps someone!

Posted Wed, Jan 18, 2012

Cloning Objects in Perl

Recently I needed to do some deep cloning of some objects at work. I think I ended up looking at all of the major ways to do it, and I figure I might as well discuss them here.

What is deep cloning?

Nearly everyone should be able to answer this, but it doesn’t hurt to define it anyway. Deep cloning means you clone other things the current object is related to, recursively. So while a shallow clone of a hashref (in Perl) would be merely:

my $clone = { %{ $other_hash_ref } };

That doesn’t do if the things in the hash get mutated and are also references, because in that case you’ll be modifying parts of the other hash, possibly surprisingly.

Isn’t this solved?

Well yes. If it’s something as basic as a simple data structure you can just use Storable. The code for above would become:

use Storable 'dclone';
my $clone = dclone($other_hash_ref);

Storable has been core enough for long enough that if it’s not core you need to upgrade ;-)

What’s your problem?

Sadly just default Storable isn’t good enough. I needed to deeply clone the objects, but not clone any related schemata. That is, the objects had a DBIx::Class::Schema object attached to them and for various reasons I do not want to clone that at all. The correct way to deal with such an issue is to define the two Storable hooks as follows:

my @stack;
sub STORABLE_freeze {
   my ($self, $cloning) = @_;

   die q(you can't freeze this thing silly!) unless $cloning;

   my %ret = %$self;

   my %frame;
   $frame{schema} = delete $ret{schema};
   push @stack, \%frame;

   return \%ret
}

sub STORABLE_thaw {
   my ($self, $cloning, $ice) = @_;

   die q(you can't thaw this thing silly!) unless $cloning;
   my %frame = %{pop @stack};
   my $new = $self->new({
      %$self,
      map {
         $_ => $frame{$_}
      } keys %frame,
   });

   %$self = %$new;
}

This is a little more generic than you probably need, and came from my prototype module, Clone::Hooker, but I gave up on that as well as Storable.

Why did you give up on Storable?

Two reasons; first, defining the hooks above might be a bad thing. Storable is something that someone other than me may use, and by defining the hooks above I am changing the relatively generic interface of Storable for my module. Second, there’s a better alternative that I ended up using.

WHAT DID YOU DO?!

I ended up settling on the handy MooseX::Clone. Obviously it is for Moose modules only, but all of my modules are Moose objects in this case. It’s very simple to use, here’s how it works for me:

   package Dashboard;

   use Moose;

   with 'MooseX::Clone';

   has gadgets => (
      is => 'rw',
      isa => 'ArrayRef',
      traits => [qw(Clone)],
   );

   1;

   package Gadget;

   use Moose;

   with 'MooseX::Clone';

   has schema => (
      is => 'ro',
   );

   1;

   my $d = Dashboard->new(
      gadgets => [
         Gadget->new(
            schema => $schema,
         )
      ]
   );

   my $cloned_d = $d->clone;

This avoids the “global” nature of changing the interface of Storable, is fairly unobtrusive in my code, and works well.

Posted Tue, Sep 20, 2011

Shortcut Constructor Method & Conversion

I left my book and notes at work yesterday, hence the late post.

Shortcut Constructor Method

What is the external interface for creating a new object when a Constructor Method is too wordy?

Sometimes creating an object is exorbitantly wordy. The example that the author gives (in javascript) is the following:

var p = new Point({ x: 1, y: 2 })

Add methods to a lower level object that can construct your objects. Take care to only do this rarely.

This can’t be done with the example given in javascript, but the idea is to do something like the following:

var p = ( 1 x 2 )

Personally, I’m very wary of this idea. I see the value, but even operator overloading, which is a step HIGHER level than this, is usually viewed skeptically. I do think it’s a good idea to make shortcut methods to instantiate related objects, but that’s a far sight better than creating a method on all integers. If you do monkey-patch something like integer, it would be best if it were done dynamically, so only the code in your own project sees it.

Conversion

How do you convert an object’s format to another object’s format?

This is (at least to me) quite obvious. Some would think that they should add methods to every object to convert to other formats. So one might monkey-patch the DOM stuff to return a jquery DOM thing with the asJQDom method or something like that. Of course doing that means you’re going to end up with a ton of random conversion methods.

Convert objects by merely instantiating the second object type

This just seems so obvious I almost feel bad even writing it…

Posted Wed, Sep 7, 2011

Creating a pseudo attribute with DBIx::Class

I’m surprised I haven’t actually blogged this before. I had to do it recently for the first time in a long time and I figured I’d share the secret sauce.

At work we just added a complete permission system on top of our existing user system, but we didn’t want to make the UI as flexible as the underlying code. We ended up making a single role (which has all permissions) called “Full Control”. Without that role all you get is the stuff configured directly for your user; that is, your user gets a dashboard. So instead of making a grid of roles etc etc we just made a single checkbox on the user edit form. Of course I could have put in controller code to handle this special case, but I’m trying to get better at factoring code correctly. (As an aside: two years ago I would have also put all of this in the model; the frustrating thing is that Fat Model Skinny Controller only really works for relatively small apps. I’ll try to do a blog post on why I think that at another point later :-) )

Anyway, first off, here’s the full_control accessor I made:

sub full_control {
   my $self = shift;

   if (exists $_[0]) {
      my $full_control = $_[0];
      if ($full_control) {
         $self->set_roles({ name => FULL_CONTROL });
      } else {
         $self->user_roles->delete;
      }
      return $full_control
   } else {
      $self->roles->search({ name => FULL_CONTROL })->count
   }
}

Not a whole lot going on. If an argument is passed we set the user’s roles based on the truthiness of the argument. Because the system is currently just the one role we delete all roles for clearing it. Later on if we make the system more full featured we’ll have to change this up a bit of course. If no argument is passed we just return the count of full control roles, as that approximates truthiness just fine.

Next up are the “insert” and update wrappers. I quote insert because I actually override new:

sub update {
   my ($self, $args, @rest) = @_;

   my $full_control = delete $args->{full_control};

   my $ret = $self->next::method($args, @rest);

   $ret->full_control($full_control);

   return $ret
}

sub new {
   my ($self, $args, @rest) = @_;

   my $full_control = delete $args->{full_control};

   $args->{user_roles} = [ { role => { name => 'Full Control' } } ] if $full_control;

   my $ret = $self->next::method($args, @rest);

   return $ret
}

The code for update should be abundantly clear. We just update the object, calling our accessor afterwards. The new code is a little bit more messy. Basically, instead of trying to use the accessor on new (which is wrong as new doesn’t actually imply an insert) we just leverage the excellent MultiCreate which DBIx::Class provides for us.

And that’s it! I hope this helps you get your job done that much faster/better :-)

Posted Sun, Sep 4, 2011

Smalltalk Best Practice Patterns - Constructor Parameter Method

How do you set instance variables from a constructor method?

The fundamental issue here is that often validation is bypassed at construction time, for whatever reason. So one’s accessor may look something like this:

sub x {
   my $self = shift;

   if ($self->constructing) {
     if (exists $_[0]) {
       $self->{x} = $_[0];
     } else {
       return $self->{x}
     }
   } else {
     if (exists $_[0]) {
       die 'too high!' if $_[0] > 100;
       die 'too low!'  if $_[0] < 0;
       $self->{x} = $_[0];
     } else {
       return $self->{x}
     }
   }
}

Clearly this method is just doing to much. To solve this we make special set methods that are entirely to be used during construction. So in Perl this might look like the following:

sub _set_x {
  my ($self, $x) = @_;
  $self->{x} = $x;
}

Interestingly, with Moose we happily side-step this issue, as the default constructor doesn’t go through the accessors and already sets the raw values.


Ok, so I think I may start trying to apply this stuff to JavaScript instead of Perl. I almost feel like the fact that I have Moose in Perl is cheating. I know that there is Joose in JavaScript, but I’ve yet to use that in production, and I find that I have a harder time making well factored code in JavaScript than Perl. Part of that is that the underlying libraries I use in JS (ExtJS 3) are not really well factored either, but I still struggle with overall structure.

Posted Sat, Sep 3, 2011

Smalltalk Best Practice Patterns: Constructor Method

Sadly reading is going slower than expected due to being so busy with various things in life. Oh well, just a single pattern today.

Constructor Method

How do you represent instantiation?

In addition to a vanilla constructor, add methods for common cases to instantiate typical objects. For strange cases allow the use of accessors.

Using Perl (with Moose) an example might be:

package Point;

use Moose;

has x => (is => 'ro');
has y => (is => 'ro');

sub r_theta {
  my ($class, $r, $theta) = @_;

  $class->new(
    x => $r * cos($theta),
    y => $r * sin($theta),
  );
}

1;

So now both of the following work:

my $p = Point->new(5, 6);
my $v = Point->r_theta(10, 1.4);
Posted Thu, Sep 1, 2011

Smalltalk Best Practice Patterns - Chapter 3 - Behavior - Methods

Today I had to spend time taking care of passport stuff for my upcoming honeymoon, so I only got to read a handful of pages. I’ll post my notes nonetheless.

Methods are more important that state because, correctly factored, methods paper over any changes in state over time. Most of us who took OO classes in college had this hammered into our brains :-)

Methods should be written to get something done, but should also be written to communicate with the reader. Method names like “task_1”, “task_2”, etc are completely useless for a regular person, and should be named as to what they actually do.

Small methods are expensive in that they cost more CPU cycles and typically cause the novice trouble in following the structure of a program. On the other hand, more methods means more human readable names, easier maintenance (pinpointing changes,) and method overrideability is much more feasible with small methods.

Composed Method

How do you split your program into methods?

As already mentioned, large methods are faster and easier for the reader to follow, but small methods with good names work well in the long run. A seasoned programmer is able to see a method and assume what it does without needing to read the code for it. On top of that, small methods with good names allow you to communicate the structure of your code to the reader. Also, small methods are a must for inheritance.

Split your program into methods that do a single identifiable task.

A Perl example might be something like:

sub run_app {
  my $self = shift;

  $self->intialize_app;
  $self->app_loop;
  $self->shutdown_app;
}

The Composed Method patter can be used in a top down fashion, that is, write your higher level methods in an almost pseudo-code fashion, and then fill in the details of the lower level methods as you work. You may also opt to use the bottom up approach of writing a larger method and splitting it into smaller methods as you notice repetition or other reusable structures. Or lastly (and I think the most new idea to me) you can use this to find holes in your API. So if an object is calling more than one method on another object, the second object probably needs to implement a method that will encapsulate the multiple calls.

Posted Thu, Sep 1, 2011