RJBS Advent Calendar 2010

Advent is over! Go home!

2010-12-25T00:00:00-05:00

Merry Christmas!

It's Christmas day, folks! Advent is over, and there is no new writing about code for you today.

I had a lot of fun writing these articles this year. It's helped me think about why (and whether!) the code I write is useful or usable. Sometimes, I found that the code was too hard to explain, which led to improvements to the code. That's a frequent side-benefit to writing about code.

The side-benefit to writing the code itself is realizing all the ways that the code you've written up until now could have been better if you had been able to use the thing you're writing now in writing your old code. Every time I have a new idea, or learn about someone else's great idea, I want to go back and rewrite all my old code to incorporate it. Fortunately, I can usually resist that temptation.

A number of articles this year have been about libraries that use frequently discouraged features: global variables and dynamic scope, AUTOLOAD, operator overloading, Moose's BETA-style method augmentation, and probably other things I don't even realize I shouldn't have used. Perl provides an excellent core language for a lot of general programming problems, but some problems become overcomplex to solve if you stick to the usually-recommended features. By understanding just what all the weird tools do, and when to reach for one of the weird tools, you can avoid getting mired down trying to avoid features that somebody told you were "bad."

The scariest weird tools are the ones you have to build yourself. When you announce, "I'm thinking of writing a weird tool to solve a weird edge-case problem that is only 70% solved by existing tools," the answer you get is usually either "huh?" or "you aren't going to need it." Sometimes you still get that when it's done, but sometimes you'll have the great joy of seeing people come to understand the problem you were having and how you solved it, and having those people think your idea makes sense.

So my suggestion is this: when you find yourself trying to solve a new problem, talk to everybody you can about it. If nobody gives you a great solution, settle for great ideas. If you can get one of those, settle for a decent idea. Write about it and ask for feedback. Even if you get a lot of blank stares, implement it anyway and then write about that. You'll end up a better programmer for it, and the rest of the world might end up with useful code -- or at least an interesting post mortem report.

Rolling Your Own Method Dispatch

2010-12-24T00:00:00-05:00

EXPERIMENTAL CODE AHEAD

Last week, I wrote about the dangerously experimental Global::Context. This week, I'll be talking about the transcendentally experimental MRO::Magic.

Merry Christmas! Perl sucks!

Lately, just a little more than usual, we've been talking at work about the reasons that Perl sucks. That's not because we think that it's a terrible language, or that it's a mistake to use it, or that we don't like it. Let's face it, though: all programming languages suck. Sometimes, they suck in subtle and interest ways, and sometimes they're just absolute stinkers. Most languages that I've dealt with have some big problems and some little problems, and learning about them all is lots of fun.

For a good long while now, I've been feeling pretty strongly that one of Perl's biggest failings, within its own design aesthetic, is that you can't write per-instance methods. That is, whenever you write $thing->method, the method is resolved entirely based on the package associated with $thing (well, or via UNIVERSAL). Either $thing is a package name or it is a reference associated with ("blessed into") a package name. When you call the method on it, something like the following happens:

if there's a subroutine named method in the package, call it
otherwise, check all the packages listed in this package's @ISA, recursing through their @ISAs too
otherwise check in UNIVERSAL
otherwise, try to call any relevant AUTOLOAD (via the search path described in 1-3)
otherwise, throw an exception

So, imagine you had a Christmas::Present class, and you wanted to make an instance of it that would be fatal to open before December 25. You can't do something like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	`my $present = Christmas::Present->new({   to => $impatient_relative,   from => $self, }); $present->ADD_METHOD(open => sub {   my ($self) = @_;      die "It isn't Christmas yet!" unless time >= 1293256800;   $self->SUPER::open; });`

For one thing, ADD_METHOD doesn't exist. Then there's the fact that SUPER is incredibly tightly bound to packages. To make this work, we need to do something like:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17: `	`{   package Christmas::Present::FatalToPeekers;   use base 'Christmas::Present';   sub open {     my ($self) = @_;          die "It isn't Christmas yet!" unless time >= 1293256800;     $self->SUPER::open;   }); } my $present = Christmas::Present::FatalToPeekers->new({   to => $impatient_relative,   from => $self, });`

This works reasonably well, but only if we know, when writing our code, all the permutations of behavior we might need, so we can make explicit classes. This isn't always acceptable; sometimes we need special behavior to be figured out at runtime, which means we need to do something like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15: `	`my $i = 0; my $base = 'Anonymous::Class'; sub ADD_METHOD {   my ($object, $name, $code) = @_;   my $new_package_name = join q{::}, $base, $i++;   {     no strict refs;     @{ $new_package_name . '::ISA' } = (ref $object);     *{ $new_package_name . "::$name" } = $code;   }   bless $object => $new_package_name; }`

..and that means that we end up with a bunch of horribly-named packages being populated, potentially forming weird, long chains of inheritance. Because packages are not garbage collected, these weird-o packages will stick around in memory long after the only instances blessed into them are gone. Some metaprogramming frameworks (like Moose, to name the most important example) build abstractions over this so that you can forget about the horrible crap going on behind the scenes. Furthermore, you can't call ->SUPER::method in the $code passed to ADD_METHOD, because SUPER:: is broken. Instead, you need to use something like the SUPER module to fix the problem -- another abstraction over a colossal hack. When we abstract a colossal hack to fix a stupid language design issue, this is what is commonly called a "design pattern."

Who cares?

At first, this could seem like a really esoteric problem, only likely to bother people who are doing weird stuff at the edges of good behavior. That's because Perl's object model is at least barely adequate for common use -- but it's not great for common use, because of the "everything relates to the package" paradigm.

For example, a very common implementation for objects in Perl is "blessed hashref." This is convenient, because the object's attribute values can be stored in the hash. Sometimes, though, people want to store class attributes, too. There's not a clear place to put this state. At first, you might want to put things in the package itself, in a package variable -- but then it would be visible in global scope, and as subclasses added new attributes, the state associated with a class is scattered over more and more places, which is just frustrating.

"Stop!" some purists cry! "Classes shouldn't really have state! They're just templates for instances!"

That's true, but if it's true, then it's also true that they shouldn't have new methods. When you write a class, you need two things: a template for new objects and a handle for constructing them. Perl doesn't provide a new operator the way that some languages do. Instead, we write new method that get called on classes -- which are packages -- so that classes are acting both as classes and as factories, but (and this is the problematic part) using the same mechanism. This is what leads to the age-old and always-annoying question:

What should we do if somebody calls new on an object?

In an ideal world, instances and classes wouldn't share one namespace for methods, so calling a class method on an instance or an instance method on a class would have the same, obvious answer: an "unknown method" exception could be raised.

If classes were instances (presumably of the notional class Class) then it would make plenty of sense to give them attributes, and it would be easy to dump them, because our classes wouldn't have to be packages identified by strings. They could be blessed references with attribute state in their guts.

Can't you just...

Yes. Of course. You can get around the template/factory conflation by making two classes and having the "factory" class bless things into the "template" class. This is somewhat clumsy, but it works... but it only solves this problem. It doesn't help with the "per-instance methods." In fact, it compounds that problem by doubling the number of classes that might get pseudo-anonymous subclasses generated at runtime and then forgotten about. Those classes might not be generated with the same name in future program runs using the same libraries, so object serialization tools won't always (ever?) be able to restore objects like this properly. It's a big mess.

Overloading the Arrow

The solution I'd proposed to this quite some time ago was to make it possible to overload the method invocation arrow, so that when an instance method was called like this:

`1: `	`$instance->some_method(@args);`

...and we had defined:

`1:  2:  3: `	`package Class; use overload 'method' => 'invoke_method';`

...then this would happen:

`1: `	`Class->invoke_method($instance, "some_method", \@args);`

This never happened, mostly because nobody had my passion for the idea and the necessary ability to add the feature to Perl. Instead, Florian Ragwitz approached me with a number of strategies for implementing it, all of them quite excellent, and he and I have been playing with a real solution on and off for over a year now. It's called MRO::Magic.

MRO::Magic in Action

MRO::Magic's goal is to let you totally replace what happen when a method is called via the arrow operator. As a simple demonstration of it in action, this package implements classless OO:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29: `	use strict; use warnings; package Classless::Root; my %STATIC; use MRO::Magic   passthru => [ qw(import export DESTROY AUTOLOAD) ],   metamethod => sub {     my ($invocant, $method, $args) = @_;     unless (ref $invocant) {       die "no metaclass method $method on $invocant"         unless my $code = $STATIC{$method};       return $code->($invocant, @$args);     }     my $curr = $invocant;     while ($curr) {       return $curr->{$method}->($invocant, @$args) if exists $curr->{$method};       $curr = $curr->{parent};     }     my $class = ref $invocant;     die "unknown method $method called on $class object";   } ; # ...continued below...

We use MRO::Magic and tell it that some methods -- primarily important internal Perl-recognized methods -- are passed through to be called normally via package entries. That's the passthru argument.

The rest of the call sets up the code that's called when somebody calls a method, just as I described above. If it was called on the class name (a "static" method, as some call it) then we look for an entry in %STATIC.

Otherwise, we assume that the object instance is a hashref, and we look for a named entry in the hash. If we find one, that's the method and we call it. If not, we look for a parent object in the parent entry and start looking there. In other words, this works almost exactly like JavaScript. So, just like in JavaScript, we might want a basic universal parent object. We just set it up like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22: `	my $Object = {   get => sub {     my ($self, $attr) = @_;     my $curr = $self;     while ($curr) {       return $curr->{$attr} if exists $curr->{$attr};       $curr = $curr->{parent};     }     return undef;   },   set => sub {     my ($self, $attr, $value) = @_;     return $self->{$attr} = $value;   },   new_child => sub {     my ($parent, %attrs) = @_;     bless { %attrs, parent => $parent } => $class;   },   parent => undef, }; bless $Object => __PACKAGE__;

Then all we need is a static new method so we can call Classless::Root->new:

`1:  2:  3:  4:  5: `	`$STATIC{new} = sub {   my ($class, %attrs) = @_;   $Object->new_child(%attrs); };`

Is this awesome?

Yes, this is awesome. In about fifty lines, we've implemented a pretty decent prototype based OO system that isn't really too shabby. It won't be affected by UNIVERSAL or AUTOLOAD abuse. It won't ever require polluting the global namespace with throwaway packages or code.

Best of all, MRO::Magic isn't just a prototype based OO system, it's a toolkit for building your own OO systems with different tradeoffs than those made by the standard Perl OO toolkit. With MRO::Magic, there's more than one way to do it.

So why isn't everybody using it?

Well, MRO::Magic isn't quite done yet. As Florian and I have looked at other ways to do this, we've found a number of places where perl's internals have gotten in the way. Generally these relate to the way that the method resolution cache works. It isn't quite fair to call them bugs, since they don't cause problems with any existing use of Perl, but they sure are weird. One implementation of MRO::Magic worked around these bugs by globally invalidating the entire method resolution cache every time a method was called. Obviously, that's pretty nuts.

Beyond that, it will take a while to figure out just how to build a good MRO::Magic kit. The Classless::Root example is a nice example, but it's kludgy, and would be hard to extend. Things like passing through universal methods or extending the implementation of OO toolkits need to be seriously thought out, which is hard to do when the basics aren't quite usable.

In the end, I think that if MRO::Magic become a viable way to write code, almost no one will use it. Instead, a few alternate OO systems will be written using it, and people will use that. I look forward to implementing a few of those myself, even if only for fun. Data::Hive sure could benefit from it, though, to eliminate its use of AUTOLOAD.

If you're going to play with MRO::Magic, I suggest you do so using the versions of code on GitHub, linked below, rather than the outdated release currently on CPAN. Be warned, though: both are pretty broken, and you might want to ask on IRC what's supposed to work and what's known to be busted.

Rolling Your Own Composition

2010-12-23T00:00:00-05:00

Beyond Method Modifiers

