fREWdiculous!
22 Aug
I’m excited to announce a new version of Catalyst::ActionRole::PseudoCache.
New in the current release of Catalyst::ActionRole::PseudoCache is that it can now use Catalyst::Plugin::Cache as the underlying cache mechanism. The main reason was that the existing architecture didn’t work for multiple servers, which is how our system works. Plus this is just better overall.
In the long term I will be removing the old “Pseudo” cache. It might be a good idea to make a separate package with a better name at some point, but that will be for the next release. Enjoy!
8 Aug
This week I
2 Aug
One of the projects that I worked on last year had a number, five I think, of background daemons. Basically the way we implemented this was by making a DoesRun role that looked something like the following:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
And then a typical Runner class looked something like this:
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 | package Lynx::SMS::Runner::Voice; use Moose; use Log::Contextual::SimpleLogger; use Log::Contextual qw( :dlog :log ), -default_logger => Log::Contextual::SimpleLogger->new({ levels => [qw( warn error fatal )]}); with 'Lynx::SMS::DoesRun'; has schema => ( is => 'ro', required => 1, ); sub single_run { my $self = shift; log_debug { 'Processing voice messages' }; my $guard = $self->schema->txn_scope_guard; while ($self->schema->resultset('MessageChild')->voice->unsent->not_blocked->count) { ... } $guard->commit; } no Moose; __PACKAGE__->meta->make_immutable; 1; |
And lastly, a script using the runner looked like this:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | #!/usr/bin/env perl use 5.12.1; use warnings; use rlib; use Lynx::SMS::Runner::Voice; use Lynx::SMS::Schema; use Config::ZOMG; my $config = Config::ZOMG->open( name => 'Lynx::SMS', path => '.', ); my $voicer = Lynx::SMS::Runner::Voice->new( schema => Lynx::SMS::Schema->connect( $config->{Model}{DB}{connect_info} ), period => 60, # seconds ); $voicer->run; |
Anyway, that was all well and good, but at some point things would die and the whole thing would come crashing down, so then we started adding an eval around the call to run in the script, and then I thought, “someone must have done this before…” So I asked in the #catalyst channel on irc.perl.org and rafl pointed out that this is what event loops (POE being the oldest and probably most popular) are great at.
So I updated the run method in the DoesRun role, so now it looks like this:
1 2 3 4 5 6 7 8 9 |
Ok, cool enough, it basically does the exact same thing as before except it never dies. But then I had an idea, on a server with 16 Gigs of RAM and a dual quad-core CPU five fat perl daemons is hardly an issue. But when developing it’s certainly a hassle to have to start them all up myself. So why not combine them and have them all run in the same process? Cake! I made the following Runner class to do the magic:
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 | package Lynx::SMS::Runner; use Moose; has tasks => ( is => 'ro', default => sub { [] }, ); sub run { my $self = shift; my $j = AnyEvent->condvar; my $x = 0; my @tasks = @{$self->tasks}; @tasks = map { my $task = $_; AnyEvent->timer( after => ($x++ / @tasks), interval => $task->period, cb => sub { $task->single_run }, ) } @tasks; $j->recv; } no Moose; __PACKAGE__->meta->make_immutable; 1; |
The after thing is weird, but the idea there is that each task will start at a different time, so things are more likely to run at a different time. Not really important, but it makes the logs easier to follow for me.
And then here is my script using 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 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | #!/usr/bin/env perl use 5.12.1; use warnings; use rlib; use Lynx::SMS::Runner::SMS; use Lynx::SMS::Runner::Voice; use Lynx::SMS::Runner::Emailer; use Lynx::SMS::Runner::Notifier; use Lynx::SMS::Runner; use Lynx::SMS::Schema; use Config::ZOMG; use Lynx::SMS::Logger; use Log::Contextual -logger => Lynx::SMS::Logger->new({ levels_upto => 'trace', format => '[%d] %m', }); my $config = Config::ZOMG->open( name => 'Lynx::SMS', path => '.', ); my $schema = Lynx::SMS::Schema->connect($config->{Model}{DB}{connect_info}); my $runner = Lynx::SMS::Runner->new( tasks => [ Lynx::SMS::Runner::SMS->new( schema => $schema, period => 1, # seconds ), Lynx::SMS::Runner::Voice->new( schema => $schema, period => 1, # seconds ), Lynx::SMS::Runner::Emailer->new( schema => $schema, period => 60*5, # 5 minutes ), Lynx::SMS::Runner::Notifier->new( schema => $schema, period => 60*60*24, # 1 day ), ] ); $runner->run; |
One thing that would improve this whole thing would be to capture dies or whatever and log $@ in our standard error logger thing. I haven’t quite figured out how to do that yet, but if someone knows how and comments I’d appreciate it.
1 Aug
Today I purchased 59 Seconds, recommended by Jeff Atwood. I struggle with procrastination as much as anyone else so I’m willing to spend 10 bucks to try to get more done. The author recommends four things to attain a given goal:
I’ve kinda slacked off with Open Source stuff the past year (see the graph at metacpan) and I’d like to remedy that.
My overall goal is to participate more (more blogging, more patches/pull requests, more releases and bug fixes for my own modules, etc.)
The book recommends breaking the overall goal into five for fewer distinct subgoals that are measurable and whatnot, so here are my subgoals:
For example submit a patch or release a distribution. Pushing to github isn’t permanent
I think this is pretty feasible. I have a huge backlog of things to do (which I’ll post, semi-prioritised at the end of this post) and I already set aside time on Mondays and Fridays to get stuff done.
To get this done I’ll work on stuff 2-3 hours on Monday night and 2-3 hours Friday night (assuming nothing is going on.) I also might do stuff Tuesday or Wednesday, but time is scarce with wedding planning. I’ll work on the most important things first, and after that’s done I’ll work on the most fun stuff; the idea being that I can get two things done in a week that way.
I’ll count this as achieved (though I don’t want to stop) after I’ve done two public things a week for two months straight. I’ll post weekly progress reports every Monday when I start hacking about the previous week.
My reward for finishing this is to buy myself a new car stereo.
Again, this sounds reasonable. I have a long list of half finished posts that I should just clean up and post. These should keep me busy for a while.
I’ll have a similar plan for this as I do for Subgoal 1; instead of Monday and Friday I’ll do Tuesday and Sunday. I’m a little nervous about those days as the are mostly booked for the foreseeable future, but what I hope to do is use remaining time on Mondays and Fridays to work on blogging.
I’ll count this as achieved after I’ve done two tech blog posts a week for eight weeks straight. Weekly progress shouldn’t be necesary
My reward for finishing this is to buy myself new car speakers.
Currently I am not very good about using a bug tracker for anything other than work. I’ve used Google’s bug tracker, github’s issue tracker, RT, and am currently toying with ticgit. I need to pick something, get good at it, and stick with it.
I think I can do this. It mostly takes discipline to pull this off. I need to just add stuff to whatever bug tracker every time I am going to add a new feature, fix a bug, clean stuff up, whatever. I think I’m gonna use ticgit for now since I don’t want to write my own bug tracker yet.
I’ll count this achieved after every single one of the things from Subgoal 1 that are my own modules use the bugtracker I’ve chosen.
My reward for finishing this is to buy myself an amp for my car stereo.
In the book he says you should state three benefits that you would get from finishing your goal. My three benefits are: I would be more respected in the community; my life would be easier as I’d have the things that I’ve been wanting for a while; and lastly, I could get more organized and more quickly ramp up on doing things.
17 May
I have now converted something like 25 repositories from svn to git. I can fix undetected merges, correctly import tags, and clean up ugly (svk) commit messages.
With this knowledge I hope to write a small, non-free eBook (7.50 USD I think.) But first I’d like a chance to convert your repository! The more repositories that I convert the more ground the ebook can cover. I’ve converted a number of repos for CPAN modules and I’d love to do more. My first thought was to convert the modules in the Catalyst repo, but sadly I’m not sure which ones I should do.
So if you are interested in having your repo converted, I am totally willing to do it. All I need from you is an email, comment, ping, etc saying you are interested and I need to you be willing to check the converted repo to ensure that it’s good. I’ve gotten pretty good at this but I’m not perfect and I’m not taking the blame if you miss something
If you’d like to try your hand at doing this, I put all my conversion scripts online, so feel free to take a peak.
13 Apr
I’m just releasing my first new release of DBIx::Class::DeploymentHandler in six months! For the most part the release is just a few doc tweaks, but it does have one important new feature, the “_any” version.
If you didn’t already know, DBICDH has a handy little directory structure for how your deploys work. If you haven’t seen it, take a look. This new release allows you to use _any in place of a version or version set, which will run the given files no matter what version you are deploying to.
Enjoy!
15 Mar
Thanks to some idle chatting in the #dbix-class channel on irc.perl.org I came up with DBIx::Class::Helper::Row::RelationshipDWIM. The gist of it is that you get to type
1 | __PACKAGE__->has_many(addresses => '::Address', 'person_id' ) |
instead of
1 | __PACKAGE__->has_many(addresses => 'MyApp::Schema::Result::Address', 'person_id' ) |
That yields a total sugar (with candy) of the following:
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 Lynx::SMS::Schema::Result::MessageParent; use Lynx::SMS::Schema::Candy; primary_column id => { data_type => 'int', is_auto_increment => 1, }; column account_id => { data_type => 'int' }; column type_id => { data_type => 'int' }; column caller_id => { data_type => 'int', size => 11, is_nullable => 1, }; column message => { data_type => 'nvarchar', size => 1000, }; column when_created => { data_type => 'datetime', set_on_create => 1, }; column voice_id => { data_type => 'int', is_nullable => 1, }; belongs_to account => '::Account', 'account_id'; belongs_to voice => '::Voice', 'voice_id'; belongs_to type => '::Type', 'type_id'; has_many children => '::MessageChild', 'message_parent_id'; 1; |
Pretty nice.
9 Mar
I’m extremely proud to announce a fairly major release of DBIx::Class::Candy, 0.002000. Not only are the tests much more complete as well as the underlying code much more comprehensible, but the usage of the Candy can now be even sweeter.
To get the full features of DBIx::Class::Candy you’ll want to first create the following base class:
(Of course you can call this sugar if you hate my naming scheme or rainbows if you love it.)
1 2 3 4 5 6 7 8 9 | package MyApp::Schema::Candy; use parent 'DBIx::Class::Candy'; sub base () { 'MyApp::Schema::Result' } sub perl_version () { 12 } sub autotable () { 1 } 1; |
Now a basic id, name table would look like this:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | package MyApp::Schema::Result::Permission; use MyApp::Schema::Candy; primary_column id => { data_type => 'int', is_auto_increment => 1, }; unique_column name => { data_type => 'varchar', size => 30, }; 1; |
id got set to the pk, name got a unique constraint, the table was named permissions, perl 5.12 features were imported, the base class was set to MyApp::Schema::Result. How awesome is that! Not that you can do the same thing as above without a subclass if you like still:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | package MyApp::Schema::Result::Permission; use DBIx::Class::Candy -base => 'MyApp::Schema::Result', -perl5 => v12, -autotable => v1; primary_column id => { data_type => 'int', is_auto_increment => 1, }; unique_column name => { data_type => 'varchar', size => 30, }; 1; |
I should give credit where credit is due. Getty had lots of ideas for improvements, but the first one I implemented (due to how easy it was and how much I liked it) was primary_column. mst had the idea of automatically generating the table name and using a subclass of candy to avoid boilerplate. Enjoy!
17 Feb
My fiancée and I have not yet picked out a date for our wedding, but we do know that we want it outdoors. We have scoped out a number of locations that can handle indoor and outdoor weddings just in case there is bad weather, but we’d prefer to have perfect weather.
After some searching I found NOAA’s NSSL, which has ridiculous amounts of data. Instead of most websites, which give you the average high temperature and average low temperature for a given day of the year from the past three years, this gives hourly measurements for basically anything back to 1910. Of course some stations are newer and whatnot, but it’s a lot of data.
Their website only lets you get one day of data at a time, so I wrote a screen scraper using the excellent Web::Scraper. Here’s most of 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 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | #!/usr/bin/env perl use Modern::Perl; use JSON; use URI; use Web::Scraper; # http://www.unidata.ucar.edu/cgi-bin/gempak/manual/apxA_index my %data_to_grab = ( SMPH => 'wind-speed', TMPF => 'temperature', RELH => 'humidity', ); my $data_str = join ';', sort keys %data_to_grab; my $weather = scraper { # there isn't a class, so we find the table with width 90 process "table[width=90] tr", "datas[]" => scraper { process "td:nth-child(2)", 'when' => 'TEXT'; my $i = 2; for (sort keys %data_to_grab) { $i++; process "td:nth-child($i)", $data_to_grab{$_} => 'TEXT'; } }; }; sub moar_data { my ($y, $m, $d) = @_; my $res = $weather->scrape( URI->new(sprintf 'http://data.nssl.noaa.gov/dataselect/nssl_result.php?datatype=sf&sdate=%4i-%02i-%02i&hour=00&sdate2=%4i-%02i-%02i&hour2=23&outputtype=list¶m_val=%s&area=&area=@DFW', $y, $m, $d, $y, $m, $d, $data_str)); warn sprintf "%4i-%02i-%02i\n", $y, $m, $d; sleep 3 + rand(2); grep { # undefined when means there wasn't actualy an observation defined $_->{when} && # ignore headers $_->{when} ne 'YYMMDD/HHMM' } @{$res->{datas}} } my @end = ( map { my $year = $_; (map { moar_data($year, 9, $_) } (1..30)), (map { moar_data($year, 10, $_) } (1..31)), } ( 1990..2010 ) ); print to_json(\@end, { pretty => 1 }); |
The scraper object grabs a bunch of the data from TD’s in the table, skipping the first TD. I made the moar_data function which just takes year, month, day so that I could get more data. It outputs all the data as json, my prefered data format.
If you did the math at home, you realized this is a ridiculous amount of observations; something along the lines of 14 thousand observations. That means you can’t just look at it. So I also wrote a little tool to slice and dice the data. Check it out:
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 | #!/usr/bin/env perl use Modern::Perl; use JSON; use List::Util qw(min max); use Statistics::Basic qw(mean stddev); my $field = $ARGV[0]; die "please choose a field to research" unless $field; die "$field is not a valid field!" unless grep { $_ eq $field } qw(wind-speed temperature humidity); # expected format: # [ # { # wind-speed => 123, # temperature => 123, # when => 'YYMMDD/HHMM', # }, # ... # ] my $data = from_json(do { local $/ = undef; open my $fh, 'weather.json'; <$fh> }); # final format: # MMDD/HHMM => [{...}], my %by_day; for (@$data) { my $when = $_->{when}; $when =~ s/^\d\d//; # remove the year part $by_day{$when} = [] unless $by_day{$when}; push @{$by_day{$when}}, $_; } say 'datetime ,mean ,stddev,min,max '; for (sort keys %by_day) { my @list = map $_->{$field}, grep { # this is weird, -9999.00 is apparently what they used # before they had undef? defined $_->{$field} && $_->{$field} != -9999.00 } @{$by_day{$_}}; my $avg = sprintf '%3.2f', mean \@list; my $min = sprintf '%3.2f', min @list; my $max = sprintf '%3.2f', max @list; my $stddev = sprintf '%3.2f', stddev \@list; say "$_,$avg,$stddev,$min,$max"; } |
Anyway, this was a fun project and a nice little valentines day surprise. Hope someone finds it useful
12 Feb
Hello All!
Some of you already know that I am working on converting the Catalyst repository to git. I am happy to announce that I am closing in on completion!
The current state of the git repo: https://github.com/frioux/Catalyst
The script to convert it: https://github.com/frioux/Git-Conversions/blob/master/cat-convert
The only things I know of that we must have before we finalize this conversion is:
Also, if you’d like to help ensure the sanity of the repo it would be great if you looked at it! Here are a few tools I use to try to get a feel for the quality of the final export:
1 | gitk --all |
Perusing the repo with gitk is good; another great thing to do is to View -> Edit View and click “Strictly sort by date”. This is helpful for finding duplicate commits. Note that there are some commits that look duplicate in this repo but actually aren’t; people decided it would be best to edit multiple branches in a single commit instead of just dealing with that at merge time.
1 | git shortlog -s |
This will make it clear if I misspelled your name.
Also looking at blames of files can be handy.
Hopefully this helps!
Update: hobbs found confirmation for rjk and identity for didls, so we are good to go assuming no one finds any issues.
(I hope to have a long blog post soon explaining some of the techniques I used to get this all working. Be prepared though, I’m not as smart as Haarg, so mostly it’s a manual process
)