MooX::LvalueAttribute - Lvalue accessors in Moo

Yesterday I was reading Joel's post, where he lists great Perl things he's seen done lately. Indeed these are great stuff. I was particulary interested by his try at playing with Lvalue accessors.

I thought that it would be a great exercise to try to implement it in Moo, as an additional feature, trying to get rid of the AUTOLOAD. Also, I was willing to avoid doing a tie every time an instance attribute accessor was called. Surely, I needed to tie only once per instance and per attribute, not each time the attribute is accessed.

So I started hacking on the code of Moo. Getting rid of the AUTOLOAD was easy, as I could change the way the accessor generator was, well, generating the, err, accessors.

Shortly after I started having issues to cache a tied variable. I asked the all-mighty Vincent Pit, and he found a solution for my tied variables, but more importanlty pointed me to Variable::Magic, which is faster, more flexible and powerful.

All I needed was to move my hacks in a proper Role, and wrap the whole in a module, and push it on CPAN. Tadaa, MooX::LvalueAttribute was born.

In the process I used play-perl to register my quests, and exchanged thoughts with Joel Berger. I think I'm going to use this website more, see if it can boost my productivity, and help me figure out what's really important to do.

On IRC, haarg discovered a bug and recommended to use so-called fieldhashes, from Hash::Util::FieldHash::Compat. At the end of the day, I only acted as a glue between different pieces of knowledges, and that was very satisfactory.

TL:DR

MooX::LvalueAttribute is a module that provides Lvalue attributes:

package App;
use Moo;
use MooX::LvalueAttribute;

has name => (

  is => 'rw',

  lvalue => 1,

);

# Elsewhere

my $app = App->new(name => 'foo');

$app->name = 'Bar';

print $app->name;  # Bar

Enjoy!

New Perl module: Action::Retry

I've just released a new module called Action::Retry.

Use it when you want to run some code until it succeeds, waiting between two retries.

A simple way to use it is :

use Action::Retry qw(retry);
retry { ... };

And the Object Oriented API:

Action::Retry->new( attempt_code => sub { ... } )->run();

The purpose of this module is similar to Retry, Sub::Retry, Attempt and AnyEvent::Retry. However, it's highly configurable, more flexible and has more features.

You can specify the code to try, but also a callback that will be executed to check the success or failure of the attempt. There is also a callback to execute code on failure.

The module also supports different sleep strategies ( Constant, Linear, Fibonacci...) and it's easy to build yours. Strategies can have their options as well.

my $action = Action::Retry->new(
  attempt_code => sub { ... },
  retry_if_code => sub { $_[0] =~ /Connection lost/ || $_[1] > 20 },
  strategy => { Fibonacci => { multiplicator => 2000,
                               initial_term_index => 3,
                               max_retries_number => 5,
                             }
              },
  on_failure_code => sub { say "Given up retrying" },
);
$action->run();

And the functional API:

use Action::Retry qw(retry);
retry { ... }
retry_if_code => sub { $_[0] =~ /Connection lost/ || $_[1] > 20 },
strategy => { Fibonacci => { multiplicator => 2000,
                             initial_term_index => 3,
                             max_retries_number => 5,
                           }
            },
on_failure_code => sub { say "Given up retrying" };

Strategies can decide if it's worthwhile continuing trying, or if it should fail.

Action::Retry also supports a pseudo "non-blocking" mode, in which it doesn't actually sleep, but instead returns immediately, and won't perform the action code until required time has elapsed. Basicaly it allows to do this:

my $action = Action::Retry->new(
  attempt_code => sub { ... },
  non_blocking => 1,
  strategy => { 'Constant' }
);
while (1) {
  # if the action failed, it doesn't sleep
  # next time it's called, it won't do anything until it's time to retry
  $action->run();

  do_something_else();

  # do something else while time goes on

}

of course do_something_else should be very fast, so that the loop goes back quickly to retrying the attempt_code.

Action::Retry is based on Moo for performance (and because the module is simple enough to not require Moose). Moo classes properly expand to Moose ones if needed, so there is no excuse not to use it.

So, please give a try to Action::Retry, and let me know what you think.

Mass-Testing Dancer's Plugins