Moose offers a few different kinds of method modifier, or "advice." They are before, after, and around. (There's also "augment" and "override," which are only sorta kinda method modifiers.) Advice lets you change the behavior of classes in very useful ways, and you can put advice in roles. The problem is that it is often more limited than you might think.

For example, subclasses of classes with advice can entirely clobber the advice applied to the superclasses' methods. Methods that collect output from multiple pieces of advice are a bit painful to write. augment solves that fairly well, but can't be used in roles, greatly limiting that behavior's usefulness. I wanted to write methods in which all the roles in a class could contribute behavior -- but subclasses-clobber-advice, combined with no-augment-in-roles made this a really annoying problem.

Sure, it could all be done with around modifiers, or by doing a lot of crawling of the meta objects, but that would be really annoying to implement over and over, and would be pretty confusing to skim. I wanted to write a library that made the pattern simple to use, not to just solve my current problem once.

This calls for specific example.

Event Handling

We've been working one some code that generates and responds to events. When an object does the HandlesEvents role, it will have a registry of event names, and each name will have a bunch of handlers, also registered by name. So, we might have a registry like this:

`1:  2:  3:  4:  5:  6: `	`$registry = {   got_signal => {     log_signal => sub { ... },     die_horribly => sub { ... },   } };`

When an object with that registry get a got_signal event, it calls each of the event handlers.

A lot of these handlers are going to be really common. For example, every object should be able to respond to a heartbeat event, even if only to respond by making note of it. We want to be able to put implicit event handlers on roles, so that when we compose together actual objects, they start off with all the event handlers that they should. For example, we might write these two packages:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29:  30:  31:  32:  33:  34:  35:  36:  37:  38:  39: `	{   package HandlesEvents;   use Moose::Role;   implicit_event_handlers {     return {       heartbeat => { inc_last_beat => sub { ... } }     };   }; } {   package Accruer;   use Moose::Role;   with 'HandlesEvents';   implicit_event_handlers {     return {       heartbeat => {         accrue_value => sub {           my $self = shift;           $self->value( $self->value * 1.01 );         }       }     };   }; } {   package Historian;   use Moose;   with 'HandlesEvents';   implicit_event_handlers {     return {       log_message => { write_log => sub { ... } }     };   }; }

Then, say we produce this class:

`1:  2:  3:  4:  5: `	`package Historian::Profitable; use Moose; extends 'Historian'; with 'Accrurer';`

It will have the following set of handlers implicitly:

`1:  2:  3:  4:  5:  6:  7: `	`{   log_message => { write_log => sub { ... } },   heartbeat => {     inc_last_beat => sub { ... },     accrue_value => sub { ... },   }, }`

If there's ever a conflicting set of entries, we should throw an exception. This turns out to be easy with MooseX::ComposedBehavior, too. We just write a ImplicitEventHandlers package and use it in all the packages above. This is what goes in it:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29:  30:  31:  32:  33: `	use MooseX::ComposedBehavior -compose => {   method_name => 'composed_implicit_event_handlers',   sugar_name => 'implicit_event_handlers',   context => 'scalar',   compositor => sub {     my ($self, $results) = @_;     my %composed; # Each result is a HOH; first keys, event names; second keys, handler     # names for my $result (@$results) {       for my $event_name (keys %$result) {         my $this_event = ($composed{ $event_name } \|\|= {});         for my $handler_name (keys %{ $result->{$event_name} }) {           if (exists $this_event->{$handler_name}) {             Throwable::X->throw({               ident => "implicit handler composition conflict",               payload => {                 handler_name => $handler_name,                 event_name => $event_name,               },             });           }           $this_event->{$handler_name} = $result->{$event_name}{$handler_name};         }       }     }     return \%composed;   }, };

When we want to know an object's composed event handlers, we just call its composed_implicit_event_handlers method. We can even make that method a builder for a lazy attribute, if we want to avoid recalculating.

Wacky New Composition is a Strategy of Last Resort

Building new ways of combining methods across compositional structures is neat. It solves a number of problems that might be hard to solve without it, and it's a very shiny little tool. It's also weird. Code that does this becomes harder to skim, and harder to explain, and more tied to a wonky library implemented in a clever but unfortunate way.

The existing tools for re-use provided by Moose are very powerful, and can address a huge array of problems. MooseX::ComposedBehavior is useful only when you're quite sure that you've exhausted simple-enough solutions wiht Moose.

A Lousy Locker (...because Worse is Better!)

2010-12-22T00:00:00-05:00

Optimizing for Failure

A long, long time ago, we had some services that ran only on one server. This was fine, because they produced minimal load and we never needed to scale up their volume. This was terrible, because it meant that if that server went down, all those services stopped. Even though the load was very low, we had to run redundant servers to avoid having single points of failure. We found ourselves doing this over and over as we identified more weird old pieces of architecture that worked this way.

When you take a job that you know can only run one at a time and make it redundant, you need to be really careful about race conditions and other kinds of contention. For example, say you're going to send out digests of mailing lists, and you're going to do it something like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`my $lists = MLM::List->get_iterator; while (my $mailing_list = $lists->next) {   my @undigested_messages = $list->messages->search({     has_been_digested => 0,   });   my $digest = $list->build_digest( @undigested_messages );   $digest->sent;   $_->mark_digested for @undigested_messages; }`

This is pretty reasonable, as long as it's only running once, in one place. Once we've got it running in two places at once, there's the possibility that the two services hit the same list at the same time, or nearly the same time, and each send out a digest -- maybe identical, or maybe not. The pattern that had been used to block this sort of condition in some places in the code base had been to get a MySQL lock:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17: `	my $lists = MLM::List->get_iterator; while (my $mailing_list = $lists->next) {   $DB->get_mysql_lock("digest " . $mailing_list->id);   my @undigested_messages = $list->messages->search({     has_been_digested => 0,   });   my $digest = $list->build_digest( @undigested_messages );   $digest->sent;   $_->mark_digested for @undigested_messages;   $DB->release_mysql_lock("digest " . $mailing_list->id); }

...and the get_mysql_lock call would become a MySQL GET_LOCK call, and so on. Unfortunately, in quite a few situations, including the one above, this is not a useful locking strategy. For one thing, in MySQL you can only hold one named lock at once, any accidental nesting of locks will be a catastrophe. More generally, native database locks usually associate with a database connection. If the database handle dies during the execution of $digest->build_digest, nothing will happen in reaction to that until we try to mark the posts digested in the database. So, before we've even begun sending mail, another service elsewhere may begin work on this job -- because we've lost our lock. Native database locks are only safe when the only changes that the service may affect are inside a transaction on the same connection as the lock.

What this really means is that you should take advantage of that, and put all your units of work into correctly-sized transactions, and you should take advantage of the incredible safety provided by database transactions. Sometimes, though, that's just a lot more work than you can afford to do. Sometimes you need a quick and dirty solution to contention, even in the face of unsafe code. After all, you might not be able to prevent every problem with not-quite-transactional code, but at least you can ensure that it won't be run four times at once!

The Simplest Test That Could Possibly Work

What we needed, for dealing with these contentious services, was a simple network-visible semaphore that would say "I have locked X; attempt no work there." It had to be impossible to get a lock if someone else had a lock, and it had to be really cheap to add locks to exisiting code -- no significant rearchitecture could be required. Everything else was secondary. Lingering locks, for example, were not a big problem, we could purge them as needed. We didn't want to worry about lock granularity (locking a whole resource or only part of it). Either a resource was locked, or not.

The solution was dead simple. We made this table:

`1:  2:  3:  4:  5:  6:  7: `	`CREATE TABLE semaphores (   id int PRIMARY KEY AUTO_INCREMENT,   lockstring varchar(128) UNIQUE,   created datetime NOT NULL,   expires datetime NOT NULL,   locked_by text NOT NULL );`

To get a lock, you'd insert a row into the table. If a row for that lockstring already existed, the unique constraint would prevent the insertion. That's it! It's almost ridiculously simple, but it works:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17: `	`my $locker = MLM::Locker; my $lists = MLM::List->get_iterator; while (my $mailing_list = $lists->next) {   my $lock = $locker->lock("digest " . $mailing_list->id);   my @undigested_messages = $list->messages->search({     has_been_digested => 0,   });   my $digest = $list->build_digest( @undigested_messages );   $digest->sent;   $_->mark_digested for @undigested_messages; }`

We don't even need to clear the lock. It will be automatically released when we finish marking messages digested and $lock goes out of scope:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17: `	`sub DESTROY {   my ($self) = @_;   local $@;   return unless $self->locked_by->{pid} == $$;   $self->unlock; } sub unlock {   my ($self) = @_;   my $dbh = $self->locker->dbh;   my $table = $self->locker->table;   my $rows = $dbh->do("DELETE FROM $table WHERE id=?", undef, $self->lock_id);   Carp::confess('error releasing lock') unless $rows == 1; }`

In reality, we'd have some exception handling to deal with failure to lock, so that we could continue on gracefully to the next list. That wouldn't cover every case, though. What if we hit an entirely unexpected error after getting our lock, and perl exited without releasing the lock. To take an extreme example, what if the server lost power? If we'd been using a database lock that was tied to our database connection, everything would be fine: our connection's death would let the lock die, and the work would now be available to anyone. The same thing would apply if we were using filesystem locks or, heaven help us, network filesystem locks. The death of our client would release the lock.

We don't have any concept of an active locking client, though. That's part of the strength of the design: failure of one connection doesn't prevent an otherwise healthy service from continuing to work. The trade off is that now, even though the server is dead, its lock it sitting there, preventing other services from picking up the work. That's why every lock has an expiration time. Every once in a while a cron job runs and just deletes expired locks.

This means that sometimes resources are locked for quite a lot longer than they should be. Sometimes seconds, sometimes minutes, or even an hour. That's okay, because we knew that could happen going in, we planned for it, and we don't care.

DBIx::Locker is a really crude tool that is often exactly the wrong thing for the job -- but sometimes it's not. Sometimes the right tool is a big, dumb hammer. Part of the challenge (and fun) of writing reasonable systems is knowing when a big, dumb hammer is good enough, and knowing when you need something better.

Testing with Classes, Roles, and Antlers

2010-12-21T00:00:00-05:00

Reuse, reuse, reuse

Sometimes, I hear the advice that it's okay to write absolutely horrible, terrible, copy and paste code in your tests, because hey, they're just tests. I would like, tentatively, to call that bad advice.

There's definitely wisdom in the idea that you don't usually want to spend all your time building elegantly constructed test suites when you're still trying to get your start-up off the ground. Getting working code out the door is a laudable goal, but it has to be balanced against your ability to get more working code out the door later, and that means that every part of your project needs to be maintainable.

Extreme Programming exhorts us to refactor mercilessly, and if we're going to accept that advice (as I think we should) then we need to write code that's planning to be refactored later. That means that as often as possible we should even our sloppy testing code into units that are at least sort of suitable for refactoring. At the start that might just mean putting sub{} around a bunch of code instead of copying it over and over. Later, maybe it means putting that sub into a shared file instead of copying it between files. These are the same tools we use when making our non-test code reusable and refactorable.

Another technique we use all the time to make code easy to maintain, reuse, and extend is object orientation. Classes are pretty good units of abstraction. Why don't we see them all that often in our tests, in Perl? I think the basic reason is that it's too hard to get started writing our tests as classes. Object orientation in Perl has traditionally been a bit of a drag, object-oriented testing moreso. You have to write a class, put it somewhere under ./t/lib, load it somewhere else, and do something to make it run. Since the class needs special facilities to be a test, you end up using some framework for writing test classes, and that's another class building system you need to learn.

In the last few years, Moose has helped usher in a revolution in how we write OO code in Perl, giving us one class-building system that's good enough for just about everything. Staring at some lousy tests and wishing for a good way to write reusable object oriented test code, I realized that Moose was probably good enough for writing tests, too. I ran with the idea and produced Test::Routine.

The Simplest Test That Could Possibly Work

To give you an example of how easy it is to write an object-oriented test with Test::Routine, here's a trivial test without Test::Routine:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10: `	`use strict; use warnings; use Test::More; subtest everything_is_okay => sub {   my $x = 100;   is($x, 100, "everything is okay"); }; done_testing;`

...and here it is, using Test::Routine:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`use Test::Routine; use Test::Routine::Util; use Test::More; test everything_is_okay => sub {   my $x = 100;   is($x, 100, "everything is okay"); }; test_me; done_testing;`

So, we've added one line of code to go from an entirely imperative test to an object-oriented test. Of course, you can't really tell, because we're not getting any benefit from it. What if we did this, though:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14: `	`use Test::Routine; use Test::Routine::Util; use Test::More; has x => (is => 'ro', isa => 'Int', default => 100); test everything_is_okay => sub {   my $self = shift;   is($self->x, 100, "everything is okay"); }; test_me; test_me({ x => 10 }); done_testing;`

Now we're getting somewhere! We've given our test object an attribute, and we use that attribute in our tests, rather than a constant. Then when we run test_me twice, we're constructing two test objects and running their all their tests. In other words, we'll run the everything_is_okay test twice, once an object where x is 100 (the default) and once where it is 10.

We could also add methods to our tests and use those just like you'd expect:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`has x => (is => 'ro', isa => 'Int', default => 100); sub is_square {   my ($self, $value) = @_;   return sqrt $value == int sqrt $value; } test everything_is_okay => sub {   my $self = shift;   is($self->x, 100, "everything is okay");   ok( $self->is_square($self->x), "x is square" ); };`

Combining Routines

Something that I haven't mentioned yet is that when we use Test::Routine, it doesn't mean we're writing a class. It means we're writing a role. That means we can write multiple routines and combine them. Here are three packages we might write:

t/lib/Factory/Gift.pm:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16: `	`package t::lib::Factory::Gift; use Moose::Role; use Gift; requires 'giver'; sub gift {   my ($self) = @_;   Gift->new({     from => $self->giver->name,     to => 'Gift Recipient',     value => rand( $self->giver->budget ),   }); }`

t/lib/Routine/Giver.pm:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19: `	`use Test::Routine; use Test::Tolerant; requires 'build_giver'; has giver => (   is => 'ro',   does => 'Gift::Giver',   builder => 'build_giver', ); test giver_is_acceptable => sub {   my ($self) = @_;   my $giver = $self->giver;   is_tol($giver->budget, [ qw(5 or_more) ], "giver is not cheapskate");   ok( $giver->celebrates_christmas, "humbugs need not apply" ); };`

t/basic.t:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15: `	`use Test::Routine; use Test::Routine::Util; use Test::More; sub build_giver {   Gift::Giver->new({     name => 'Scott Calvin',     budget => 100,     celebrates_christmas => 1,   }); } with( 't::lib::Factory::Gift', 't::Routine::Giver' ); run_me;`

The test file that gets run by make test is the last one, but you might notice that it doesn't actually have any tests in it! It gets its tests from the other roles it composes -- namely, t::Routine::Giver. That role gives the test object a giver attribute and sets up a test to make sure the giver is acceptable, but it doesn't set up a default. Instead, it requires that the default be provided by a builder method implemented elsewhere. We've implemented it in t/basic.t.

We also compose t::lib::Factory::Gift, which isn't even a Test::Routine role, but just a plain old Moose role. If we add more tests later, they can use the factory's gift method to get gifts built based on the fixture (the giver) provided by the rest of the composed test.

There's More Than One Way to Do It!

I've shown two pretty extreme use cases of Test::Routine: using it for almost nothing, and using it for fairly complex composition. One of the things that makes it such a useful library is that it can be used in lots of different ways not seen here. It doesn't have many opinions on how it should be used, it's just a simple tool with lots of possible applications.

Better yet, it's not much more than plain old Moose roles, with all the same rules in play. The extra bit of code that makes Test::Routine roles testable is very small and easy to understand. You can start by writing test files that look almost exactly like what you're doing now, but later, when you want to refactor or update your tests, you'll have far more options available to do it.

Shuffle Smarter, Not Harder

2010-12-20T00:00:00-05:00

NOT ON THE CPAN

Today's article is about code not found on the CPAN. In fact, this code won't even work anymore on many new compiles of perl. It's still an interesting idea, and maybe I will rewrite it to use the scripting bridge in some other way -- either via PerlObjCBridge or some non-Perl language with a working scripting bridge.

Albums as Atomic Units

Some recording artists are still refusing to be sold through the iTunes music store, in part because they can't restrict shoppers from buying single tracks. That is, some artists want to say, "I made an album. You can buy the whole album, or you can go buy something else. You can't just buy track nine." I can really get behind that. These guys are artists, and they don't want people to think they've experienced their work if they've really just experienced part of it, out of context.

Unfortunately, the idea that "music is organized into tracks, and tracks can be shuffled arbitrarily" is getting more and more popular with the rise of MP3 players. Years ago, I realized that because of the way I built my "smart playlists" in iTunes, I was very rarely hearing large parts of albums that I liked, and that I was almost never listening to whole albums. When I realized this, I spent a few days only listening to whole albums, and it was fantastic. After that, I felt sad that it was so hard to keep doing that daily.

iTunes didn't have a way to make smart playlists that included whole albums. The iPod had recently lost the ability to shuffle by albums, too -- making listening to classical music much harder.

After sulking for a while, I realized that this would be really easy to fix by stepping outside the smart playlist editor and reaching for Mac::Glue to analyze my library and build a playlist by hand.

The code that follows does this, and I will sprinkle annotations explaining how it all works.

albumen

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`use strict; use warnings; use Getopt::Long::Descriptive; use List::Util qw(sum); use Mac::Glue qw(:glue); my ($opt, $usage) = describe_options(   '%c %o',   [ 'interactive\|i!', 'prompt for each album' ], ); my $itunes = Mac::Glue->new('iTunes');`

So far, we've prepared to run our program, and gotten our handle on the iTunes automation "glue."

`1:  2:  3:  4: `	`my $pl = $itunes->obj(playlist => whose(name => equals => 'Regularer'))->get; my $albumen = $itunes->obj(playlist => whose(name => equals => 'Albumen'))->get; die "couldn't find target playlist" unless $albumen;`

We're going to consider as our input tracks in the "Regularer" playlist, which is a smart playlists that filters out stuff that, more or less, isn't really music, like spoken word, podcasts, and jazz. When we build our playlist out, it will go into the playlist "Albumen."

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	`{   my $tracks = $itunes->obj(     track => gAll,     playlist => $albumen->prop('index')->get,   );   $_->delete for $tracks->get; } print "getting tracks\n"; my @tracks = $pl->obj('tracks')->get;`

We empty out the old playlist from Album and get our new set of tracks to consider adding.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22: `	my %album; while (my $track = shift @tracks) {   my $trackid = $track->prop('database ID')->get;   my $album = $track->prop('album')->get;   my $artist = $track->prop('compilation')->get               ? '-'               : $track->prop('artist')->get;   next unless defined $album and defined $artist;   next unless length $album and length $artist;   my $rec = $album{ $album, $artist } \|\|= [];   printf "storing record of $trackid ($album/$artist); %s left\n", 0 + @tracks;   push @$rec, {     id => $trackid,     rating => scalar $track->prop('rating')->get,     played => scalar $track->prop('played date')->get, # epoch sec   }; }

Here, we build up %album, a hash in which keys are album/artist pairs (using the justly-maligned list-in-hash-subscript-means-join-with-$; feature) and values are arrayrefs of tracks. Now that we've got a data structure suitable for building our playlist, we can really get to work.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14: `	`my $DEFAULT_TIME = time - 30 * 86_400; my %avg_age; ALBUM: for my $key (keys %album) {   my ($album, $artist) = split $;, $key;   printf "considering (%s/%s)\n", $album, $artist;   my @tracks = @{ $album{ $key } };   unless (@tracks > 4) {     printf "skipping (%s/%s); too few tracks\n", $album, $artist;     delete $album{$key};     next ALBUM;   }`

We start iterating through all the albums we've got to consider, and skip any album with fewer than four tracks available. Once, I skipped any album that didn't have all of its tracks available, but this ended up causing problems with albums with some tracks that were not "Regularer" music, like hip hop albums with "spoken word" tracks, or with albums that had no "total tracks" tags.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	my @lp_dates = map { undef $_ if $_ eq 'msng'; $_ \|\| $DEFAULT_TIME }                  map { $_->{played} }                  @tracks;   my $avg_age = time - (sum(@lp_dates) / @lp_dates);   $avg_age{ $key } = $avg_age;   if ($avg_age < 86_400 * 30) {     printf "skipping (%s/%s); too recent\n", $album, $artist;     delete $album{$key};     next ALBUM;   }

Next, we figure out the average "last listened to" of the album. If we've listened to the whole thing recently, or to a lot of its tracks recently, we remove it from the playlist. This works really well, because iPod and iTunes will update the "last played," so the next time you sync your iPod and run albumen, the albums you've listened to since your last sync will be replaced.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`  my @ratings = grep { $_ > 0 } map { $_->{rating} } @tracks;   my $avg_rating = sum(@ratings) / @ratings if @ratings;   if ($avg_rating and $avg_rating < 65) {     printf "skipping (%s/%s); too lousy\n", $album, $artist;     delete $album{$key};     next ALBUM;   }   printf "keeping (%s/%s) @ %s\n", $album, $artist, $avg_rating \|\| '(n/a)'; }`

After removing albums we've heard too recently, we remove albums we don't want to hear ever again. We get an average of ratings, skipping unrated tracks, and drop the album if it's got under a three and a quarter star rating. (The stars displayed in iTunes are counted as 20 "rating points" in the scripting interface.)

Now we've gotten down to just albums we'll consider putting in the playlist: nothing we've just listened to, and nothing we dislike. Now it's time to start building the playlist:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10: `	`my $total_size = 0; my %seen_artist; my %included_track; ADDITION: for my $key (sort { $avg_age{$b} <=> $avg_age{$a} } keys %album) {   my ($album, $artist) = split $;, $key;   if ($artist ne '-' and $seen_artist{ $artist }) {     printf "skipping (%s/%s); already have album by this artist\n",       $album, $artist;     next ADDITION;   }`

We'll use %seen_artist to keep track of artists whom we've added to our playlist already. If we've already added a Negativland album, we won't add another one. I had to add this feature after I ended up, one day, with a playlist of nothing but Elvis Costello. It wasn't bad so much as overwhelming.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10: `	`  if ($opt->{interactive}) {     local $\|;     $\|++;     for (1) {       print "include ($album by $artist)? ";       my $line = <STDIN>;       next ADDITION if $line =~ /^n/;       redo unless $line =~ /^y/;     }   }`

Sometimes, you just want to be able to veto something that would otherwise show up. Maybe it's time for me to listen to Tragic Kingdom again, but I'm just not ready to hear it again. Interactive mode lets me tell albumen to wait for next time.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20: `	$seen_artist{ $artist }++;   my @tracks = @{ $album{ $key } };   for my $track (@tracks) {     my $t = $itunes->obj(       track => whose('database id' => equals => $track->{id})     )->get;     $total_size += $t->prop('size')->get; # in bytes     my $dupe_track = $itunes->duplicate($t, to => $albumen);     unless ($dupe_track) {       warn "could not dupe track\n";       next;     }     $included_track{ $dupe_track->prop('database id')->get } = 1;   }   last ADDITION if $total_size > 1_000_000_000; }

Finally, we add the tracks and make a record of adding them. If we've gotten our playlist up to a gig, we're done. Otherwise, we go ahead and look for another album.

The Gift of Music

I can honestly say that writing this program improved the quality of my life. Maybe not by leaps and bounds, but it made me remember how albums sounded. I found that many albums in my library were much better taken as a whole than as individual tracks, and that means that I was now enjoying my music collection much more than I had in years.

It's the ability to keep "last played" and "play count" data synced with my mobile device that's kept me hooked on iTunes, despite its numerous, crushing flaws. I encourage anybody who uses other music software to reproduce this program for his software, just to see how nice it can be.

Exporting Globs for Fun and Profit

2010-12-19T00:00:00-05:00

What's a glob?

A glob (or typeglob) is a kind of scalar in Perl. It is a weird, pretty horrible thing. There really isn't any need for them in Perl 5, but instead of being jettisoned, typeglobs were enshrined in the construction of packages and classes. Anyway, that doesn't really explain what a glob is.

A glob is a scalar that may contain a reference to one variable of each type: scalar, array, hash, code, I/O handle, and format. In Perl, packages (and therefore classes) are just hashes with identifiers as keys and globs as values. So, given the following program:

`1:  2:  3:  4:  5:  6:  7: `	`package main; # we would have been in "main" anyway, but let's be explicit use 5.12.0; our $x = 1; our @x = qw(foo bar baz); sub x { say "I'm in a glob!" }`

This program sets up a typeglob in $main::{x} with references to a scalar, a hash, and code so that we can get the following results in the debugger:

`1:  2: `	`  DB<1> x $main::{x} 0 *main::x`

We've got a glob there, just as we said.

`1:  2: `	`  DB<2> x { $main::{x} } 0 main::x`

The * isn't a dereference, because we don't have a glob reference. It just means we want to use it as a glob.

`1:  2:  3:  4:  5:  6: `	`  DB<3> x ${ $main::{x} } 0 1   DB<4> x @{ $main::{x} } 0 'foo' 1 'bar' 2 'baz'`

We can dereference the glob as a scalar or array (or anything else) to dereference the scalar or array (or whatever) in the slot for that type in the glob. We can also access those slots as if the glob was a hash; if we do that, we see the reference itself:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14: `	`  DB<5> x { $main::{x} }{ARRAY} 0 ARRAY(0x1008ad4d8)    0 'foo'    1 'bar'    2 'baz'   DB<6> x { $main::{x} }{SCALAR} 0 SCALAR(0x100829658)    -> 1   DB<7> x { $main::{x} }{CODE} 0 CODE(0x10083b518)    -> &main::x in -:7-7   DB<8> x { $main::{x} }{CODE}->() I'm in a glob! 0 1`

It gets weirder, though. When we said *$x above, we said we weren't dereferencing, because there was no reference. What if there is?

`1:  2:  3:  4:  5: `	`use strict; our $x = "This is X!"; our $y = \*x;`

Then, in the debugger...

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`  DB<1> x $x 0 'This is X!'   DB<2> x x 0 main::x   DB<3> x ${ *x } 0 'This is X!'   DB<4> p ref $y GLOB`

None of this is very surprising, so far. What do we do to get the string out of $y, though? Well, $y is a GLOB ref, and a GLOB is a kind of scalar, so we can dereference it with a dollar sign:

`1:  2:  3:  4:  5: `	`  DB<7> x $y 0 GLOB(0x1008297a8)    -> main::x   DB<8> x $$y 0 main::x`

...and if you want to get at the string, we know we can scalar-dereference a glob to get its scalar entry:

`1:  2: `	`  DB<11> x $$$y 0 'This is X!'`

And just to make sure there are more ways to do it, we can use a * instead of a $ for some of these dereferences.

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`  DB<15> x $y 0 GLOB(0x1008297a8)    -> main::x   DB<16> x $y 0 main::x   DB<17> x {$y}{SCALAR} 0 SCALAR(0x100829700)    -> 'This is X!'   DB<21> x ${ *$y }`

...and that all makes sense. Then there's:

`1:  2:  3:  4: `	`0 'This is X!'   DB<22> x $$y $ is no longer supported at (eval 26)   [/Users/rjbs/perl5/perlbrew/perls/perl-5.12.2/lib/5.12.2/perl5db.pl:638] line 2.`

Oh. Right, because there used to be a $* magic variable, we need to be clearer about our line noise:

`1:  2: `	`  DB<23> x ${ *$y } 0 'This is X!'`

That Looks Really Dumb

Well, it is -- and the above is really just the goofy syntax around globs. In case you're wondering: yes, they do have goofy semantics as well. So, why would you ever go out of your way to deal with globs?

There are basically two reasons. The first is simple: you install subroutines in packages at runtime by putting code into globs. I wrote about this last year. This is how Sub::Exporter and Exporter work.

The other reason is more complicated. Globs in symbol tables are public, globally shared variables, so you can use them to share a variable everywhere. For example:

`1: `	`*Target::variable = \$Source::variable;`

This makes $variable in Target an alias to $variable in $source.

You could do pretty easily with a reference, though:

`1:  2:  3:  4:  5:  6:  7: `	`package Christmas; sub wishlist {   state %wishlist;   return \%wishlist; }`

...and then anywhere else in the program:

`1: `	`Christmas->wishlist->{ $person } //= [ ... ];`

That gets us a shared variable with much tighter control over the interface than just a global variable name. So why would we do it with globs? There's one really good reason: localization. If we don't just alias one part of the glob (like we aliased the scalar part above), but assign the whole glob, then we can use Perl's local keyword to localize values within a dynamic scope.

Dynamic scope lets you save the value of a global variable and overwrite it, and when you exit the current block the old value is restored. The usual (and excellent) document explaining scoping in Perl, including local, is Mark Jason Dominus's Coping with Scoping. If you're not clear on what dynamic scoping is, you should read it.

If you are clear, then what you need to know is that if you localize an imported variable, but you didn't import the whole glob, other things that imported that variable will not see your changes. Let that sink in.

Here's an example of how importing variables can make localization fail:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22: `	{   package Source;   our $variable = 10;   BEGIN {     User_1::variable = \$Source::variable;     User_2::variable = \$Source::variable;   } } { package User_1; sub var { $variable } } {   package User_2;   say $variable; # 10, as expected   say User_1->var; # 10, as expected   local $variable = 20;   say $variable; # 20, as expected   say User_1->var; # 10, no good! }

Because we only imported the scalar part of *Source::variable, it isn't localized the way we might expect. If we replace the $ on lines 5 and 6 with * then the final two say statements will both print 20.

I Never Want to Think About This Again!

This isn't the kind of thing you need to think about very often, and once you've been forced to think about it enough, you might realize that you don't want to think about it again. One way to do that is to never have shared, localized variables. That's kind of a bummer, because it's a useful thing to do. Another tactic would be to always use fully-qualified variable names to localize them. That's a bummer, too, because local names are both easier to type and a layer of indirection in front of the real variable. That is: if you only use your package's $variable, and later you want to make it point to $Other::variable instead of $Source::variable, it's only one line to update. If you had to type out $Source::variable each time, it's a much hairier problem.

So, this is a fairly esoteric problem that isn't encountered very often -- but it came up in the construction of two libraries mentioned earlier in this advent calendar: Log::Dispatchouli::Global and Global::Context. To avoid thinking about the grotty details of the problem, I built a library abstract the idea of a exported, shared glob.

Sub::Exporter::GlobExporter

Finally, today's actual code!

Here's the Sub::Exporter setup for Global::Context, which exports a shared global:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`use Sub::Exporter -setup => {   exports => [     ctx_init => \'_build_ctx_init',     ctx_push => \'_build_ctx_push',   ],   collectors => {     '$Context' => Sub::Exporter::GlobExporter::glob_exporter(       Context => \'common_globref',     )   }, };`

ctx_init and ctx_push are set up like plain old exports that you might see in any other use of Sub::Exporter. It's $Context that's more interesting. Because it doesn't just export a subroutine, it has to be a "collector," which is Sub::Exporter jargon for "some weird hunk of behavior." When someone uses $Context in their import statement, like this:

`1: `	`use Global::Context '$Context';`

...then the glob_exporter routine kicks in. It's been passed two arguments. One is the name under which to install the exported glob. We used Context, so it will be installed in *Context. The other is a reference to a name of a method that will return the globref to install. In other words, the above import will result something like this happening:

`1:  2:  3: `	`my $globref = Global::Context->common_globref; Importer::Context = $globref;`

If we wanted, we could have done this:

`1:  2:  3:  4:  5:  6: `	`use Global::Context '$Context' => { -as => 'ctx' }; # ...which would have meant: my $globref = Global::Context->common_globref; Importer::ctx = $globref;`

That's how we can pick a different name in our package for a global that goes by another name elsewhere. This isn't the big benefit, though. The big benefit is that because common_globref is a method, subclasses of Global::Context can provide a different globref. We could have two different global contexts that would never interfere with one another by writing the following code:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14: `	`{   package Context::Alpha;   use parent 'Global::Context';   sub common_globref { \Context } } {   package Context::Bravo;   use parent 'Global::Context';   sub common_globref { \Context } } use Context::Alpha '$Context' => { -as => 'ctx_a' }; use Context::Bravo '$Context' => { -as => 'ctx_b' };`

We'd end up with $ctx_a and $ctx_b, both properly shared with other things using the Alpha or Bravo contexts, and neither interfering. In other words, by using glob_exporter, we write libraries that use global variables but less strictly limited in terms of reuse.

We'll Have a Blue Christmas Without del.icio.us

2010-12-18T00:00:00-05:00

What Color is Your Data's Parachute?

Multi-master synchronization of an application's data across multiple computers is hard -- really hard. More and more, services spring up to keep all your data in just one place, accessible from all your computers. As more and more of your personal belongings become always-on parts of the Internet, all able to access more and more of your on-the-Internet data, it's like you're constantly surrounded by a cloud of all your information, always available but never weighing you down. The problem is that when your data is only supported by clouds, the clouds might dissipate at any time, leaving all your precious data in free fall.

If you're going to rely on cloud-backed systems, it's always a good idea to make sure that you've got a regularly updated backup copy safely on the ground, even if it's only on one system and inconvenient to use. After all, "inconvenient" will still be pretty good compared to "totally lost."

As a lot of people probably know by now, Yahoo! recently laid off quite a lot of staff, including (reportedly) the entire http://del.icio.us/ team. Other widely-reported leaks said that Delicious would be shut down for good. If you long ago replaced all your other bookmarks with Delicious, and Delicious went away, you would suddenly be without your bookmarks.

I started using Delicious back in 2004, when it was still pretty new, and was immediately gripped with fear that it would go away, leaving me bookmarkless. Eventually, too, I knew I'd want to migrate to my personal blog and bookmark manager, Rubric. To do that, I'd need my bookmarks in some kind of intermediate form.

Fortunately, Delicious even then provided a good API for getting at your data, and Aaron Straup Cope wrote a nice Perl interface to it. It was pretty easy for me to write a stripped down version and a simple "dump my bookmarks" program.

Using delbackup

First, create a .delicious file in your home directory with your Delicious credentials in it:

`1:  2: `	`user: username pswd: password`

Then, run delbackup with one of two switches:

`1:  2:  3: `	`rjbs$ delbackup -y rjbs$ delbackup -ns`

-y dumps your bookmarks as YAML so you can import them into any other API you want, later. -ns dumps them into a HTML document, organized by tags. It's a Netscape bookmark file, so you can import it into nearly any web browser, but you'll end up with lots of weird duplicates because Delicious uses tags and the Netscape bookmarks format uses (virtual) folders.

When in doubt, add more globals.

2010-12-17T00:00:00-05:00

EXPERIMENTAL CODE AHEAD

Last week, I wrote about the highly experimental DNS::Oterica. This week, I'll be talking about the dangerously experimental Global::Context.

The Law of Demeter Sucks

Actually, I'm a pretty firm believer in at least a modified form of the Law of Demeter in designing systems, but sometimes you really need a global. Sometimes the only alternative to a global is inversion of control, a fairly complex pattern to implement. That doesn't mean that globals are always a better choice than IOC, just that both are choices. (Like many other often-lousy program choices, global variables have been more maligned than they deserve. They deserve to be disliked, but maybe not quite demonized.)

Years ago, we wanted to run all code inside of dynamic scopes that would provide "context" for the call. We called the notional project Class::Contexual. Context would tell us things like what user had initiated the request, from what IP, and what URL had been hit. This wouldn't just be part of our web framework, though. Scripts run by the customer service staff would provide the same kind of context.

Since we'd always have the same kind of context, we could always check permissions by using a single authorization system built into the user class. When logging, we'd always know where requests came from. The important thing was that we'd always have a context, and the context would be the same type of object everywhere. Our notional API looked something like:

`1:  2:  3:  4:  5:  6:  7: `	`sub do_stuff {   my ($self, @args) = @_;   X::Permission->throw unless $self->context->user->can_do_stuff;   $self->with_more_context({ action => 'doing stuff' })->do_else; }`

Then, do_else would be called on some clone of $self that differed only in context.

The whole thing got really messy really quick, and eventually we abandoned the idea and just stuck to looking at the web request.

Years later, the idea kept coming up here and there as a solution to a number of different problems. We finally said, "You know what? This is just what global variables are for." After all, the context is describing the global execution context. It's only for code that we have written and run internally, and isn't going to be consumed by general publicly distributed code.

We even made sure that the global context system could be re-used by multiple sets of libraries in a single process by making the specific global variable used pluggable. That is, two different systems could use the global context system without clobbering each others context. With that much safety ensured, the next question was just what we needed in our context.

The Content of The Context

We decided that for any given action, we'd only care about a few things:

a handle for performing authorization checks; the auth Token
a record of where the request came from (via email? the web? what IP?); the request's Terminal
a simple stack of how the request came in and got routed; the Stack

Auth token could come in all forms. We might get a web request from a user with a logged-in session identified in his cookie. We might get an OAuth signed request with a token associated with a user and a subset of that user's rights. The token might even just represent "being run by employee rjbs who has superuser privileges." What we do know is that it isn't going to change one we get it. Every request has exactly one valid token, and once we have it, we don't change it. Tokens are associated with users.

The terminal, too, is pretty straightforward. We can tell, looking at the web request or the console program being run, where the request came from. Once we know that, it never needs to change.

Both the token and the terminal can be represented by URIs, although we might want to use private URI schemas for them: myapp://token/websession/1234

The stack isn't very complicated, either. It's an array of frames, and each frame doesn't need much more than a name. Imagine that user on the web has uploaded a list of contacts to add to his address book. We might have the following context, when we get to the underlying code that's going to do the import:

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`token:   uri : myapp://token/websession/1234   user: MyApp::User object terminal:   uri : ip://1.2.3.4 stack:   - account setup wizard   - address book manager   - contact importer`

The stack can add and drop frames as the program runs and execution enters and exits subroutines. We don't tie the context's stack to the program's stack one-to-one, because that would make refactoring the code much more complicated. Instead, we can just add frames dynamically, and Perl will pop them off when we leave that part of the program.

We get that benefit by making the context object a real old-fashioned global variable that can be localized with local.

Putting Things into Context

A simple program that uses Global::Context might look something like this:

`1:  2:  3:  4:  5:  6: `	`use Global::Context -all, '$Context'; ctx_init({   terminal => 'ip://1.2.3.4',   auth_token => 'myapp://token/websession/123', });`

This imports a $Context global and initializes it by calling ctx_init. If some other part of the program has already initialized the context, an exception is thrown -- once we've set up the starting context, we're only supposed to replace it locally. For example, if our first action is to decide to route down into the setup wizard, we might write this:

`1:  2:  3:  4:  5:  6:  7:  8: `	`# our request is routed to the setup wizard: if ( ... ) {   local $Context = ctx_push("account setup wizard");   $wizard->process_request( $r ); } $Logger->log("program complete");`

That's it! We've pushed a frame onto the stack. $Context is now a new object, identical to what it was before, safe for the extra stack frame. We can keep pushing onto the stack as we descend through our program -- or we can leave it untouched. As we go back up the frame, the previous value is restored. For example, by the time we're logging "program complete," above, the "account setup wizard" stack frame is gone.

This works because we've made sure that every part of the context is immutable. Nothing that we change at a deeper scope will be changed and then lost when we exit that scope. The only allowable change is the addition of stack frames.

Marrying the context to logging make it easy for any part of the program to mention, in its, logs, why it's doing something, without changing its API at all to allow caller info to be passed in. That is, we can take some deep, crufty old routine and make it tell us exactly why it's doing something dangerous:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	`sub __randomize_user_password {   my ($self, $enc, $str, $dig, $_uk1, $uk_3, $uk_2, @rest) = @_; # log exactly why we're going to do this: $Logger->log([     "randomizing user password for %s because of %s",     $self->user_id,     $Context->as_json,   ]);   $self->password = re_enc($uk1, ...); }`

Specialized Context

Token, terminal, and stack behavior are all implemented as roles. Because it's pretty likely that different users of a system like Global::Context would want to allow different kinds of token, users, and so on, it's easy to subclass any part of the system with more specific restrictions.

If the only kind of terminal you want to support is a web browser, you can write a single Terminal class and require that the context object's terminal attribute be a member of it.

The Future

The future of this totally untested software (and idea) is, well, to be tested. It's a design we've been thinking about for quite some time, but it needs to see some real combat. After that, it will probably either fail and never be seen again, or it will stick and simplify large amounts of our code.

Dealing with an Oversized Interface

2010-12-16T00:00:00-05:00

Too Many Methods

At OSCON this year, I had the great pleasure of presenting a tutorial on Moose. Afterward, a fellow from a large Perl-based project approached me and said, "Moose looks fantastic, but right now our code base is built around a really small number of gigantic classes that we need to refactor slowly. We can't just replace the whole system with Moose. How can we go about doing that?"

The question really pleased me, because it was a question we'd also had to deal with, and we'd found a few good answers that really helped us make progress on our situation. For example, two of our important classes have over five hundred methods each, and are backed by database tables with way too many fields.

Rewriting these classes entirely would be completely insane. The Big Rewrite is sometimes a valid approach, but here it would have been a big time sink, since way too much code would also need rewriting to deal with a new interface without the same five hundred methods. We made some first attempts with replacement classes that could get the old-interface object as needed, but this ended up just meaning that we had six hundred methods. It wasn't targeted enough at cutting down on the amount of crap we'd shoved into one place.

Divide and Delegate

Our next strategy was to identify groups of methods that all addressed a single area of concern. One of the first targets for this kind of refactoring was the code that let you subscribe or unsubscribe from a mailing list. There were a few enormous methods and dozens of goofy little ones scattered here and there. It provided a weird set of entry points with semantics that varied between them.

We wanted to take all that code, give it a small set of entry points with simple semantics, and get it the heck out of our existing, overcrowded classes. We made a new SubscriptionManager class and wrote all our new methods there. Then we'd delegate all the old calls to the new subscriptions subsystem. So, for example, our old code that looked like this:

`1: `	`my ($member, $error) = $list->subscribe($email_address, { ... });`

...could now look like...

`1: `	`my $member = try { $list->subs_mgr->subscribe($email_address, { ... }) };`

The actual conversion of old calls to new was somewhat tedious. First, grep for the old method names and switch them over. Next, delete all the old methods and see what breaks. Fix those and repeat.

The Spoils of Refactoring

Some of the benefits of this refactoring are obvious: we were able to change the old code to make more sense; we moved methods into smaller libraries, making them easier to understand at a glance; we reduced the size of an overly-large interface. These were all very nice changes, but the second order of benefits were great.

For example, because the SubscriptionManager was its own class, it could be written with different class-building tools than the big, old class. Namely, it could be Moose. It had to manage some persistent settings, like configuration about each mailing list's subscription policies. Previously, these were all stored in the Big Class's Big Table. Now that we broke out of the big class, we could put them somewhere else. I've already written about breaking up big tables, and that's just what we did.

Now we still had a big complicated class, but it was just a little less complicated. It had delegated a bunch of its work to a smaller class, written more cohesively, storing all its data in a little branch of a Data::Hive, but what if we wanted to move back to using relational storage in the future? What if we wanted to write a new set of behavior for the subscription manager? This had also become trivial!

Look at the second (new) code sample, above, and you'll see a call to a subs_mgr method, which obviously returns the subscription manager object. What does that method look like? Something like this:

`1:  2:  3:  4:  5: `	`sub subs_mgr {   my ($self) = @_;   my $subs_mgr = MLM::SubscriptionManager->new({ list => $self }); }`

It doesn't need to, though. We could instead write it like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	`sub subs_mgr {   my ($self) = @_;   my $subs_mgr_class = $self->subs_mgr_class;   Class::Load::load_class( $subs_mgr_class );   confess "$subs_mgr_class isn't a valid subscription manager"     unless $subs_mgr_class->DOES( 'MLM::Role::SubscriptionManager' );   my $subs_mgr = $subs_mgr_class->new({ list => $self }); }`

What's the big difference? Well, now different lists can have different return values from subs_mgr_class, so they can have radically different behavior -- but they still have to promise to implement the right role. We started with this built in, and it made the refactoring much easier.

Our first implementation of the subscription subsystem could just keep using the old table for its storage, and then as lists were upgraded to the subscription backend, they were switched to use a class with settings stored in the hive.

Making Success Repeatable

This kind of refactoring was so successful, with so many side benefits, that we worked to make it easy to perform over and over, by factoring out this "subsystem pattern" into a reusable library: Role::Subsystem.

The way you use it is simple. First, you include Role::Subsystem in the class you want to be a subsystem, like our subscription manager; then you tell the main class how to get a subsystem object. Our subscription manager class might look like this:

`1:  2:  3:  4:  5:  6: `	`package MLM::SubscriptionManager; use Moose; with('MLM::Role::SubscriptionManager'); sub get_subscriber_policy { ... }`

Okay, so that's not very interesting -- as I said above, we put the actual subsystem stuff in a role:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25: `	package MLM::Role::SubscriptionManager; use Moose::Role; with 'Role::Subsystem' => {   ident => __PACKAGE__,   type => 'MLM::List',   what => 'list',   getter => sub { MLM::List->retrieve($_[0]) }, }; requires 'get_subscriber_policy'; has subscription_policy => (   ...,   init_arg => undef,   builder => 'get_subscriber_policy', ); sub subscribe {   my ($self, $email_address) = @_;   if ( $self->list->is_disabled ) { ... }   if ( $self->subscription_policy eq 'open' ) { ... } }

For the most part, this is pretty stock Moose code. We have some attributes and methods. We provide a subscription_policy method, but its initial value will have to be provided by the class, which can do something like look in a database table or hive.

The two things of note are the inclusion of the Role::Subsystem role and the call to the list method on line 22. It should be pretty obvious that the list method gets the mailing list that the subscription manager belongs to, but where does it get that method? It's set up, along with a lot of other useful behavior, by Role::Subsystem.

Let's look at it line by line:

`1:  2:  3:  4:  5:  6: `	`with 'Role::Subsystem' => {   ident => __PACKAGE__,   type => 'MLM::List',   what => 'list',   getter => sub { MLM::List->retrieve($_[0]) }, };`

This says: "I am a subsystem known as (the current package's name). I expect to be a delegate for an object of type MLM::List, which I'll store in my list attribute. If I only have the object's identifier, and not an object, I can get it with this subroutine."

So, when we want a particular manager, we can say:

`1: `	`MLM::SubscriptionManager->new({ list => $list });`

Role::Subsystem provides some shortcuts, though:

`1:  2:  3: `	`MLM::SubscriptionManager->for_list($list); MLM::SubscriptionManager->for_list_id( 1234 );`

The first form's behavior should be obvious. It's great for putting in the subs_mgr method we wrote earlier, and is really clear.

The second one might be less straightforward. It lets us get the subscription manager for a list that we haven't instantiated! If it's very expensive to get a list, it might be a much better idea to just get the subsystem of it that we need. If someone calls a method that needs the list object iself, it will call the list method on the subsystem, which will lazily get the list using the getter we provided.

This library might seem like it's performing only a very simple task, but you might be surprised at how useful it is. See, the task it's performing is simple, but it's also boring. By making it extremely easy to make these kinds of delegates, it's much more likely that code will get refactored into subsystems as soon as it's useful. If this kind of refactoring requires boring slogging through extra delegation code, it will probably get put off until it's absolutely essential -- and that means it will probably be pretty painful.

Under the Hood

Role::Subsystem is a parameterized role, and something of an abuse of parameterized roles. While I won't get into the implementation here, the source code might be interesting to some, especially the bits about getters and weak reference management.

Lovingly Mass-Produced HTML

2010-12-15T00:00:00-05:00

Hand-Crafted Bugs

One of my goals at work has been to grossly reduce the amount of HTML that our HTML Guy writes. Every time he writes more lines of HTML than are absolutely necessary, it's a failure. This shouldn't be a weird idea, because HTML is code, and any time anybody writes more code than is needed to clearly express an idea, it's more likely to have mistakes. For example, there's this input:

`1: `	`<input id='foo' value='bar'></input>`

Well, this input won't work as part of a form, because there's no name attribute that tells the value how to get into the form. Then there's the incredibly tedious generation of radio buttons partly in HTML and partly in Perl:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	`%# This example uses Mason, because that's what I use. -- rjbs, 2010-12-12 % my %options = ( % yes => 1, % no => 0, % maybe => -1, % ); % for my $option (%options) { % my $value = $options{ $option }; % my $selected = $ARGS{is_jolly} eq $value ? q{selected='selected'} : q{};     <input type='radio' name='is_jolly' <% $selected %> value='<% $value %>'></input> <% $option %> % }`

Building HTML like this over and over is just horrible, and it gets worse when the people producing the HTML aren't also expected to be very good Perl programmers. There needs, instead, to be a very simple way to say things like, "and then I want a radio button" -- because "we'll just be very careful each time" is not a viable strategy for anything in programming, and especially not anything boring that gets done frequently. The right solution is, as usual, "build a reusable component."

What we wanted was to provide a simple way to say, "make a radio button here" and always get the right thing -- and to make it easy enough to provide custom tweaks that we'd almost never have to resort to hand-written HTML.

We built HTML::Widget::Factory, which serves as a hub for plugins that build HTML. For example, consider that gross radio-button-building example, above. We had a list of options, %options, and the value of the currently selected one in %ARGS. We ignored a bunch of considerations like option ordering, or warning that would arise if the existing is_jolly argument was undef, because they would have made the example even uglier. The widget factory does deal with those problems, but the code looks fine, because it's abstracted away:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`my $factory = HTML::Widget::Factory->new; print $factory->radio({   name => 'is_jolly',   selected => $ARGS{is_jolly},   options => [     [ yes => 1 ],     [ no => 0 ],     [ maybe => -1 ],   ], });`

We work primarily with Mason, and have added a factory to our HTML::Mason::Request subclass, so in a component, we'd write the above as:

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`<% $m->widget->radio({   name => 'is_jolly',   selected => $ARGS{is_jolly},   options => [     [ yes => 1 ],     [ no => 0 ],     [ maybe => -1 ],   ], }) %>`

Or we could set up a bunch of checkboxes:

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`my @properties = qw( is_jolly is_naughty is_sleeping celebrates_christmas ); for my $prop (@properties) {   print $m->widget->checkbox({     id => $prop,     value => 1,     checked => $user->$prop   }); }`

Part of the factory's job way of making things easy to get right is in filling in all the boring attributes the right way. For example, we gave an attribute id, but not a name. The name will default to the id. The checked value is just a boolean that results in either checked="checked" or nothing. This kind of behavior is all over: text gets HTML escaped, common element attributes (like id, class, and others) are handled for you, and so on.

If you have to pass something weird into the produced element, you can often put it into the attr argument:

`1:  2:  3:  4:  5:  6:  7: `	`$factory->input({   name => 'stocking_position',   attr => {     usemap => $image_map,     accesskey => 'S',   }, });`

Adding New Products to the Factory

Everything that the factory produces comes out of a plugin. There are a bunch of really useful plugins, but it's easy to write more. This is the source for one of the simpler plugins, used to generate textarea elements:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22: `	package HTML::Widget::Plugin::Textarea; use parent 'HTML::Widget::Plugin'; use HTML::Element; sub provided_widgets { qw(textarea) } sub _attribute_args { qw(disabled id) } sub _boolean_args { qw(disabled) } sub textarea {   my ($self, $factory, $arg) = @_;   $arg->{attr}{name} = $arg->{attr}{id} if not defined $arg->{attr}{name};   my $widget = HTML::Element->new('textarea');   $widget->attr($_ => $arg->{attr}{$_}) for keys %{ $arg->{attr} };   $widget->push_content($arg->{value});   return $widget->as_XML; }

When you call the textarea method on a factory with this plugin, the arguments are rewritten in light of the _attribute_args and _boolean_args given. Boolean args produce those weird x='x' things expected for true values in HTML, and attribute args are then merged directly into the attr argument described above. The textarea method gets called with the rewritten args and is expected to return HTML.

Notice that the method gets passed $factory, the object on which textarea actually got called. This means that you can write widget plugins defined in terms of other widgets. For example, the (non-core) plugin HTML::Widget::Plugin::Struct takes a Perl data structure and turns it into a bunch of hidden form inputs that can be reconstructed into the data structure by CGI::Expand. For example, it can turn:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`my $struct = {   name => 'Edwin Ample',   favorite => {     pie => 'apple',     movie => 'Elf',     fowl => 'duck',   },   siblings => [ qw(Elmer Ebenezer Eric) ], }; $factory->struct({ name => 'person', value => $struct });`

...into...

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`<input type='hidden' name='person.name' value='Edwin Ample' /> <input type='hidden' name='person.favorite.pie' value='apple' /> <input type='hidden' name='person.favorite.movie' value='Elf' /> <input type='hidden' name='person.favorite.fowl' value='duck' /> <input type='hidden' name='person.siblings.0' value='Elmer' /> <input type='hidden' name='person.siblings.1' value='Ebenezer' /> <input type='hidden' name='person.siblings.2' value='Eric' />`

It does that by repeatedly calling the hidden method on the factory, so it gets exactly the same kind of hidden inputs that the rest of our code does -- and the thing producing those inputs can be replaced if we want all our hidden inputs to have different properties, like using end tags instead of /> empty tag markers.

Because the struct widget is implemented by a class, we can do things like subclass the struct widget to make an editable struct (maybe by turning array entries into multiselects and everything else into normal inputs), or do emit a script element with a JavaScript representation of the structure in it.

In the end, we can get all kinds of uniform, bug-free content produced with a nice, simple interface.

Experiments and Annoyances

One early complaint we got internally about the factory was that it had too many quirks because of how Mason and Perl were interacting, and that it would be better if the widgets all worked like Mason components. In response, Dieter Pearcey wrote the excellent MasonX::Resolver::WidgetFactory, which exposed a Mason component-like interface, allowing code like this:

`1: `	`<& /w/select, id => "myselect", options => \@options &>`

Then, we added MasonX::Resolver::Multiplex, which let us say that things found under /w would look first in on disk and then in the widget factory. This meant we could let the HTML authors write simple widgets as basic Mason components, and then alter we could turn them into faster or more reusable Perl plugins, and the interface wouldn't need to change.

Unfortunately, Mason's caching layer would break on this sometimes, because widget factories are blessed into weirdly-named, auto-generated classes in order to resolve methods like textarea to the right plugin. These names might change or be generated in the wrong runtime order, breaking things that have cached objets blessed into them.

This is a surmountable problem, although tedious and annoying, so we haven't addressed it yet. It's one of the places where Perl's lack of per-instance method resolution really becomes a hinderance. Instead, we were forced to ask HTML Guy to suck it up, for now, and use $m->widget.

Before the end of Advent, I'll talk about potential solutions to this kind of problem.

Wanted: Gift, Got: Gift

2010-12-14T00:00:00-05:00

The Case of the Invisible Differences

I've seen this kind of output from test programs more than I'd like to remember:

`1:  2:  3:  4:  5:  6:  7: `	`not ok 6172 - sent expected message # Failed test 'sent expected message' # at t/omnibus.t line 1938. # got: 'Foo. # ' # expected: 'Foo. # '`

You'll stare at that for a long time before having the clever idea of piping the test through cat -A -- only to find that you're only expecting a carriage return and newline, but you're getting a newline. After the hundredth time, you learn to bring cat -A into play as soon as you see this kind of weird test result, and lesson helps. The problem is that it doesn't help when diagnosing CPAN Testers reports from your code running on SqueeOS True56, a platform that you've never heard of and that nobody knows the line endings for. What's going on with the output? You can't say, so you contact the smoker and ask him to re-run the tests and tell you what the bytes in question are, but it's a pretty lousy approach. The solution is to fix the diagnostic messages to show you everything that might be relevant.

Test::BinaryData replaces the usual "have X, want Y" diagnostic with output inspired by xxd. The above test would have produced:

`1:  2:  3:  4: `	`not ok 6172 - sent expected message # Failed test at t/omnibus.t line 1938. # have (hex) have want (hex) want # 466f6f2e0d0a------------ Foo... ! 466f6f2e0a-------------- Foo..`

It's pretty obvious, here, what happened. There's an extra byte in the "have," and a quick glance at the compared lines shows that the bogus byte is an 0x0d before the shared 0x0a.

If we've got a bunch of identical content before the difference, we get leading content for context:

`1:  2:  3:  4:  5:  6:  7:  8: `	# have (hex) have want (hex) want # 310d0a320d0a330d0a340d0a 1..2..3..4.. = 310d0a320d0a330d0a340d0a 1..2..3..4.. # 350d0a360d0a540d0a380d0a 5..6..T..8.. ! 350d0a360d0a370d0a380d0a 5..6..7..8.. # 390d0a31300d0a31310d0a31 9..10..11..1 = 390d0a31300d0a31310d0a31 9..10..11..1 # 320d0a31330d0a31340d0a31 2..13..14..1 = 320d0a31330d0a31340d0a31 2..13..14..1 # 350d0a31360d0a31370d0a31 5..16..17..1 = 350d0a31360d0a31370d0a31 5..16..17..1 # 380d0a31390d0a32300d0a32 8..19..20..2 ! 380d0a31390d0a32300a3231 8..19..20.21 # 31---------------------- 1 ! ------------------------

The column between the have and want signs shows you the relationship of the two subsequences: either they are equal (=) or they are not (!).

Comparing Encoded Text

Originally, I wrote this module exclusively for comparing line endings. It had obvious applications for testing the results of encoding text strings, but I didn't know much about encoding at the time. Once I became further mired in encoding issues, though, I came back to Test::BinaryData and found it really useful. For example, why did performing the same operation from different operating systems fail, with no visible differences?

`1:  2:  3: `	`# have (hex) have want (hex) want # 517565656e7372c3bf636865 Queensr..che ! 517565656e737279cc886368 Queensry..ch # ------------------------ ! 65---------------------- e`

Both encode the name of Queensrÿche, complete with heavy metal umlaut, but the byte sequences differ. The first is LATIN SMALL LETTER Y WITH DIAERESIS, but the second is a combining sequence: LATIN SMALL LETTER Y, followed by COMBINING DIAERESIS.

These forms are identical when read, but of course computers will see them differently, and this can cause really bizarre, awful bugs. As a side note, this kind of bug led me to find Unicode::Normalize, which is something any programmer dealing with "funny characters" should know about.

Test::BinaryData is meant to compare byte strings, and will reject any comparison when either side of it contains "wide characters" -- a sign that the content is probably a non-encoded character string. And anyway, cramming a four-character "byte" into the diagnostic display wouldn't work!

All Marked Up with No Place to Go

2010-12-13T00:00:00-05:00

NOT ON THE CPAN

Today's article is about code not found on the CPAN.

Talk, talk, talk!

For the past few years, I've given quite a few technical talks at YAPC, OSCON, and other conferences. I really enjoy doing this, and I like to think I've gotten fairly good at producing good slides to illustrate the things I'm discussing. Since the initial release of Apple Keynote, I've been using it for nearly all of my slide construction, and I like it quite a bit, but every once in a while I run into one of its shortcomings.

Although Keynote can be scripted with AppleScript, I've found that its scripting facilities are pretty weak, and they've never been sufficient to let me do what I want. Sometimes, this means I skip doing something, and sometimes it means I find a very convoluted way to achieve my goals using only Keynote's stock features.

One of the things that's left me most frustrated, though, is my inability to automatically syntax highlight source code on slides. When you're displaying fifteen lines of code on a big screen to people sitting in an amphiteater, syntax highlighting can be a huge help for readability. Just compare this plain code:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18: `	`package Counter; use MooseX::POE; has count => (   is => 'rw',   default => sub { 0 }, ); sub START {   my ($self) = @_;   $self->yield('increment'); } event increment => sub {   my ($self) = @_;   print "Count is now " . $self->count . "\n";   $self->count( $self->count + 1 );   $self->yield('increment') unless $self->count > 3; };`

...to this syntax highlighted code:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18: `	`package Counter; use MooseX::POE; has count => (   is => 'rw',   default => sub { 0 }, ); sub START {   my ($self) = @_;   $self->yield('increment'); } event increment => sub {   my ($self) = @_;   print "Count is now " . $self->count . "\n";   $self->count( $self->count + 1 );   $self->yield('increment') unless $self->count > 3; };`

Adding syntax highlighting seemed like it would be a huge win, and would be useful to quite a few people, so I decided to undertake the endeavor. I knew that like many OS X apps (at the time, at least), Keynote was using RTF to store the rich text of slides. If I could produce RTF syntax highlighted code, I could get it into Keynote and be done!

Making Stew from the CPAN

In the end, making the RTF -- which I'd assumed would be the most difficult part of the job -- was pretty simple. The thing that made it simple, as with so many things in Perl, was the CPAN. All I needed to do was find the right set of modules and figure out how to tie them together. What follows is a run-through of the code-to-RTF program I produced.

First, we load the libraries we'll need:

`1:  2:  3:  4:  5:  6:  7: `	`use strict; use warnings; use Getopt::Long::Descriptive; use Graphics::ColorUtils qw(name2rgb); use RTF::Writer; use Text::VimColor;`

Everybody remember Getopt::Long::Descriptive? Good. We're going to use that to get some very basic options:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	my ($opt, $usage) = describe_options(   '%c %o <filename>',   [ 'help\|h', 'display this message' ],   [ 'filetype\|ft\|f=s', 'filetype; Vim guesses by default' ],   [ 'font-face\|F=s', 'font face to use; defaults to Courier New',                        { default => 'Courier New' } ],   [ 'font-size\|Z=i', 'font size to use, in points; defaults to 14',                        { default => 14 } ], ); $usage->die if $opt->{help} or @ARGV != 1;

The --filetype option is important, because it tells us what kind of syntax to highlight. After all, I have been known to include non-Perl code in my slides, once in a while.

`1:  2:  3:  4: `	`my $syn = Text::VimColor->new(   file => $ARGV[0],   ($opt->{filetype} ? (filetype => $opt->{filetype}) : ()), );`

Here, we use one of my favorite modules. I only use it very occasionally, but it always saves quite a lot of time. While there are a number of syntax highlighting libraries on the CPAN, they often strike me as experimental or awkward to use. Vim, on the other hand, does a pretty good job with many different languages, and Text::VimColor lets us get exactly the coloring that Vim would have used. Even better, we'll be able to get at the syntax highlighted document as a list of substrings of the document, each with a syntax type, something like this:

  $VAR1 = [
    [ Statement  =&gt; &#39;my&#39;      ],
    [ &#39;&#39;         =&gt; &#39; &#39;       ],
    [ Identifier =&gt; &#39;$syntax&#39; ],
    [ &#39;&#39;         =&gt; &#39; = &#39;     ],
    ...
  ];

With our input primed in $syn, it's time to prime our output mechanism with RTF::Writer:

`1:  2:  3:  4:  5: `	`my $rtf = RTF::Writer->new_to_string( \my $str ); local $RTF::Writer::Escape[ ord('-') ] = '-'; local $RTF::Writer::AUTO_NL = 0;`

We've initialized our RTF::Writer so that as it writes out text, it puts it in an in-memory buffer. We're not going to be doing anything gargantuan, and thinking about temporary files is always a drag. Then we have to futz around with some settings to tweak out output. We prevent the replacement of hyphens with "non-breaking hypens" because Apple's RTF implementation doesn't seem to understand them, and we preserve the location of newlines so that we can skim our output RTF by eye to look for problems.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	`$rtf->prolog(   fonts => [ $opt->{font_face} ],   colors => [ all_colors() ], ); my $hp_size = $opt->{font_size} * 2; # RTF uses half-points for font size # Set size, font, and background color. $rtf->print(   \"\\fs$hp_size\\f0",   color_controls_for('Normal') );`

Now we've set up the RTF prolog, which tells future readers in advance what fonts and colors will be used in the document. We scale up to RTF's weird "half point" font sizing, and get into our starting format by setting up our font size and colors by printing some raw RTF commands. \fs sets font size, \f sets font, and \c sets the color. Where do all_colors and color_controls_for come from? We'll get back to those in a bit.

At this point, we've loaded in a stream of syntax-marked text hunks and we've got an RTF output stream ready to go. All we have to do is read, transform, and print -- the Platonic Perl Program:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10: `	`my $tokens = $syn->marked; while (my $pair = shift @$tokens) {   my ($type, $text) = @$pair;   $rtf->print(     color_controls_for($type), " ",     $text,   ); }`

That's it! @$tokens is our input, each entry a pair of "type" and "text" values. For each one, we spit out a color command, terminated by a space, and then the text. We don't need to worry about anything else, because we've picked a monospace font and RTF won't try to mangle our whitespace. (Thanks, RTF!) We can just finalize the RTF document and print out the buffer to which it was written:

`1:  2:  3: `	`$rtf->close; print $str;`

So, that's the whole program -- save for color handling -- in about 45 significant lines.

It turns out that almost all of the work was in reading the Vim color scheme file!

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24: `	my %color_pos; my @colors; BEGIN {   my %color = groups_from_file("$ENV{HOME}/.vim/colors/manxome.vim");   $color{Normal} \|\|= {};   $color{Normal}{bg} \|\|= [ 0, 0, 0 ];   $color{Normal}{fg} \|\|= [ 127, 127, 127 ];   for my $group (keys %color) {     for my $which (qw(fg bg)) {       next unless my $rgb = $color{ $group }{ $which };       my $pos = $color_pos{ join('-', @$rgb) };       unless (defined $pos) {         push @colors, $rgb;         $pos = $color_pos{ join('-', @$rgb) } = $#colors;       }       $color_pos{ "$group:$which" } = $pos;     }   } }

We read in the syntax highlighting groups from a given file -- here, my personal Vim color scheme -- and save everything as two entries in a hash. The keys are names like Identifier:fg and Identifier:bg, and the values are numbers -- because in RTF, we always refer to colors by their position in the index of colors, like this:

`1: `	`\line \cf0 \cb3 This text is color 0 on color 3! \line`

So this code has to set up the index and make sure all the possible names refer back to index positions. The color index looks like this:

`1:  2:  3:  4:  5: `	`{\colortbl \red0\green170\blue0;\red0\green0\blue0;\red170\green170\blue170; \red255\green255\blue0;\red255\green0\blue0;\red0\green170\blue170; \red255\green255\blue255;\red0\green0\blue255;\red170\green0\blue0; \red0\green255\blue0;\red255\green0\blue255;\red0\green255\blue255; \red0\green0\blue238;\red204\green204\blue204;}`

...so we need to get all our colors into RGB values, but in Vim color schemes, we're free to use named colors, like "SlateBlue." We'll resolve these with Graphics::ColorUtils, a weird little module that turns out to be really handy once in a while.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29:  30:  31:  32:  33:  34:  35:  36:  37:  38:  39:  40:  41: `	sub groups_from_file {   my ($filename) = @_;   open my $fh, '<', $filename or die "couldn't open $filename to read: $!";   my %color;   LINE: while (my $line = <$fh>) {     chomp $line;     $line =~ s/\A\s+//;     next LINE unless $line =~ /\Ahi(?:ghlight)?/;     my ($group) = $line =~ /\Ahi(?:ghlight)?\s+(\w+)/;     my %attr;     if (my ($fg) = $line =~ /guifg=(\S+)/) {       $attr{fg} = color_to_rgb($1);     }     if (my ($bg) = $line =~ /guibg=(\S+)/) {       $attr{bg} = color_to_rgb($bg);     }     $color{ $group } = \%attr;   }   return %color; } sub color_to_rgb {   my ($str) = @_;   if ($str =~ /#([0-9a-f]{6})/i) {     return [ map { hex } unpack "(a2)*", $1 ]   } else {     my @rgb = name2rgb($str); # <-- from Graphics::ColorUtils     return unless @rgb;     return \@rgb;   } }

Also note that for some bizarre reason I chose to use unpack, above. It's actually the only form of unpack that I know how to use.

Finally, we get to the heart of the matter:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15: `	sub all_colors { @colors } sub color_controls_for {   my ($group) = @_;   my $ctrl = '';   for (qw(f b)) {     $ctrl .= "\\c$_"           . (defined $color_pos{"$group:${_}g"}              ? $color_pos{"$group:${_}g"}              : $color_pos{"Normal:${_}g"});   }   return \$ctrl; }

all_colors returns a list of RGB arrayrefs to be used as the color index, and color_controls_for returns an RTF command sequence to switch to the color for the given group.

The Proof of the Stew is in the Eating

I got this code written pretty quickly, and felt pretty good about it. It didn't do anything clever or tricky, it just tied together a few simple CPAN modules to perform a simple text transformation, and it worked! Those are the qualities I like to end up with in my code: simple, straightforward, mostly implemented in terms of other libraries, and working. You can look at some sample output, if you want, too.

From here, things should have been simple. I'd write some AppleScript like this (forgive my pseudo-AppleScript):

`1:  2:  3:  4:  5:  6:  7: `	`tell application Keynote   get body of current slide   write body to file with path P   execute shell command "synrtf P > P.rtf"   set rtf to (read file with path (P & ".rtf"))   set body of current slide to rtf end tell`

Well, it turns out that you can't address the formatting of slides in Keynote, at all. You also can't address anything on the slide that isn't the main body -- and the main body has several behaviors that differ from other shapes with text. I could've resorted to GUI-level automation to do things like:

assume that the current text object is the target
simulate Cmd-A, Cmd-C to select all text and copy it
run synrtf using pbclip to get pasteboard contents
get synrtf output and put it on the pasteboard
simulate pressing Cmd-V to paste the formatted text

It was pretty clear by this point, though, that all the work lay ahead of me would be boring drudgery, and that I could just quit now and feel good about the RTF bits, maybe to revisit them later, when Keynote's automation improved.

I'm sorry to report that now, three years later, the automation hasn't gotten any better, and it no longer uses RTF. I don't see myself switching away from Keynote, despite that, but maybe synrtf, or some of the code it shows off, will be useful to someone else the way I'd hoped the original project would be.

One People, One Address Book

2010-12-12T00:00:00-05:00

Centralizing Your Config

I used to be really lousy at keeping track of people's info. I had a text file with a bunch of people's email addresses, and sometimes phone numbers. Other addresses were in my mutt alias file, and others I'd find by searching my Maildir as needed. Phone numbers were either in memory, on paper, or in my cell phone's memory. Any time I looked at fixing this, I was frustrated by lousy tools and lousy tool integration. If I wanted to put everything into Thunderbird, I could, but then... well, I'd be stuck using Thunderbird.

When I started using Mac OS X heavily, I started using the Apple Address Book pretty heavily, too. My cell phone supported iSync, so I could get all my phone numbers onto my cell effortlessly, which was fantastic. I started to load in everything else, and found it to be a totally reasonable program for managing my addresses. If I had been using Apple's Mail program, it would have also provided lots of configuration for free, like whitelisting and address autocompletion. There was just one problem: I absolutely could not tolerate Apple's Mail.

I wanted to keep using mutt, and Spam Assassin, and other disparate tools, all with configuration drawn from my address book. The solution was addex.

Addex talks to an address book -- any kind for which you care to provide an adapter -- and has plugins that do stuff with your address book entries. For example, my addex.ini config file looks something liket his:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`addressbook = App::Addex::AddressBook::Apple output = App::Addex::Output::Mutt output = App::Addex::Output::SpamAssassin output = AddexYAML [App::Addex::Output::Mutt] filename = mutt/alias-abook [AddexYAML] filename = abook.yaml [App::Addex::Output::SpamAssassin] filename = spamassassin/whitelists-abook`

The program will acquire address book entries from App::Addex::AddressBook::Apple and then use a bunch of different output plugins to produce things like mutt configuration, Spam Assassin whitelists, and some random YAML file that one of my personal mail filters uses. Addex ships with a number of these output plugins, but it's easy to write your own. That AddexYAML plugin, for example, helps my Email::Filter program decide how to file mail. There's a block in it that looks like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10: `	my ($email_address) = Email::Address->parse($this->from); if ($email_address and my $from_addr = lc $email_address->address) {   my ($addex_dest) = YAML::Syck::LoadFile("$ENV{HOME}/.brita/abook.yaml");   $addex_dest->{ lc $_ } = delete $addex_dest->{ $_ } for keys %$addex_dest;   if (my $folder = $addex_dest->{ $from_addr }) {     $dest .= ".$folder/";     _log "Delivering to: $dest";     $this->accept($dest);   } }

If there's a delivery destination for a given sender, the mail goes there instead of into my default folder. The abook.yaml file gets produced by this really simple plugin that took five minutes to write:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29: `	package AddexYAML; use base qw(App::Addex::Output::ToFile); use YAML::Syck (); sub process_entry {   my ($self, $addex, $entry) = @_;   my $s = $self->{_struct} \|\|= {};   return unless my $folder = $entry->field('folder');   $folder =~ tr{/}{.};   my @emails = grep { $_->sends } $entry->emails;   for my $email (@emails) {     if ($s->{ $email } and $s->{ $email } ne $folder) {       warn "conflict on email <$email>: '$s->{ $email }' vs. '$folder'\n";     }     $s->{ $email } = $folder;   } } sub finalize {   my ($self) = @_;   $self->output(YAML::Syck::Dump($self->{_struct}));   $self->SUPER::finalize; }

The process_entry method is called for every address book entry, and builds up a map of email addresses to folder names. When it's processed every entry, it spits out a YAML dump of the mapping. It extends App::Addex::Output::ToFile, which takes care of the boring parts of file construction.

So, what are address book entry objects, and where do they come from?

Entries and Address Books

Entries are simple. Every entry represents a person or contact. It has a name, one or more email addresses, and a hash of other miscellaneous fields. Every email address has a label, for things like "home" or "work" email addresses. The fields are just key/value pairs, and get used by things like the YAML plugin above, to provide arbitrary extra information. The "folder" field might say to which folder mail should be delivered. There's another field used to pick the default email address for an entry (instead of the default of "home.")

The entries come from address book plugins, which really only need to provide one method: entries, which must return a list of entries. My original target was Apple's Address Book, of course, which I talked to with Chris Nandor's spectacular Mac::Glue library. Things like an entry's name and email addresses are pretty unambiguous, there, but what about the "fields" for things like "folder"?

We just read the free text "notes" field on the contact, looking for lines like this:

  folder: family
  whitelist: no

I showed addex to a friend, years ago, and he said, "Wow, that's great, how can I use it on Linux?" It hadn't occurred to me, but it was easy to write a plugin to let addex work with abook, mapping user-defined fields to addex fields.

Surviving the Death of Mac::Glue

I really wanted to post about Addex in this calendar, but it didn't seem fair. Addex hasn't worked very well on modern OS X because Mac::Glue, the Carbon-Perl bridge used to access Address Book won't build in most situations. Ever since upgrading to Snow Leopard, I haven't been able to update my mutt config, which has been a growing annoyance.

Finally, I decided that I'd work around the lack of Mac::Glue so that I could write this post, and I'm glad I did. The solution is simultaneously cute and absolutely horrible. I won't include it all here, but you can read the whole source on GitHub.

I'll just include the most horrible part:

1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29:  30:  31:  32:  33:  34:  35:  36:  37:  38:  39:  40:  41:  42:  43:  44:  45:  46:  47:  48:  49:  50:  51:  52:  53:  54:  55:  56:  57:	sub _produce_applescript {   my @fields = (     'first name',     'middle name',     'last name',     'nickname',     'suffix',     'note',   );   my $dumper = '';   for my $field (@fields) {     $dumper .= <<"END_FIELD_DUMPER"; set _this to get $field of _person       if $field of _person is not missing value then         set _answer to _answer & "- BEGIN $field\n"         set _answer to _answer & ($field of _person) & "\n"         set _answer to _answer & "- END $field\n"       end if END_FIELD_DUMPER }   my $osascript = <<'END_APPLESCRIPT'; tell application "Address Book"     set _people to (get people)     set _answer to ""     repeat with _person in _people       repeat 1 times         if count of email of _person = 0 then           exit repeat         end if         set _answer to _answer & "--- BEGIN " & id of _person & "\n"         $dumper         set _answer to _answer & "- BEGIN email\n"         repeat with _email in (get email of _person)           set _answer to _answer & (label of _email) & "\n"           set _answer to _answer & (value of _email) & "\n"         end repeat         set _answer to _answer & "- END email\n"         set _answer to _answer & "--- END " & id of _person & "\n\n"       end repeat     end repeat     _answer   end tell END_APPLESCRIPT   $osascript =~ s/\$dumper/$dumper/;   return $osascript; }

With no direct access to the scripting interface from Perl, we're reduced to writing AppleScript and later running it with the osascript program. AppleScript doesn't have a useful facility for stdout, so we just build up a big string with concatenation. osascript will print out the value of the last evaluated expression, so we evaluate _answer last.

There's no JSON library, and trying to worry about escaping JSON strings would be a real pain, so instead I've come up with my own ridiculous output format to dump address book entries. Later, there's code that will parse that back in, after reading the output of the AppleScript program.

It's a gross, colossal hack, but because address books are pluggable, everything just keeps working the way it did before.

The Future

I keep meaning to write a GMail address book plugin, and an output plugin to update my Pobox whitelists. So far, though, I've just been too lazy. Apart from that, though, I'm pretty happy with things the way they are. It just works, and it means I can keep using mutt and Apple Address Book and pretend that they know how to interoperate.

Putting less on Your Wish List

2010-12-11T00:00:00-05:00

One of Perl's `less`er Known Features

I do a lot of work with email, including a lot of message rewriting. Last year, I wrote about my favorite message-rewriting helper, but this year I'll write about something somewhat more removed.

Although quite a lot of my mail-handling uses Email::MIME or Email::Simple, the most heavily-munged mail goes through the venerable MIME::Entity, which has much more sophisticated facilities for things like "message body stored on disk." When you're going to build email messages with huge attachments, and then rewrite them, this is pretty important.

Sometimes, though, we know we're going to deal with very small messages, and using the disks to store MIME content will just grind on IO. For example, we might have a program that does something like this:

`1:  2:  3:  4:  5:  6:  7:  8: `	`my $parser = MIME::Parser->new; for my $file ( File::Find::Rule->file->in('Maildir') ) {   ...   my $entity = $parser->parse_open( $file );   MIME::Visitor->rewrite_parts($entity, sub { ... }); }`

By default, this will produce temporary files in /tmp for the message and temporary working data. This is often (perhaps surprisingly) much faster than working in memory, because disk IO is native, while Perl's file-in-memory IO is implemented in (relatively) slow Perl. So, while the default behavior may be faster, it's also more expensive, at least as regards disk IO. If, like me, you often find yourself bound by disk operations, you might want a way to switch your programs into a mode that will use less disk IO operations, or "iops."

This is easy, first we update our program to have the optional code path:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`my $parser = MIME::Parser->new; if ( less->of( 'iops' ) ) {   $parser->output_to_core(1);   $parser->tmp_to_core(1); } for my $file ( File::Find::Rule->file->in('Maildir') ) {   ...   my $entity = $parser->parse_open( $file );   MIME::Visitor->rewrite_parts($entity, sub { ... }); }`

Now, most of the time that path will not be entered. The call to less->of will usually return false. To make it true, we would need to add a line like this to the top of the program:

`1: `	`use less 'iops';`

We don't want to edit our program every time, though -- but we're not out of luck. Instead, we can invoke it in one of two ways. The first is the normal way, which will produce lots of disk IO:

  $ perl scan-all-mail

If we want less IO, we run:

  $ perl -Mless=iops scan-all-mail

The -M flag to perl basically injects that use line to the top of our program, causing the less->of call to return true, and all message handling to be done in memory.

Disregard that, this is less 'useful'

less has long been regarded as a joke module, which did nothing until perl 5.10.0. In that release, it became something of a demonstration of how to write a lexical pragma that looks at the "hints hash" found in the 11th (!) element returned by caller. From the outside, it actually looked useful, as seen above.

Unfortunately, less is just the sort of pragma where dynamic, rather than lexical scope would be useful. We want to put that parser-optimizing code down in some "give me a new MIME parser" library that anything can call, getting a usefully-optimized parser based on what the programmer has asked to use less of most recently -- not just what he asked to use less of in the lexical scope calling of.

With that limitation in place, can you use less for anything useful? Possibly, but in the end, less is less useful than less could be if less used less lexicality.

Wait, RJBS didn't write `less`!

That's true. I didn't write less, and I don't think I can easily fix it given its existing interface. I did fix another big problem with it, though.

This code snippet looks great:

`1:  2:  3: `	`use less 'cpu'; process_lots_of_files( @filenames );`

Or this one:

`1:  2:  3: `	`use less 'memory'; process_lots_of_files( @filenames );`

This one, though, is just unbearable:

`1:  2:  3: `	`use less 'filehandles'; process_lots_of_files( @filenames );`

It's not that I mind the idea of trying to minimize open filehandles. That can be a reasonable optimization, sometimes. The problem is that filehandles are countable things, and you don't use "less" with countable objects. The word "less" is for things that cannot be counted. For example:

This advent calendar entry has less merit than many others.

...but...

Rik deserves fewer words of praise today than he did yesterday.

If you are running perl 5.12.0 or newer, you can fix the nasty English suggested by the previous code snipped by installing fewer and writing:

`1:  2:  3: `	`use fewer 'filehandles'; process_lots_of_files( @filenames );`

I hope this is of use.

In Lieu of Coal, Naughty Children May Be Given M4 Files

2010-12-10T00:00:00-05:00

EXPERIMENTAL CODE AHEAD

Last week, I wrote about the somewhat experimental Throwable::X. This week, I'll be talking about the much more experimental DNS::Oterica. It's been unchanged for a while, but this article is meant to tantalize more than to offer a warrantied product.

Better Living Through Macros

Like, nearly any other internet business, my company has to manage DNS records. For a number of reasons, not the least of which was our heavy reliance on MX records and email transports to get work done. With on the order of 200 host names (A records) alone to manage, the programmers of old had very wisely decided that maintaining thousands of lines of tinydns configuration was madness. They very wisely decided to automate the generation of these files. They very wisely decided to generate output based on the jobs performed by actual hosts. Then they went and decided to use M4.

dns/data.m4 was not a well-loved file, and with good reason. Here's a brief sampling of some of its contents:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22: `	# create tinydns-data "+" or "=" lines define(EQUALS, `=$1:$2:$3')dnl define(PLUS, `+$1:$2:$3')dnl # set up a macro for the IP and an = line at the same time define(defq, `define($1, `$2')EQUALS($1) ')dnl # macros to get host definition parts out of the defq-defined host define(NAME_FOR, $1)dnl define(IP_FOR, $2)dnl define(TTL_FOR, $3)dnl # macro for boxes that send mail form us define(SENDS_PUBLIC_MAIL, PLUS(outbound-1.example.com, $1, ONE_HOUR))dnl # set up one of our webservers defq(XYZ, `xyz.example.com, 10.2.3.34, 3600')dnl defp(XYZ_WWW, `xyz.www.example.com, 10.2.3.32, 600')dnl defq(XYZ_STATIC, `xyz.static.www.example.com, 10.2.3.34, 600')dnl DEFAULT_SOA_AND_NS( 34.3.2.10.in-addr.arpa ) SENDS_PUBLIC_MAIL( IP_FOR( XYZ ) )

This is probably some of the clearest m4 found in the file. I won't show you anything worse, because nobody wants his or her Friday ruined by something like this:

`1:  2:  3:  4:  5:  6:  7: `	define(DEFAULT_MAIL, ` @$1::mx.example.com:10:600 pushdef(`__dom', `__macro_'translit($1, -., __)) define(__dom`_mx', @$1`::$'`1:10:600') map(__dom`_mx', DEFAULT_MXES) popdef(`__dom') ')

So this file was a relic of days gone by, produced by programmers who had long since moved on to other ventures. Every shop has this kind of system: it works, its custodians can make very basic adjustments to it, but nobody dares make significant changes. Unfortunately, these kind of systems usually get built very early in a product's lifecycle, to solve very important problems that are not within the business's central competency. That is: we were not a company that existed to manage DNS records, but we needed to have something to manage them as soon as possible.

The problem is that eventually the business will grow past this kind of solution, and if it can't be maintained, it will have to be rewritten. There may be plenty of ways to make that take longer and to keep these systems more maintainable, but their eventual retirement and replacement, over and over, seems inevitable.

The time for our system to die was at hand, and before we could replace it, we had to understand it.

Decomposing data.m4

Hosts in the M4 file were macros. That meant that when you said, "XYZ sends public mail," m4 would eventually say, "XYZ's IP appears as reverse DNS for outbound-1.example.com." Other macros were more complex, like the REDIRECTING_VIRTUAL_DOMAIN macro, which set up quite a few records of both forward and reverse DNS lookup. All these macros would be passed the host macro, which stood in for a number of identifying attributes of the host.

In fact, once you got past a lot of the weird M4-ness of the file, it was trying to say some pretty simple things, like this:

All hosts have a primary name.
Hosts might have IP addresses for their name.
Hosts might have extra names that go to the same address.
Hosts might belong to service groups, like MX or webservers.

Then there was a second layer of logic that said "a host turns into a bunch of tinydns lines based on its names and IP addresses" and "service groups turn into a bunch of tinydns lines based on the hosts in them." The only things that varied, really, was what it meant to be in a given group.

So, there were two kinds of entities to consider: hosts and groups. Hosts were easy, since they're all pretty much the same. We put our host definitions into YAML files, like this one:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`hostname: a-lb-mx-fastnet domain: example.com location: megacenter ip:   world: 10.1.0.100 aliases:   - almf.example.com families:   - com.example.mx   - com.example.memcached   - com.example.tor-exit-node`

Files like this sit in a directory organized however the sysadmins want. Ours, for example, puts each server in one file, along with any Solaris zones running on that server. The tool doesn't care. It just reads in a bunch of YAML documents and turns them into Host objects. When every host is loaded in, the hosts can be turned into DNS data lines with their as_data_lines method:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	sub as_data_lines { my ($self) = @_;   return (     $self->rec->comment("begin host ". $self->fqdn),     $self->rec->comment(" families: " . join(q{, }, $self->_family_names),     $self->rec->a_and_ptr({ name => $self->fqdn, node => $self }),     $self->rec->a({ name => $_, node => $self }) for $self->aliases,     $self->rec->comment("end host ". $self->fqdn),   ); }

($self->rec is a record generator, so that we can generate diagnostic output rather than tinydns-config, as needed.)

This is pretty straightforward. Sure it's longer than the corresponding M4 found in our defq macro, but it's a heck of a lot clearer. That said, it's also pretty boring. This code might solve a problem, but it doesn't solve the more interesting, difficult problem we have: composing the behavior found in each service group -- here, called families.

In our YAML document above, we put the host into several families, one of which was com.example.mx, which we implement in a class seen below. We'll go through it in chunks:

`1:  2:  3:  4:  5: `	`package DNS::Oterica::NodeFamily::ExampleMX; use Moose; extends 'DNS::Oterica::NodeFamily'; sub name { 'com.example.mx' }`

It's just a Moose class, implementing the abstract NodeFamily class. (There ended up being boring reasons that NodeFamily couldn't be a role.) The name corresponds to the family name used in the config files.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15: `	`has mx_nodes => (   is => 'ro',   isa => 'HashRef',   default => sub { {} }, );    after add_node => sub {   my ($self, $node) = @_;   my $nodes = $self->mx_nodes;   my $i = keys %$nodes;            my $next_name = sprintf 'mx-%s.example.com', $i+1;        $self->mx_nodes->{ $next_name } = $node; };`

The family keeps track of all the MX nodes that it's seen; there's an mx_nodes attribute on the object, and every time it adds a node, it records the node and gives it a new name. The first is mx-1.example.com, the mx-2.example.com and so on.

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13: `	`augment as_data_lines => sub {   my ($self) = @_;   my @lines;              my $mx = $self->mx_nodes;   for my $mxname (sort keys %$mx) {     push @lines, $self->rec->a({       name => $mxname,       node => $mx{$mxname},     });   }   return @lines; };`

Then, when we're ready to turn the family into configuration we... wait, what?? What's augment? Rather than a length explanation, here's a snippet of the method definition from the base NodeFamily class:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`sub as_data_lines {   my ($self) = @_;   my @lines;   push @lines, $self->rec->comment("begin family " . $self->name);   push @lines, $_ for inner();   push @lines, $self->rec->comment("end family " . $self->name);   return @lines; }`

We're going to return a list of lines. We create start and end comments, and get the rest by calling inner. inner is the other end of augment. When we call inner, the augment blocks get called in subclasses. With "normal" method calls, we'd end up entering the subclass's method first, and it would decide how (and whether) to call the superclass's method. Here, we're working backward, in a sense: first the superclass method is begun, then any subclasses may contribute to the output, and then the superclass is finalized.

This avoids any need to worry about calling the superclass method in subclasses, which can then write the simplest thing needed. Unfortuantely, you can't call augment in a role. To get that kind of method composition, you may have to wait for a future Advent posting!

A Triumph of the Moose

In the end, we replaced literally hundreds of thousands of lines of M4 with 42 very short class definitions -- our node families -- and one file per physical server. The new system can be the target of regression tests, either of individual groups or of the whole thing. Most of the time, the sysadmins can just edit simple YAML documents. Occasionally, node families need updating, but they're all very simple Perl classes with only one or two methods of any note.

Best of all, nobody needs to learn M4.

A Place to Shove Your Settings

2010-12-09T00:00:00-05:00

Because 132 Fields Ought To Be Enough for Anybody

A long time ago, I inherited a lot of shares in a pretty crufty old system. Like almost everything else you're likely to find at a small software place, it had a bunch of objects that it stored in relational database -- and like you'd find a lot of places, there weren't enough tables. (I once heard this problem described as, "It's like some programmers think that they're charged by the table.") We had thousands of rows, each with well over a hundred fields, and we'd end up finding great stuff like this:

  mysql&gt; SELECT use_oxford_comma, COUNT(*)
       &gt; FROM customers
       &gt; GROUP BY use_oxford_comma;

  +------------------+----------+
  | use_oxford_comma | COUNT(*) |
  +------------------+----------+
  | NULL             |    89162 |
  | 1                |        8 |
  | yes              |        1 |
  +------------------+----------+

Creating extra tables for this sort of setting was the right thing to do, but that would've been a lot of tables, and let's face it: there is a charge per table. You have to add the table, add the class to your ORM, and update queries. Query costs change when you add more FKs between tables. We wanted to strike a balance between hundreds of rarely-used table and only one enormous table by offloading weird nearly-one-off data someplace else. The answer was pseudo-structured data storage in a key-value store. Not MongoDB or CouchDB or something like that, mind you -- just a table that looks something like this:

`1:  2:  3:  4:  5:  6:  7: `	`CREATE TABLE customer_hive (   id INTEGER AUTO_INCREMENT PRIMARY KEY,   customer_id INTEGER REFERENCES customers (id),   hive_key STRING,   hive_val STRING,   UNIQUE KEY (customer_id, hive_key) );`

What are the hive key and value? The key is a materialized path for the value, which is just, well, a value. Every value can only be typed as a string, but that's okay. If we get worried about the type, we'll move the data to its own table later. So, what do entries in this table look like? Maybe something like this:

  mysql&gt; SELECT hive_key, hive_val FROM customer_hive WHERE customer_id = 123;

  +-------------------------------------------+----------+
  | hive_key                                  | hive_val |
  +-------------------------------------------+----------+
  | formatting.use_oxford_comma               |   always |
  | formatting.spaces_after_period            |        2 |
  | reports                                   |        1 |
  | reports.activity.daily.include_moon_phase |        1 |
  +-------------------------------------------+----------+

So we're really storing something like this:

                                     (root)
                                    /      \
                                   /        \
                         formatting          \
                            /      \          reports: 1
        use_oxford_comma: always    \               \
                                     \              activity
                        spaces_after_period: 2            \
                                                         daily
                                                          \
                                                          include_moon_phase: 1

(Notice that this can't be represented as a hash, because we have parts of the hierarchy, like reports that have both values and subtrees!)

What we needed next was a convenient way to access these data, and that's where Data::Hive came in to play.

Yet Another Hashes-as-Objects Schema

We called this structure a hive, in honor of the Windows registry -- always a good role model for software design. We wanted it to be as simple to use for new data as possible, so we could just plow forward with new code and never think about how the settings were being saved. If the setting became important or significantly-used, we could move it, later, to a more strictly-typed part of the schema. For now, the goal was to allow for rapid development. The interface for setting up a hive like the one above would be:

`1:  2:  3:  4:  5:  6:  7: `	`my $hive = Data::Hive->NEW( ... ); $hive->formatting->use_oxford_comma->SET('always'); $hive->formatting->spaces_after_period->SET(2); $hive->reports->SET(1); $hive->reports->activity->daily->include_moon_phase->SET(1);`

...and maybe later...

`1:  2:  3: `	`if ($hive->formatting->use_oxford_comma->GET('never')) { # never = default   ... }`

That's it! Now, we didn't have to predeclare any of the potential structure of our hive -- that would not be simple enough. So, how did these methods work? Well, we're using another usually-the-wrong-solution feature of Perl, autoloading. As you call not-all-caps methods, you just keep getting back another proxy object for the path you build. Eventually, you call something like GET or SET or DELETE to deal with the underlying data.

Hooking it All Up

So, where is the underlying data? Data::Hive doesn't care. Its concern is mapping the path-descending interface to something else -- and that something else is a storage driver. In other words, "bring your own underlying data access code." For the sake of testing, it comes with some simple storage drivers that store hives in hashrefs. This isn't too useful, though, because we (or I, at least) want to use hives to store persistent data. Fortunately, one of our drivers can store to anything implementing a set of CGI.pm-like params methods.

We also don't just want standalone hives. We want hives that are associated with other objects. We want to be able to decorate any arbitrary object with a hive to add ad hoc hierarchical data to an object. We looked at a system for doing this in last year's calendar; there was a whole article about Mixin::ExtraFields. (You might want to review it.) ExtraFields also has storage drivers, some of which persist the extra fields into databases. There's also a Data::Hive-specific subclass that lets you associate hives with objects just like you can extras.

What does that mean? It means that for any object you want, you can write something like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`package MyApp::Customer; use Mixin::ExtraFields::Hive -hive => {   driver => {     class => 'DBIC',     schema => sub { MyApp::Schema->connect(...) },     rs_moniker => 'CustomerHive',     name_column => 'hive_key',     value_column => 'hive_val',   } };`

That little use statement means that we can now write:

`1:  2:  3:  4: `	`my $formatting_hive = $customer->hive->formatting; $formatting_hive->use_oxford_comma->DELETE; $formatting_hive->page_numbers->number_index->SET(1);`

...and all the changes will be made for us in a DBIx::Class-managed table, without any need to worry about how it works. Later, we can change the backend for storage and nothing needs to know.

Option Processing -- This Time, Invented Here!

2010-12-08T00:00:00-05:00

Everybody's Favorite Getopt

This isn't everybody's favorite getopt. It's my favorite getopt, and it might be the favorite of some other people, but the problem with getopt libraries is that they can be optimized for so many different needs... but most of the time no optimization is needed, so we each get attached to the library we're using most often, forgetting that there are lots of reasons to choose differently.

Well, I'm not here to tolerate other people's libraries. The time for tolerance is past. I'm going to talk about my favorite getopt library. In what may be a first for the RJBS Advent Calendar, it's a library I didn't write. It was written by my former co-worker Dieter, and I remember very clearly how happy I was when I started that the "which getopt?" question had not only been answered already, but had been answered with a library that I liked using.

Our Optimizations

So, if all getopt libraries make tradeoffs, what are ours? We wanted it to be very easy to read and write option specifications, and we needed the command to get a usage message that was always correct and up to date with the usage message. Our non-technical staff all use a Unix shell, and run a lot of command-line programs. They need to have useful help messages to forestall questions about how to use things.

To use Getopt::Long::Descriptive (aka GLD), you basically describe the options you'd like to accept and get back the options parsed from @ARGV and an object representing the "usage message." Here's a fairly complete program using GLD:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29:  30:  31:  32:  33:  34: `	my ($opt, $usage) = describe_options(   '%c %o recipient ...',   [ 'template\|t=s', "the HTML template for the card", { default => 'card.html' } ],   [ 'from\|f=s', "the sending address", { required => 1 } ],   [],   [ "text-mode" => hidden => {     required => 1,     one_of => [       [ "html-only" => "send no plaintext part" ],       [ "autotext" => "generate plaintext from HTML" ],       [ "text-tmpl=s" => "filename for a separate plaintext template" ],       ],   } ], ); my @rcpts = @ARGV; $usage->die({ pre_text => "no recipients given!" }) unless @rcpts; my $html_template = slurp( $opt->template ); my $text_template = $opt->text_mode eq 'html_only' ? undef                   : $opt->text_mode eq 'autotext' ? textify($html_template)                   : $opt->text_mode eq 'text_tmpl' ? slurp( $opt->text_tmpl )                   : ... ; for my $rcpt (@rcpts) {   send_card({     html => render( $html_template, $rcpt ),     text => render( $text_template, $rcpt ),     to => $rcpt,     from => $opt->from,   }); }

Some of this is obvious, especially if you know Getopt::Long, but have another slow read through the code, and then we'll walk through it piece by piece.

`describe_options`

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15: `	my ($opt, $usage) = describe_options(   '%c %o recipient ...',   [ 'template\|t=s', "the HTML template for the card", { default => 'card.html' } ],   [ 'from\|f=s', "the sending address", { required => 1 } ],   [],   [ "text-mode" => hidden => {     required => 1,     one_of => [       [ "html-only" => "send no plaintext part" ],       [ "autotext" => "generate plaintext from HTML" ],       [ "text-tmpl=s" => "filename for a separate plaintext template" ],       ],   } ], );

describe_options doesn't really just describe the options. It parses the command line arguments by reading @ARGV and returns an object describing the switches that were given ($opt) and another object that can be used to print out a usage message in case of error. If @ARGV can't be parsed legally, that message is printed and the program dies, something like this:

  send-holiday-card [-ft] [long options...] recipient ...
    -t --template     the HTML template for the card
    -f --from         the sending address
  
    --html-only       set no plaintext part
    --autotext        generate plaintext from HTML
    --text-tmpl       filename for a separate plaintext template

The first argument to describe_options produces the first line of the usage message. It uses sprintf-like formatting, letting you get the name of the script and a quick summary of available options into the usage message.

After that, everything describes options. Each argument is an arrayref with up to three entries:

`1: `	`[ $switch, $description, \%options ]`

The contents of $switch value might look familiar. It's just a Getopt::Long-style description of the switch. GLD is not so ambitious as to try to implement its own argument processor! It's just a layer on top of Getopt::Long and some other tools. So, every $switch value can have a few names, separated by pipes. The first name (with some mild munging, like s/-/_/, becomes the name of the accessor on $opt. That's why later we can call $opt->from to get the value given for --form.

The $description field is just the description for the option in the usage message. The description "hidden" means that an option isn't displayed in the usage message, and an entirely empty option, like [], by the way, means "put a blank line in the usage message."

%options, which is optional, changes how the switch is interpreted. It can take a bunch of options, but the most common are required and default, which change what happens if no value was given. The value can also be validated by using Params::Validate arguments.

The most interesting kind of option is one_of, as seen in:

`1:  2:  3:  4:  5:  6:  7:  8: `	[ "text-mode" => hidden => {     required => 1,     one_of => [       [ "html-only" => "send no plaintext part" ],       [ "autotext" => "generate plaintext from HTML" ],       [ "text-tmpl=s" => "filename for a separate plaintext template" ],       ],   } ],

one_of is usually used in combination with hidden, and creates a sort of virtual option. $opt->text_mode will tell us which of the sub-options was used, and then we can check that option's value. Only one of the sub-options can be specified. That's why we could safely write this:

`1:  2:  3:  4: `	my $text_template = $opt->text_mode eq 'html_only' ? undef                   : $opt->text_mode eq 'autotext' ? textify($html_template)                   : $opt->text_mode eq 'text_tmpl' ? slurp( $opt->text_tmpl )                   : ... ;

one_of options are useful for establishing mutually exclusive kinds of operation, and were originally set up to create something like a "run mode." There'd be a hidden mode option, and the user would pick one_of "delete" or "add" or "list," for example. Our use of virtual options for that has faded after the creation of App::Cmd, a framework for slightly more complicated applications. App::Cmd helps make command-line applications easy to write, but it isn't so ambitious as to try to provide its own getopt implementation: to use App::Cmd properly, you need to first understand Getopt::Long::Descriptive.

Safe, Simple, Deadly

2010-12-07T00:00:00-05:00

Making Exception Testing Easier

I do not like "returns false on failure." Even worse is "returns a result or some magic error value." Part of this is based in reason and part in irrational reaction to a personal history of dealing with really, really bad APIs. The result is that when I write a subroutine that returns a value, it's very likely to follow these simple rules:

return a value of a known type, if everything worked; "false" is okay too
if something went wrong, throw an exception

I do like testing my code. Testing case 1, from above, is easy!

`1:  2:  3:  4:  5:  6:  7: `	`use Gift::Wrapper qw(wrap); use Test::More; my $gift = wrap( $input ); isa_ok($gift, 'Wrapped::Gift'); is( $gift->contents, $input );`

That's nice and simple and straightforward! There's no code there that doesn't contribute to the very thing we're testing. What about testing case 2, though

`1:  2:  3:  4:  5:  6:  7:  8: `	`use Gift::Wrapper qw(wrap); use Test::More; my $okay = eval { wrap( $coal ); 1 }; my $error = $@; ok( ! $okay, "we can't wrap coal"); is( $error->ident, 'coal is not a good gift');`

That "eval and check result and capture $@" is going to get pretty tedious, pretty quickly. Also, if our tests are part of some larger test program -- which they probably are -- then we're missing a bunch of extra safety. That's why we'd never use eval, right? We all use Try::Tiny instead! With that, our code would look like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14: `	`use Gift::Wrapper qw(wrap); use Test::More; my $error; try {   wrap( $coal ) } catch {   $error = $_; } finally {   die "bizarre error condition" if @_ and not $_[0]; }; ok( ! $okay, "we can't wrap coal"); is( $error->ident, 'coal is not a good gift');`

Woah, what? Now we're in a world of hurt, and there's no chance that we'll ever write that over and over. And what's up with that finally block with the weird die? Well, Perl has some really bizarre (read: awful) semantics with exception handling, and in a number of cases it can die but leave $@ empty. Try::Tiny helps us deal with these situations, but only at the first order. Here, we want a higher-order check of our exception status.

Obviously, this is all lead in to the simple way to check this:

`1:  2:  3:  4:  5:  6:  7:  8: `	`use Gift::Wrapper qw(wrap); use Test::More; use Test::Fatal; my $error = exception { wrap( $coal ) }; isnt( $error, undef, "we can't wrap coal"); is( $error->ident, 'coal is not a good gift' );`

exception always returns a scalar: the exception that was thrown, if any, or undef otherwise. In the event that the code died, but no exception could be found -- a highly problematic case -- exception itself will die. The routine's "returns a scalar" behavior makes it excellent for use inline in test assertions:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14: `	`# test that we died ok( exception { wrap( undef) }, "no empty boxes!" ); # test that we got the exception we wanted, more or less like(   exception { wrap( 'gift certificate' ) },   qr{show some imagination!}, ); # test that we lived! ok(   ! exception { wrap( "toy train" ) },   "nothing wrong with wrapping a toy train", );`

A Quick Note about Test::Exception

Test::Fatal is not the only library for this kind of testing. There also exists Test::Exception, which also provides tools for testing. Test::Exception has more moving pieces than Test::Fatal, including the highly complex Sub::Uplevel. In almost all cases, its complexity is not needed, and you will be better served by the simple exception routine than by the handful of test assertions provided by Test::Exception -- but it takes all kinds.

Feast of St. Burl

2010-12-06T00:00:00-05:00

NOT ON THE CPAN

Today's article is about code not found on the CPAN.

The Good Old Days

Today is the feast of St. Burl, the little known patron saint of gophers. In his honor, I'd like to talk a little about the Gopher protocol and my on-again, off-again affection for it.

Since I first made a home page some time around 1995, it has included an opening something like this:

I made my first home page back when HTML 1.1 was just coming out and some guy named Mozilla was releasing Netscape, which he said would replace the NCSA Mosaic browser. I'll let you in on a little secret: I didn't believe for a minute that HTTP would replace such tried-and-true services as Archie, Veronica, and (my favorite) Gopher.

Eventually, though very late, I accepted that Gopher was done for, but I'd think back on it fondly from time to time. As HTML and CSS and JavaScript and XML and the rest of the web got more and more complicated, and there were more and more "best viewed in Webbernet SurfPro" badges or "required plugin missing" errors, I'd remember the nice, simple Gopher system. You'd basically get two things from it: directories and files. There was nothing to screw up!

Years later, when I had learned how to write non-trivial programs, I decided I would write a Gopher server, which meant reading the Gopher spec. It looked sort of weird, but easy enough to implement a test server:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14:  15:  16:  17:  18:  19:  20:  21:  22:  23:  24:  25:  26:  27:  28:  29:  30:  31:  32:  33:  34:  35:  36:  37:  38:  39:  40: `	use strict; use warnings; use IO::Socket; my $port = 70; my $crlf = "\015\012"; my $socket = IO::Socket::INET->new(   Proto => 'tcp',   LocalPort => $port,   Listen => 128,   Reuse => 1 ); warn "waiting for incoming connections on port $port...\n"; while (1) {   next unless my $connection = $socket->accept;   if (fork) {     $connection->close;     next;   } else {     $connection->autoflush(1);     my $request = $connection->getline;     $request =~ s/$crlf//g;     print STDERR "REQUEST: $request\n";     if ($request eq '' or $request eq '/') {       $connection->print("1Directory Listing\t/\tlocalhost\t70$crlf");       $connection->print("0README.TXT\tREADME.TXT\tlocalhost\t70$crlf");       $connection->print("0README.TxT\tREADME.TxT\tlocalhost\t70$crlf");       $connection->print(".$crlf");     }          $connection->close;   } } $socket->close;

All this server could do was print a directory. You could ask for the other stuff it had to offer, but you wouldn't get it. Anyway, the directory is good enough for us to look at Gopher a little. It's a bunch of tab-delimited lines, which would look like this, as a table:

  +--------------------+------------+-----------+------+
  | Type, Display Name | Selector   | Host      | Post |
  +--------------------+------------+-----------+------+
  | 1Directory Listing | /          | localhost |   70 |
  | 0README.TXT        | README.TXT | localhost |   70 |
  | 0README.TxT        | README.TxT | localhost |   70 |
  +--------------------+------------+-----------+------+

The Gopher request to get that listing goes like this:

  CLIENT: connect, send &quot;/&quot; and CRLF
  SERVER: send tab-delimited lines, followed by . and CRLF, then disconnect

Simple!

When the Gopher client gets that table, it turns it into a menu like this:

  [ Dir  ]  Directory Listing
  [ File ]  README.TXT
  [ File ]  README.TxT

The user can pick one of three options and get a new document. The first option leads to another directory and the other two lead to files. We know this because the first character of the lines was either 0 (a directory) or 1 (a file). This is crucial, because we need to know, if we're getting a text file, that we shouldn't look for tabs and display it as a menu.

This leads to the first big problem. See, imagine what happens if we try to get README.TXT:

  CLIENT: connect, send &quot;README.TXT&quot; and CRLF
  SERVER: send a bunch of lines, followed by . and CRLF, then disconnect

How do we know that what we got back was a text file and not a directory listing? There's nothing in the request or the response telling us. We need to know before making the request, because the directory told us what to expect. Gopher predates URIs, but if it didn't, we might imagine that the URI for the README file was the whole line:

  0README.TXT\tREADME.TXT\tlocalhost\t70

In fact, when Gopher was given its own scheme, the above locator would look read gopher://localhost:70/0README.TXT but it would often be rewritten as gopher://localhost:70/0/README.TXT. (In HTTP this problem doesn't exist, because every response includes a declaration of the type of the content.)

So, what does this mean in practical terms? My first guess was that it just meant that we'd have a simple transport layer to get bodies, and then a slightly more complex presentation layer to display the body based on what it expected. Unfortunately, that doesn't play out. See, zero and one aren't the only content types. There are about 124 possible values, although only a few are assigned. Here are two troublesome ones that are assigned:

  5 - binary file (for DOS)
  9 - binary file

(How do the two differ? Nobody seems to have any idea.)

The trouble is that you're prohibited from encoding binary files, even if they contain the pattern CRLF-dot-CRLF. That means you can't detect the end of stream, and there may not be a terminal CRLF. So, the client must wait until the server disconnects and must not truncate any trailing dot-CRLF. In that case, how does it know when to stop reading? Only by getting hung up on. That means that the context of the request (that is, its appearance in some containing directory) influences not only the presentation, but also the behavior of the network client.

If it doesn't get that "end of body" sentinel, how does it know that it got the whole document? Well, it doesn't.

There are some other weird type identifiers. "g" means a GIF image, and "I" means "some kind of image file." (It's assumed that with broad types like "I" the client will decide what to do by interpreting the selector as a file name and looking at the extension.) Both "g" and "I" can be dot-terminated. "7" means "search engine," and the client prompts the user for a search string to be concatenated to the selector before fetching. "7" is assumed to actually return a directory (a "1").

There are even some types for other protocols. For example, "T" points to an interactive tn3270 session. I must admit to being moved to feelings of nostalgia by that -- like finding "troff" as a top-level MIME-type-like classification for in an early email RFC. If we added "h" as a type for HTTP, we could say:

  +--------------------+------------+-------------------------+------+
  | Type, Display Name | Selector   | Host                    | Post |
  +--------------------+------------+-------------------------+------+
  | hAdvent Calendar   | /2010      | advent.rjbs.manxome.org |   70 |
  +--------------------+------------+-------------------------+------+

We don't need to mandate that "h" also means "expect HTML," because HTTP requires that the server tell us what it's giving us. Once we're off into HTTP land, we really have entered a web of interconnected documents of all types, using uniform resource locators. (Did you notice, by the way, that because Gopher gives us "links" only in directory listings, we can't provide hypertext in Gopher without a new type definition? A text file ("0") in Gopher can't contain links.

Today's Gift, As-Is

I still sometimes think back on the apparent simplicity of Gopher. It could be emulated in HTML pretty easily. Maybe I'll write a DTD for a subset of XHTML that gets you something like Gopher. In the past, though, I was young and idealistic and less willing to compromise. I really wanted to write a fun little framework for Gopher servers in Perl. I even wanted to make it part of my 2009 Advent calendar, but disappointment with the protocol and its implications for implementing and testing overwhelmed me.

I have since given up the idea of ever finishing it, so I present to you, unfinished, Net::Gopher::Server!

It's a Time for Tolerance

2010-12-05T00:00:00-05:00

Secret Origins!

Once upon a time, I was called upon to write a database for complex semiconductor growth specifications. Very often, the specification would state that a given measurement had to be within a certain tolerance, rather than a specific value. For bizarre semi-political reasons, we couldn't just provide outer limits and shoot for a center point. We had to track, through all parts of the system, the specific way in which the specification was... specified. That might be like any of the following:

  5
  &gt; 5
  &ge; 5
  &lt; 5
  &ge; 5
  5 &plusmn; 1
  5 &plusmn; 20%
  4 .. 6
  5 (-1 to +2)

At the time, the need to stick to a given format was frustrating, but it drove me to write a library that has proven itself useful again and again -- mostly in weird situations, but I'm still happy to have a tool I only use once in a while.

Tolerance in Form and Action

A tolerance is an object that acts like a number for the sake of comparison.

Rather than struggle to contrive a generic example, I'll talk about how this code was originally used. Our customer is going to come to us with a specification for a product, and we want to be able to record that specification, overlay our own specifications, and then test results against it. The customer might give us the following set of requirements:

`1:  2:  3:  4:  5:  6:  7:  8: `	`use Number::Tolerant; $spec{customer} = {   width => tolerance(qw( 10 plus_or_minus 2)),   depth => tolerance(qw( 182 plus_or_minus_pct 5)),   weight => tolerance(qw( less_than 10 )),   hue => tolerance(qw( 630 to 740)), };`

Internally, we know what our production equipment's capabilities are:

`1:  2:  3:  4:  5:  6: `	`$spec{machine} = {   width => tolerance(qw( 7 to 10 )),   depth => tolerance(qw( less_than 184 )),   weight => tolerance(qw( less_than 50 )),   hue => 675, };`

...and engineering doesn't want to use anything too heavy, and have done some final design work, so they tack on:

`1:  2:  3:  4: `	`$spec{engineering} = {   width => 9,   weight => tolerance(qw( less_than 2 )), };`

Now we have a bunch of different, separate specification documents, and we can have a quick review of them all:

`1:  2:  3:  4:  5:  6:  7:  8: `	`sub tol_string {   my $tol = shift;   join qq{\n}, map {; sprintf "%10s %s", $_, $tol->{$_} } sort keys %$tol; } for (keys %spec) {   print "\U$_\n", tol_string( $spec{$_} ), "\n"; }`

...to get...

  CUSTOMER
       depth 182 +/- 5%
         hue 630 &lt;= x &lt;= 740
      weight x &lt; 10
       width 10 +/- 2
  ENGINEERING
      weight x &lt; 2
       width 9
  MACHINE
       depth x &lt; 184
         hue 675
      weight x &lt; 50
       width 7 &lt;= x &lt;= 10

Composing these together is easy:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12: `	`my $final_spec = {}; for (keys %spec) {   my $this_spec = $spec{$_};   for (keys %$this_spec) {     $final_spec->{ $_ } \|\|= tolerance('infinite');     $final_spec->{ $_ } &= $this_spec->{$_};   } } print tol_string($final_spec);`

...and we get:

     depth 172.9 &lt;= x &lt; 184
       hue 675
    weight x &lt; 2
     width 9

What just happened? Well, tolerances can be joined together logically with intersections and unions. When we want to produce the intersection of a bunch of tolerances, we just use the & operator. Or, if you want to avoid weird overloading, you can use the union method. When unions intersect, the result is either a new tolerance (like the unified depth specification above) or a constant giving the only permissible value. When a union would produce an impossible tolerance, an exception is thrown. I accidentally caused one of those when writing the above code. I'd picked a bad hue for the machine spec and got:

  No valid intersection of (630 &lt;= x &lt;= 740) and (775) at...

Once we've gotten our final product, it's easy to test against the spec:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11:  12:  13:  14: `	`my $final_product = get_final_product; my @errors; for my $prop (keys %$final_product) {   next unless exists $final_spec->{ $prop };   my $value = $final_product->{ $prop };   my $spec = $final_spec->{ $prop };   next if $value == $spec;   push @errors, "$prop ($value) outside of specification ($spec)"; } say for @errors;`

...which might produce an error like:

  weight (2.2) outside of specification (x &lt; 2)

Testing with Tolerance

Tolerances can also be handy for running automated tests. An output file's size should fall into a given range, or we should process no more than a certain number of records, and so on. Using Number::Tolerant with tests can be useful when tolerances must be combined -- but it's often just easier to use than Test::More's cmp_ok, which has pretty gross semantics. For example, compare:

`1:  2:  3: `	`use Test::More; cmp_ok($x, '>', 10); cmp_ok($x, '<', 20);`

to:

`1:  2: `	`use Test::Tolerant; is_tol($x, '10 < x < 20');`

Test::Tolerant is part of the Number-Tolerant distribution.

83% of Advent Remaining

2010-12-04T00:00:00-05:00

Sufficiently Advanced (ProgressBar) Technology

At YAPC::NA 2004 in Buffalo, Damian Conway gave a talk on "Sufficiently Advanced Technologies," in which he showed off a number of very simple interfaces for fairly complex operations. Among the libraries he talked about was Smart::Comments, a source filter that turns comments into code. It had a bunch of functions, but one of them let you do this:

`1:  2:  3:  4:  5:  6:  7:  8: `	`use Smart::Comments: my @input = acquire_input(); my @output; for my $datum (@input) { ### Analyzing [===\| ] % done   push @output, expensive_analysis($datum); }`

...and your program would, on one line, cycle through stuff like this:

  Analyzing [|                ]   0% done
  Analyzing [===|             ]  25% done
  Analyzing [========|        ]  50% done
  Analyzing [============|    ]  75% done
  Analyzing [=================] 100% done

Progress bars are hard to get right! Just look at any implementation you've seen in otherwise great, well-designed software, like Microsoft Windows. They often provide progress bars that jump between "almost done" and "-919 days remain."

Smart::Comments can have this problem, too, as the workload changes out from under it -- some items in @input, for example, might be costly to analyze, for example. There might be redo or next statements, or lasts, all of which can interfere with proper job speed detection.

Acme::ProgressBar is always accurate. No matter what the characteristics of the input are, no matter how the loop flow is altered, no matter what, Acme::ProgressBar is accurate. Only extreme system load or fatal signals can interfere with its accuracy.

It's very easy to use, too. It isn't a source filter, and uses no complex features. It should never introduce bugs to your code and can be added or removed to your code easily. Written with Acme::ProgressBar instead, the above code would look like this:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10: `	`use Acme::ProgressBar; my @input = acquire_input(); my @output; progress {   for my $datum (@input) {     push @output, expensive_analysis($datum);   } };`

...and would produce output like this (but all on one line, and I've omitted some lines for brevity's sake):

  Progress: [          ] (calculating time remaining)
  Progress: [==        ] 8s remaining                         
  Progress: [====      ] 6s remaining                         
  Progress: [======    ] 4s remaining                         
  Progress: [========  ] 2s remaining                         
  Progress: [==========] 0s remaining

There can be a performance cost for using Acme::ProgressBar, but the impact varies from program to program. You should test it in your code before judging the performance costs.

The source code for Acme::ProgressBar may also be instructive.

Exceptionally Extensible Exceptions

2010-12-03T00:00:00-05:00

Building Exception Classes with Moose

Perl 5 supports exception objects natively, with die and eval and $@, but there has traditionally not been any standard, core class for exception objects. This has been both good and bad, because it has encouraged many different people to produce their own exception classes -- some quite simple, and some quite complex. One fairly successful such system was Exception::Class, a framework for quickly building exception classes. It provided a number of generic class-building features, and you'd use them to build classes for your exceptions.

These days, we have a much better and more powerful system for building classes: Moose. Throwable is a tiny Moose role for turning generic Moose classes into throwable exceptions. If you've written:

`1:  2:  3:  4: `	`package Catastrophe; use Moose; has description => (is => 'ro', isa => 'Str', required => 1);`

You can turn that into a throwable exception by adding...

`1: `	`with qw(Throwable StackTrace::Auto);`

Now you can call use Catastrophe->throw(...) and it means the same thing as die Catastrophe->new(...), and it's given a stack_trace attribute that contains a Devel::StackTrace so you can tell where the catastrophe happened. "But wait!" you cry, "that stack trace isn't coming from Throwable!" That's right, it's not. It's coming from another library that's meant to work well as part of an exception class, but it's totally optional. Sometimes, after all, you want exceptions for flow control and not error reporting, and in those cases a stack trace is a needless expense.

Over time, I've found other behaviors I really want in my exceptions, and I threw them all into an experimental Throwable::X role -- but rather than actually talk about that, it will be more useful to look at the pieces that make up Throwable::X, because you can use them one by one.

One-Arg Exception Throwing

The first thing I ever did with Exception::Class was to make it possible to call throw with only one arg. Why give named parameters every time, if almost every time you call throw you only need to pass one value?

Throwable::X does the same thing by using MooseX::OneArgNew to say, "If you only got one argument to new (or, by extension, throw), it's the ident argument." Since most of the time, all that's needed of a thrown exception is its name. Probably better than 95% of my thrown exceptions look like this:

`1: `	`X::Permission->throw('must run as root');`

Making that work just means adding this to our role or class:

`1:  2:  3:  4: `	`with 'MooseX::OneArgNew' => {   type => 'Throwable::X::_VisibleStr',   init_arg => 'ident', };`

You can do that in any Moose class or role, by the way, not just exceptions!

Clearly-Identified Exceptions

So, I said that if you gave throw only one argument, it stood for the ident argument. What's that?

Well, in Exception::Class, it would have been message, which is the error message that the exception is giving you. If your exception classes ar pretty broad (like "X::Permission" and "X::Unavailable" and similar-sized categories) then you'll probably end up using message for more detailed information. So, you'll see code that looks like this:

`1: `	`ExceptionClass::Error->throw("can't use $value as hostname");`

How do we detect that this is the error we got? We do something like this:

`1:  2:  3: `	`} catch {   if ($_->message =~ /\Acan't use .+? as hostname\z/) { ... } }`

Regular expression matches are a pretty lousy substitute for clear identification -- especially when we control the exception system and could just make our exceptions identifiable. By using Role::Identifiable::HasIdent, we add an ident attribute that is guaranteed to be a simple string that we can use to identify our exceptions. Our classes can identify exceptions in broad groups, but string equality with our ident will always tell us if we have exactly the exception we expected.

If the ident is not supposed to contain any specifics (like the hostname that we say is illegal), then how do we communicate that stuff back to the user?

Describing the Error

We describe our exception with the message attribute, just like we did with Exception::Class. We can leave it blank, and it will default to the ident. If we provide it, though, it acts sort of like a sprintf format. (Readers of last year's calendar may remember that I have a soft spot for sprintf.) We might say something like this:

`1:  2:  3:  4:  5: `	`X::BadValue->throw({   ident => "bad nameserver hostname",   message => "can't use %{hostname}s for nameserver",   payload => { hostname => $hostname }, });`

When the message is read, it gets formatted to read just like you expect, interpolating the value of $hostname for the %...s expression. The formatting language is very simple and easy to implement in other languages. It's on the CPAN as String::Errf, and has a JSON-backed test suite. The named inputs come from the payload -- but they don't all need to be in the payload hash.

For example, what if we have a lot of errors related to hostnames? We could write a role:

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`package X::Role::HasHostname; use Moose::Role; has hostname => (   is => 'ro',   isa => 'Str',   required => 1,   traits => [ 'Payload' ], # <-- Role::HasPayload::Meta::Attribute::Payload );`

...then if we made an exception class with that role included, the value of the hostname attribute would automatically be part of the payload -- and we can be guaranteed that it will be there, and a string, because of the attribute definition. We could rewrite the above as:

`1:  2:  3:  4:  5: `	`X::BadValue::HasHostname->throw({   ident => "bad nameserver hostname",   message => "can't use %{hostname}s for nameserver",   hostname => $hostname, });`

This lets us write really generic exceptions to start with, but refactor to more specific implementations if it's ever useful. With all the refactoring we might do over time, how do we keep track of what exceptions signify without relying on class or role names that might vary over time? We already have an ident for identifying specific exceptions, but we want to identify whole categories of exceptions.

Identification by Tagging

We want to be able to identify exceptions at resolutions other than "it's an exception" and "its ident is 'bad hostname'," so one option would be to rely on checking classes and roles with isa and does. The problem is that we're probably going to be ripping apart and rebuilding classes and roles over time as we figure out what kind of exceptions we really need to handle. Instead of tying our type checks to classes, we can tie them to something easier to carry around when we refactor: tags.

We can use Role::Identifiable::HasTags to add tags to our exceptions:

`1:  2:  3:  4:  5:  6: `	`X::BadValue->throw({   ident => "bad nameserver hostname",   message => "can't use %{hostname}s for nameserver",   payload => { hostname => $hostname },   tags => [ qw(dns hostname) ], });`

Later, refactoring like we said above, we might end up writing:

`1:  2:  3:  4:  5:  6:  7:  8:  9:  10:  11: `	`package X::Role::HasHostname; use Moose::Role; add_tags { qw(hostname) }; has hostname => (   is => 'ro',   isa => 'Str',   required => 1,   traits => [ 'Payload' ], );`

...and the hostname tag would no longer be required when throwing, because it would be implicit in the class.

(The tags role is still in a bit of flux as it is rewritten to use MooseX::ComposedBehavior. More on that another day.)

Picking and Choosing

I think there are a number of exception extensions left to be written, most importantly stringification and serialization behaviors. Because each of these behaviors is its own role or component, you can build your own application's exception classes with only the behavior you want. You can even re-use most of these behaviors in other classes that have nothing to do with exceptions, because they're just hunks of behavior, rather than exception-specific code built into and inseparable from an exception library.

Bringing out the Good Exporter for Company

2010-12-02T00:00:00-05:00

The Illusion of Sophistication

Sub::Exporter, covered in the first Advent post last year, describes itself as "a sophisticated exporter for custom-built routines." This is in contrast to Exporter, which is, well... chocked full of near-adequacy.

Sometimes, though, you're stuck working with some code that you don't control and that uses the plain old Exporter. Sub::Import gets around this problem by letting you import from that library with a number of the features otherwise found only in Sub::Exporter.

For example, say you want to use the useful but horribly named natatime routine from List::MoreUtils, and you want to give it a name that won't make you constantly wonder, "What's natural atime?" It's easy to use Sub::Import to get apply Sub::Exporter's renaming facility:

`1:  2:  3: `	`use Sub::Import 'List::MoreUtils' => natatime => { -as => 'iterate_by_n' }; my $iterator = iterate_by_n 3, @list;`

The import-to-scalar rename would work, too:

`1:  2:  3:  4: `	`my $by_n; use Sub::Import 'List::MoreUtils' => natatime => { -as => \$by_n }; my $iterator = $by_n->(3, @list);`

You're not limited to renaming single routines, either. You can use the prefix and suffix renaming for groups:

`1:  2:  3:  4:  5: `	`use Sub::Import 'Perl6::Junction' => -ALL => { -suffix => '_junction' }; if ($input == any_junction(1, 2, 3)) {   say "$input is okay"; }`

Many other advanced features are available too, like custom installers or generators, so even if you're working with a library that's still using stock Exporter, you're not stuck with its limitations.

A Logging Library that Really Stinks

2010-12-01T00:00:00-05:00

Couldn't you just use...

Yeah, probably. After all, there are over one hundred logging libraries on the CPAN. Probably there's something out there that's tolerable. The question is how to find it.

A few years ago, at work, we were really starting to suffer because of the totally haphazard approach to logging. Some code used Sys::Syslog, some code logged to files, some code used print. Some used internal solution A, and some used internal solution B. Given any two pieces of code, the odds were good that they didn't log the same way. Worse, lots of the code didn't log at all, because doing any logging was blocked by choosing how to log.

We wanted to standardize on something, and we didn't want to write our own logging framework. How would we choose from the overwhelming selection available on the CPAN? We picked the usual strategy: figure out what everybody else was using. The winner was Log::Log4perl, and we wrote up notes on how we'd go about standardizing, which mostly meant writing a comprehensive configuration and then using it everywhere. We got about as far as figuring out what syslog facilities to use for what and then balked. It felt like there were too many options to really move forward. We needed freedom from all that choice.

Our alternative had been Log::Dispatch, which has many of the same properties as Log4perl, but is less complex. In fact, we had quite a bit of code already using it, and that code was pretty easy to work with it. The only drag was that those programs often ended up with dozens of lines of code just to initialize the logger. It turned out that they were always the same lines of code, with just a few tweaks, though. We took that code and shoved it into a factory that built loggers and started using it everywhere. That made it a one-liner to set up a logger the way we liked.

Over time, the usual thing happened: we simplified our logging so much that it seemed silly not to simplify it more, and a sprintf facility was built into our logger (using String:Flogger). Then we added proxies so that subroutines of a program could use subloggers with built-in prefixes. Just about everything we log, now -- many gigabytes per day -- gets logged by Log::Dispatchouli.

Enough History, Let's See Some Code

So, how does it work? It's easy. First, you need to make a logger. Then you need to do it.

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`my $logger = Log::Dispatchouli->new({   ident => 'My::Awesome::Program',   facility => 'local2', # a syslog facility   to_stdout => 0, }); $logger->log("This is a boring message."); $logger->log([ "This will be passed through %s.", 'String::Flogger' ]);`

The logger only really has to know a couple things: what its identity is, where it will log, and whether it should discard debugging messages. There are a few other options, but they're pretty rarely needed. The example above covers the great majority of options that get used.

We can call log on our logger and give it strings or arrayrefs of String::Flogger args. Those arrayrefs are mostly just sprintf arguments, but non-strings (like references, objects, and undef) are converted to JSON, and we can defer evaluation of bits of the log message so that it won't be evaluated unless needed. This works well with the log_debug method, which logs only if our logger is in debug mode.

`1: `	`$logger->log_debug([ "Current score: %s", sub { $self->compute_score } ]);`

If compute_score is expensive, this is a big win, because we can avoid calling it unless we're actually going to log this message.

We can also make little proxies for use in subroutines, for example:

`1:  2:  3:  4:  5:  6: `	`for my $account_id (@account_ids) {   $self->do_work({     account => Account->retrieve($account_id),     logger => $logger->proxy({ proxy_prefix => "$account_id: " }),   }); }`

All the do_work calls will log with a proxy to the main logger that prefixes all logged messages with a fixed string.

This has been the state of the art for our logging for a few years now, and it's been a huge improvement, precisely because it has so few options.

Future Experiments

One of the biggest drags with Log::Dispatchouli is that we tend to pass around logger objects or proxies up or down the call stack. This can be a really annoying chore, and usually adds nothing to the program that couldn't be added other ways. The program's logging behavior is mostly a global issue. When we pass loggers to subroutines, right now, it's only to set a prefix or just to allow access to the logger at all.

We're experimenting with a promising new throwback interface, using a shared global variable. Globals are usually a bad idea, but sometimes you really do want a global! Globals also let you tie behavior to the execution context with local -- again, usually you don't want it, but consider the example above, rewritten:

`1:  2:  3:  4:  5:  6:  7:  8:  9: `	`use Log::Dispatchouli::Global '$Logger'; for my $account_id (@account_ids) {   local $Logger = $Logger->proxy({ proxy_prefix => "$account_id: " });   $self->do_work({     account => Account->retrieve($account_id),   }); }`

It looks about the same, but when we want to start using a proxy, we localize the shared variable instead of passing a lexical. That means that do_work doesn't need to look for a logger argument or decide what to do if none was passed. It justs uses the global, which is guaranteed to be there. Unlike many systems that use global variables, Log::Dispatchouli::Global can be subclassed to use distinct globals per subclass, so your application can have its own shared global that won't conflict with other applications, if you ever need to load more than one in a program.

RJBS Advent Calendar 2010

Advent is over! Go home!

Merry Christmas!

See Also

Rolling Your Own Method Dispatch

EXPERIMENTAL CODE AHEAD

Merry Christmas! Perl sucks!

Who cares?

Can&#39;t you just...

Overloading the Arrow

MRO::Magic in Action

Is this awesome?

So why isn&#39;t everybody using it?

See Also

Rolling Your Own Composition

Beyond Method Modifiers

Tags

Event Handling

Wacky New Composition is a Strategy of Last Resort

See Also

A Lousy Locker (...because Worse is Better!)

Optimizing for Failure

The Simplest Test That Could Possibly Work

See Also

Testing with Classes, Roles, and Antlers

Reuse, reuse, reuse

The Simplest Test That Could Possibly Work

Combining Routines

There&#39;s More Than One Way to Do It!

See Also

Shuffle Smarter, Not Harder

NOT ON THE CPAN

Albums as Atomic Units

albumen

The Gift of Music

See Also

Exporting Globs for Fun and Profit

What&#39;s a glob?

That Looks Really Dumb

I Never Want to Think About This Again!

Sub::Exporter::GlobExporter

See Also

We&#39;ll Have a Blue Christmas Without del.icio.us

What Color is Your Data&#39;s Parachute?

Using delbackup

See Also

When in doubt, add more globals.

EXPERIMENTAL CODE AHEAD

The Law of Demeter Sucks

The Content of The Context

Putting Things into Context

Specialized Context

The Future

See Also

Dealing with an Oversized Interface

Too Many Methods

Divide and Delegate

The Spoils of Refactoring

Making Success Repeatable

Under the Hood

See Also

Lovingly Mass-Produced HTML

Hand-Crafted Bugs

The Widget Factory

Adding New Products to the Factory

Experiments and Annoyances

See Also

Wanted: Gift, Got: Gift

The Case of the Invisible Differences

Comparing Encoded Text

See Also

All Marked Up with No Place to Go

NOT ON THE CPAN

Talk, talk, talk!

Making Stew from the CPAN

The Proof of the Stew is in the Eating

See Also

One People, One Address Book

Centralizing Your Config

Entries and Address Books

Can't you just...

So why isn't everybody using it?

There's More Than One Way to Do It!

What's a glob?

We'll Have a Blue Christmas Without del.icio.us

What Color is Your Data's Parachute?

One of Perl's `less`er Known Features

Disregard that, this is less 'useful'

Wait, RJBS didn't write `less`!

Everybody's Favorite Getopt

`describe_options`

Today's Gift, As-Is

It's a Time for Tolerance

Couldn't you just use...

Enough History, Let's See Some Code