Mojolicious and DBI handles

From http://toroid.org/ams/etc/mojolicious-db-handles we find this bit of code:

sub startup {
  my $app = shift;

  my ($user, $pass);
  # read $user and $pass from config file
  (ref $app)->attr(db => sub {
    DBI->connect("dbi:Mysql:database=$db",
                 $user, $pass)
    }
  );
}

The concept is that Morbo, or Starman, or whatever PSGI server is running your program, can use any kind of forking, but each instance of your program will execute the startup code and create its own database handle.

Some of the code is not too obvious:

  • ref $app returns the class name of the main object. In my tests, replacing this line with the more obvious: $app->attr(db =>… worked just fine. EDIT: Apparently the ref business is because he wanted the class method, although because there isn’t an instance method by the same name of attr, it doesn’t matter.
  • The attr(...) call is a Mojolicious method (see here) that is described as, “Create attribute accessor for hash-based objects.” What that means is, the call actually creates a function definition as a string, and then does an eval of the string, thereby creating the named function (db in this case) in the given namespace (ref $app) in this case.

And here’s how you get the data back out:

  $app->get('/test')->to(cb =>
               sub{ 
               my $self = shift;
               $Data::Dumper::Indent = 1;
               $self->render( 'text' => "TEST: ATTR of foo" . $self->app->foo .
                    "\n<pre>\n" . Dumper($self) . "</pre>" );
               });

It’s really a better idea to use DBIx::Connector anyway, but the startup attribute trick might come in handy elsewhere.  One note on DBIX::Connector − Under the heading, Execution Methods we see the code:

  $conn->run(sub { $_->do($query) });

It is not documented, but by reading the source (let’s hear it for free software!) what happens is that $_ is set, via the «local» keyword, to temporarily be the database handle (dbh) of the connection within execution of the code reference.

Thanks to mst and others on #perl for the assistance.

Postfix on bare CentOS install

Starting from scratch with a new CentOS 7 Linode, I found that iptables is set by default to block (although not reject) packets to the IMAP and POP3 services.

Rackspace has a good primer on setting up Dovecot that includes these instructions, but here’s the short answer:

sudo iptables -I INPUT 2 -p tcp --dport 587 -j ACCEPT
sudo iptables -I INPUT 3 -p tcp --dport 110 -j ACCEPT
sudo iptables -I INPUT 4 -p tcp --dport 143 -j ACCEPT
sudo iptables -I INPUT 5 -p tcp --dport 993 -j ACCEPT
sudo iptables -I INPUT 6 -p tcp --dport 995 -j ACCEPT
sudo /etc/init.d/iptables save
sudo /etc/init.d/iptables restart

That adds a rule to accept the IMAP and POP ports, both the regular and SSL versions. Then we save the chain table and restart iptables. Now you should be able to get in:
$ telnet myhost.wlindley.com imap
Trying myhost.wlindley.com... Connected to myhost.wlindley.com. Escape character is '^]'. * OK [CAPABILITY IMAP4rev1 LITERAL+ SASL-IR LOGIN-REFERRALS ID ENABLE IDLE STARTTLS LOGINDISABLED] Dovecot ready.

Perlbrew a 64-bit Perl on Linode

For some reason, even the 64-bit kernel on my Linode wasn’t sufficient for perlbrew to generate a 64-bit Perl. I was able to get one by doing:

perlbrew install 5.20.0 --64int

which resolved the problem I was having trying to install Minion with cpanm, namely the error “Perl with support for quads is required!” (from this bit of code, thanks mst on undernet #perl)

Moose data types

A quick reference to the built-in data types you can use in Moose. Use these when declaring a class, as with ‘isa':

 Data Type Possible Values
Any Note: [`a] is an optional extension
which means any Type 
Item
Bool undef, 0, empty string, or 1
Maybe[`a] undef or [`a]. e.g.: Maybe[Str]
Undef must be undef
Defined must not be undef
Value
Str string
Num looks like a number
Int integer
ClassName string that is name of a class
RoleName …of a role
Ref
ScalarRef[`a] e.g., ScalarRef[Value]
ArrayRef[`a]
HashRef[`a]
CodeRef
RegexpRef
GlobRef
FileHandle IO::Handle or Perl filehandle
Object any blessed reference
any Class e.g., MyClass or SQL::Abstract
assuming your program uses them

Full details, examples, and advanced capabilites are explained at https://metacpan.org/pod/Moose::Manual::Types

Cleanly create SQL with SQL::Abstract::More

Some years ago now, I had written my own wrapper around DBI to make common SQL statements easier to write. Awhile back I found SQL::Abstract and recently revisited some old code to bring it up to the modern era. I found that the related SQL::Abstract::More was almost a direct replacement for what I had written − except with more features and better debugged. Here’s an example:

#!/usr/env/perl

use strict;
use warnings;

use SQL::Abstract::More;

my $sqla = SQL::Abstract::More->new;

# More maintainable with named parameters.
($stmt, @bind) = $sqla->select(
    -columns => [qw(listname id description from_email),
         'mailing_list.active|active',
         "COUNT(subscriber.person_id)|subcribercount",
    ],
    -from => [qw(mailing_list subscriber)],
    -where => {'subscriber.list_id' => {'=', \ 'mailing_list.id'},
           'subscriber.active' => {'<>', \ 0}
    },
    -group_by => "list_id",
    );

print "$stmt\n" . join(',',@bind) . "\n";

The Above example produces the code ready to pass to SQL:

    SELECT listname, id, description, from_email, 
      mailing_list.active AS active, 
      COUNT(subscriber.person_id) AS subcribercount
    FROM mailing_list, subscriber
    WHERE ( ( subscriber.active <> 0 AND 
      subscriber.list_id = mailing_list.id ) ) 
    GROUP BY list_id

After that, it’s just a matter of execution:

my $sth = $dbh->prepare($stmt);
$sqla->bind_params($sth, @bind);
$sth->execute;

You could do the same thing with SQL::Abstract itself, but you have to use somewhat-undocumented features for the “as” and “group by” pieces. Specifically, you can use a scalar reference for a literal field name in the columns part, and shove the “group by” clause into the order field; but you’ll have to build the group clause yourself:

use SQL::Abstract;

my $sql = SQL::Abstract->new;

my ($stmt, @bind) =
    $sql->select([qw(mailing_list subscriber)], 
		 [qw(listname id description from_email),
		  \ "mailing_list.active AS active",
		  \ "COUNT(subscriber.person_id) AS subcribercount"
		 ],
		 {'subscriber.list_id' => \ '= mailing_list.id',
		  'subscriber.active' => \ '<> 0'},
		 "asc GROUP by list_id"
    );
print "$stmt\n" . join(',',@bind) . "\n";

Altogether, SQL::Abstract::More is superior.

Thoroughly Modern Perl

 

An overview of:

  • A bit of Perl history
  • Perl 5 −vs− 6
  • Perlbrew: Running modern and bleeding-edge programs on the same system as legacy
  • Unicode and UTF-8 in the Web world, and how to sort and capitalize names that are more than just English.
  • Perl 5’s heritage Object system −vs− the “new” Moose
  • Databases: Old-school SQL with injection vulnerabilities, SQL::Abstract, and DBIx
  • Tying it all together: Mojolicious

Download/view:

Finding shortest time or distance with Graph::Undirected

The Graph module on CPAN is mostly well documented. One place it falls short is explaining that not only can you create weighted edges, you can also use various edge attributes to calculate different minimum spanning trees (via Dijkstra’s algorithm) based on any given attribute.

Here we create a small network of railway lines between cities, from the example on page 9 in John Armstrong’s “Track Planning for Realistic Operation” (Kalmbach Books, 1986):

    • There are two routes from A to D: A-B-D, and A-C-D.
    • Here we assume that the route via B is longer but faster, and via C shorter but slower.
    • The line continues from D through E and G to H.
    • There is a branch line from E to F.

We calculate the shortest route by distance, and then by time.

Note the undocumented attribute parameter to SPT_Dijkstra().

#!/usr/bin/env perl
use strict;
use warnings;

use Graph::Undirected;

my $station_graph = Graph::Undirected->new();

# Add a few cities

$station_graph->add_path(qw(A B D E G H)); # first route via B
$station_graph->add_path(qw(A C D));	   # second via C
$station_graph->add_path(qw(E F));	   # branch route

# Define characteristics of the alternate routes

# Longer but faster
$station_graph->set_edge_attribute(qw(A B distance), 150);
$station_graph->set_edge_attribute(qw(A B time), 3.1);

# Shorter yet slower
$station_graph->set_edge_attribute(qw(A C distance), 120);
$station_graph->set_edge_attribute(qw(A C time), 3.3);

# Find spanning tree in distance
my $sptg1 = $station_graph->SPT_Dijkstra(attribute => 'distance');

print "Shortest Distance: ". join('|',$sptg1->SP_Dijkstra('A','H'));
print "\n";

# Clear cache (required for recalculation)
$station_graph->SPT_Dijkstra_clear_cache();

# Find spanning tree in time
my $sptg2 = $station_graph->SPT_Dijkstra(attribute => 'time');

print "Shortest Time:     ". join('|',$sptg2->SP_Dijkstra('A','H'));
print "\n";

1;

When run, this shows as follows:

$ perl Graph.pl 
Shortest Distance: A|C|D|E|G|H
Shortest Time:     A|B|D|E|G|H

If you want to use a directed graph, create the graph by replacing that line with:

my $station_graph = Graph::Directed->new();

and be sure to specify the starting node for the spanning trees:

my $sptg1 = $station_graph->SPT_Dijkstra(attribute => 'distance', first_root => 'A');
…
my $sptg2 = $station_graph->SPT_Dijkstra(attribute => 'time', first_root => 'A');

Printing Perl documentation

Why? There’s still nothing like printed documentation when you’re learning a new subject. Or perhaps you’d like a PDF document to view on your tablet.

Here’s the quickest way to create a PDF from any Perl documentation on your system. For example, let’s do the CPAN module SQL::Abstract:

pod2pdf `perldoc -l SQL::Abstract` > /tmp/SQL_Abstract.pdf

Now you can view or print that. I find print 2-up pages, double-sided (4 total pages per sheet) is a handy and space-saving yet still readable. You might find it useful to reduce the PDF margins and let ‘evince’ or ‘okular’ manage the actual 2-up physical margins later:

pod2pdf --margins 18 `perldoc -l SQL::Abstract` > /tmp/SQL_Abstract.pdf

The margins parameter is in printer’s points (1/72 inch) and 18pt = ¼inch (0.635cm). You can also specify –left-margin as well as right, top, and bottom margins individually.

Excellent Moose introductions and tutorials

Modern Perl (see also the Modern Perl book) is based on, among other things, Moose as an object system, built on Perl 5’s innate but spare O-O abilities.

This introduction [houseabsolute.com] explains not only Moose itself but quickly, and fairly painlessly, brings you into modern object orientation.

Also, Moose Is Perl − A Guide to the New Revolution [oreilly.com] − an over 400-page guide from the introductory to the detailed.

CPAN tricks

What modules are installed on my system?

# cpan -l

From the cpan prompt, how can I tell whether a module is already installed, and what version?

cpan> i module_name

And how can I tell which modules are out-of-date or have updated versions?

cpan> r

…which gives a result like:

Package namespace installed latest in CPAN file
Archive::Extract       0.70   0.72 BINGOS/Archive-…0.72.tar.gz
Attribute::Handlers    0.94   0.96 SMUELLER/Attribute…0.96.tar.gz
AutoLoader             5.73   5.74 SMUELLER/AutoLoader-5.74.tar.gz
B::Debug               1.18   1.19 RURBAN/B-Debug-1.19.tar.gz
Carp                   1.29 1.3301 ZEFRAM/Carp-1.3301.tar.gz
Clone                  0.36   0.37 GARU/Clone-0.37.tar.gz
Compress::Bzip2        2.16   2.17 RURBAN/Compress-….tar.gz
DB_File               1.827  1.831 PMQS/DB_File-1.831.tar.gz
Data::Dumper          2.145  2.151 SMUELLER/Data…151.tar.gz
…

"Si datur citrea, sucus faciunt" (When life gives you lemons, make lemonade)