So, as I said at YAPC::EU 2012, one thing that remains to be done before Dancer 2 can be released : migrating the plugins, making sure they work with it.

To be able to do that, what's best than an automatic testing facility ?

The goal is to get all Dancer plugins, test them with Dancer1, and Dancer2, and produce a report, to check which one fails and need fixing.

Step 1. Get the list of Dancer plugins.

Easy ! let's use Metacpan. After searching, I finally got a way to get the list of all modules that depend on Dancer. Then filtering out the ones that don't contain "Plugin" will do the trick.

#!/usr/bin/env perl

use Modern::Perl;

use ElasticSearch;

my $es = ElasticSearch->new( servers => 'api.metacpan.org', no_refresh => 1 );

my $scroller = $es->scrolled_search(

    query       => { match_all => { } },

    search_type => 'scan',

    scroll      => '5m',

    index       => 'v0',

    type        => 'release',

    size        => 100,

    filter => {

            term => {

                     'release.dependency.module' => 'Dancer'

                    }

              },

);

my $result = $scroller->next;

my %plugins;

while ( my $result = $scroller->next ) {

    $result->{_source}->{name} =~ /Dancer-Plugin/

      or next;

    my $name = $result->{_source}->{name};

    $name =~ s/-\d.*//;

    $name =~ s/-/::/g;

    $plugins{$name} = 1;

}

say $_ foreach sort keys %plugins;

Cool, let's save this script as get_modules_list.pl.

Step 2. Prepare two Perl environments

We want two instance of Perl, without polluting anything. We'll use perlbrew for that. Easy. The small trick is to have PERLBREW_ROOT initialized to a local directory to not polute existing ~/perl5 installation.

Step 3. Have a way to test modules

Well, let's use cpanm, which has an option --test-only to only test a module without installing it. Oh but plugin modules that we'll test may require dependances. We'll install them using cpanm --installdeps, which does just that.

Step 4. Create a result file

I was lazy and just output to a .csv text file, but I may store the results somewhere else later.

Step 5. Let's glue all that in a Makefile

The beauty of this is that by writing a proper Makefile, we can install this auto-tester anywhere. The requirements are minimal : bash, curl, and perl, with ElasticSearch and Modern::Perl installed.

( This post is intentionally named the same as the one from Yannick, because he proposed a different implementation. We'll try to merge the good ideas together )

HERE=${PWD}

# set up the local Perlbrew location

PERLBREW_DIR=${HERE}/perlbrew

PERLBREW=export PERLBREW_ROOT=${PERLBREW_DIR} \

    && source ${PERLBREW_DIR}/etc/bashrc \

    && PERLBREW_ROOT=${PERLBREW_DIR} ${PERLBREW_DIR}/bin/perlbrew

# This will run the cpanm from the local Perlbrew, on each of the 2 perls

CPANM_DANCER1=${PERLBREW} exec --with dancer1_plugin_tests ${PERLBREW_DIR}/bin/cpanm

CPANM_DANCER2=${PERLBREW} exec --with dancer2_plugin_tests ${PERLBREW_DIR}/bin/cpanm

# loop on the plugin list, install the deps and test each plugin and output result

all: got_curl got_bash got_perlbrew_perl plugins_list

    echo "Plugin name,Pass on Dancer 1,Pass on Dancer 2" > result.csv

    @for i in `cat plugins_list`; do pass_d1=0; pass_d2=0; \

      echo " ---------- TESTING on Dancer 1 : $$i"; \

          ${CPANM_DANCER1} -n --installdeps $$i \

              && ${CPANM_DANCER1} --test-only $$i && pass_d1=1; \

      echo " ---------- TESTING on Dancer 2 : $$i"; \

          ${CPANM_DANCER2} -n --installdeps $$i \

              && DANCER_FORCE_PLUGIN_REGISTRATION=1 ${CPANM_DANCER2} --test-only $$i \

              && pass_d2=1; \

          echo "$$i,$$pass_d1,$$pass_d2" >> result.csv; \

        done;

clean:

    rm -rf plugins_list

fullclean:

    rm -rf ${PERLBREW_DIR}

# Get and install Perlbrew locally

${PERLBREW_DIR}/bin/perlbrew:

    @echo " - creating a local perlbrew"

    export PERLBREW_ROOT=${PERLBREW_DIR} && curl -kL http://install.perlbrew.pl | bash

# Get and install cpanm in the local Perlbrew

${PERLBREW_DIR}/bin/cpanm:

    ${PERLBREW} install-cpanm

got_curl:

    @which curl >/dev/null \

        || ( echo "you don't have curl, please install it and retry" && false )

got_bash:

    @which bash >/dev/null \

        || ( echo "you don't have bash, please install it and retry" && false )

got_perlbrew_perl: ${PERLBREW_DIR}/bin/perlbrew ${PERLBREW_DIR}/bin/cpanm perlbrew_dancer1_plugin_tests perlbrew_dancer2_plugin_tests

# Build perl from scratch and call this instance dancer1

perlbrew_dancer1_plugin_tests:

    ${PERLBREW} list | grep dancer1_plugin_tests > /dev/null \

        || ( ${PERLBREW} install -j 2 -n perl-5.16.1 --as dancer1_plugin_tests )

# Build perl from scratch and call this instance dancer2

perlbrew_dancer2_plugin_tests:

    ${PERLBREW} list | grep dancer2_plugin_tests > /dev/null \

        || ( ${PERLBREW} install -j 2 -n perl-5.16.1 --as dancer2_plugin_tests \

             && ${CPANM_DANCER2} ${HERE}/../.. )

# This gets the list of plugins, as previously described

plugins_list:

    ${HERE}/get_modules_list.pl > plugins_list

It's really cool to see what you can do with modern tools of the Perl ecosystem !

Paris.pm technical meeting

( french version below )

The next Paris.pm technical meeting will happen the 25th september 2012, with:

• Elizabeth Cholet: Firefox automatization with Perl using AnyEvent, Coro and MozRepl modules

Location : 181 avenue Daumesnil, 75012 Paris, France

Google map : google map

If you are interested, and live in Paris, please join us ! If you need more info, ask in the comments.

La prochaine réunion technique de Paris.pm se tiendra mardi 25 septembre 2012, et le programme est :

• Elizabeth Cholet : l'automatisation de Firefox avec Perl en utilisant AnyEvent, Coro et les modules MozRepl

Adresse : 181 avenue Daumesnil, 75012 Paris

Google map : google map

Si vous êtes intéressé, n'hésitez pas à venir, entrée libre et gratuite. Pour plus d'info, demandez dans les commentaires.

dams.

MooseX::Singleton is slow

Just a quick note : if you plan to use MooseX::Singleton, beware ! It is easy to use and it implements properly what it claims, however it is quite slow.

If my profilings are corrects, each call to ->instance() calls meta(), get_metaclass_by_name() one time, and blessed() two times.

So for now I'll avoid it and implement a simplified version using something similar to this :

use Moose;

my $singleton;

sub instance {

    return $singleton //= $CLASS->new();

}

# to protect against people using new() instead of instance()

around 'new' => sub {

    my $orig = shift;

    my $self = shift;

    return $singleton //= $self->$orig(@_);

};

sub initialize {

    defined $singleton

      and croak __PACKAGE__ . ' singleton has already been instanciated'; 

    shift;

    return __PACKAGE__->new(@_);

}

dams.

Dancer is community-driven

Long time I haven't blogged about Dancer.

Antelink is a french startup, specializing in Software Life Cycle Management and Open Source Component Detection. They provided us with cool Dancer sourcecode analyzis graphs.

Overall contribution by users

.pm files contribution by users

Pod files contribution by users

Test files contribution by users

Reading these graphs

The surfaces represent a mean between the number of commits, and the weight of
modifications contributed (in term of "code line"), only when these are
original content addition. Moving content around isn't counted as active
contribution.

Note that some people are registered twice with different names, I'll try to
post an updated version

What does that demonstrate ? It shows that Dancer is really powered by its community. Decisions are made together, the code is hacked by multiple hands, and the management is done in a collegial manner on github.

It's a great reward to be visible on these graphs :)

More Graphs

UPDATE : Erwan (@Labynocle) sent me new graphics, they show the difference between core devs and contributors. By the ay, Erwan will be at the French Perl Workshop in Strasbourg, France.

So here we go :

.pm files contribution by groups

Pod files contribution by groups

Test files contribution by groups

As a side note, I've proposed 2 talks related to Dancer for YAPC::EU. One called "Dancer + WebSocket + AnyEvent + Twiggy", and an other one mixing Dancer, Log::Message::Structured and Message::Passing.

Let's hope they'll get accepted !

Cross Posting to blogs.perl.org

So, a while ago, I moved my blog to github, using jekyll and markdown, with jekyll integration in Emacs.

That works great, and I like the fasct that posting a blog entry is just a regular git push.

My blog is aggregated in some places, but it doesn't appear on blogs.perl.org, because it's not an aggregator (and that's cool, it's not its purpose). But, blogs.perl.org audience is big, and I'm missing all these potential readers (in improbable case people would actually be interested in what I have to say :) )

Anyway, so I decided to bite the bullet and write a script that would cross post my entry to blogs.perl.org. I made the script generic enough to work with different type of blogs, but here I'm going to explain only the blogs.perl.org specific case.

blogs.perl.org is a Movable Type blog engine. A look on Metacpan indicates us there is a Net::MovableType module. That's great, let's use that.

There is a catch: to use this module, you need your login, and your API password, not your regular password. You can get it easily though, by following these instructions (thanks to davorg for directing me to it).

To avoid storing the user / password in the script, and to have to pass it on the command line, let's have a configuration file, that will lie at ~/.crosspost.ini, and that we'll load with Config::Any::Merge.

The file name of the original post will have to be passed on the command line, using Getopt::Long and Path::Class to retrieve and slurp it.

Here is the configuration file.

# file ~/.crosspost.ini
[ main_blog ]
title = dams blog
url = http://damien.krotkine.com

[ blogs.perl.org ]

type = mt

username = foo

password = bar

url = http://blogs.perl.org/rsd.xml

And here's the code:

# file crosspost.pl

use Modern::Perl;

use Carp;

use Net::MovableType;

use Config::Any::Merge;

use Getopt::Long;

use Path::Class;

use Text::Markdown qw(markdown);

my $file;

GetOptions ("file=s"   => \$file)

  or croak "failed to parse command line options";

$file

  or croak "need a file";

$file = file($file);

# Get a hash representing the config file

my $cfg = (values %{Config::Any->load_files({files => [ $ENV{HOME} . '/.crosspost.ini' ], use_ext => 1 })->[0]})[0];

# Grab some main info

my $main_blog_title = $cfg->{main_blog}{title};

my $main_blog_url = $cfg->{main_blog}{url};

my $text = $file->slurp;

# In reality, I do some transformation on $text to interpret jekyll specific

# syntax

$text = "\n <i>cross-posted from [$main_blog_title]($main_blog_url)</i>\n\n" . $text;

# So now we have the content to be posted, but it's in markdown. Let's

# transform it in HTML

my $html = markdown($text);

# Then we loop on all the other blog to cross post to

foreach my $site (grep { $_ ne 'main_blog'} keys %$cfg) {

    say "posting to $site";

    my %properties = %{$cfg->{$site}};

    # for now we handle only movable type

    if ($properties{type} eq 'mt') {

        my $username = $properties{username};

        my $password = $properties{password};

        my $url = $properties{url};

        my $mt = Net::MovableType->new($url);

        $mt->username($username)

          or croak $mt->errstr;

        $mt->password($password)

          or croak $mt->errstr;

        We need to get the user's blog id

        my $user_blogs = $mt->getUsersBlogs

          or croak $mt->errstr;

        $mt->blogId($user_blogs->[0]->{blogid})

          or croak $mt->errstr;

        # finally, the post

        $mt->newPost({

                      title       => $title,

                      description => $html,

                      mt_allow_comments => $properties{allow_comments} // 1,

                     },

                     # uncomment this line to directly post it

                     # 1

                    );

    }

}

Missing in this code is some mungling of the text to manage jekyll specific syntax. And while I was at it, I improved it so that it supports cross-posting to twitter, using Net::Twitter, and posting only a short description of the entry. Here is an example (I had to create a custom Twitter app called blog-cross-poster)

Now, I just need to add a git hook to be executed at push time, check if there is a new post or a modified one, and cross post it. Yay !