Skip to content

URL, Devel::Declare and no strings attached

December 16, 2009

This Hacker News article caught my eye yesterday which pointed to a blog post about having a raw URL within a Ruby program using some clever shenanigans. (They you go, I saved you having to click through to find all the links yourself!)

Some examples from blog post:

# display this JSON request
puts http://github.com/defunkt.json

# => "He nose the truth."
require 'json'
url = http://twitter.com/statuses/show/6592721580.json
JSON.parse(url.to_s)['text']   

Very clever indeed. Of course there will be some edge cases but it does show you how far you can stretch Ruby. NB. Didn’t work in 1.9 for me but worked with minor warning in 1.8.2 (yes I know it old but thats what shipped with Mac OSX Tiger).

So how far can we stretch Perl? Well with Devel::Declare it can be stretched all the way:

use Modern::Perl;
use JSON qw(decode_json);
use URLDSL;

# print the json
say http://twitter.com/statuses/show/6592721580.json;

# => "He nose the truth."
say decode_json( http://twitter.com/statuses/show/6592721580.json )->{text};

So Perl also has no strings attached πŸ˜‰

Devel::Declare allow us to extend the Perl syntax in a robust and easy fashion:

package URLDSL;
use Modern::Perl;
use Devel::Declare ();
use LWP::Simple ();
use base 'Devel::Declare::Context::Simple';

sub import {
    my $class  = shift;
    my $caller = caller;
    my $ctx    = __PACKAGE__->new;
    
    Devel::Declare->setup_for(
        $caller,
        { 
            http => { 
                const => sub { $ctx->parser(@_) },
            },
        },
    );
    
    no strict 'refs';
    *{$caller.'::http'} = sub ($) { LWP::Simple::get( $_[0] ) };
}

sub parser {
    my $self = shift;
    $self->init(@_);
    $self->skip_declarator;          # skip past "http"

    my $line = $self->get_linestr;   # get me current line of code
    my $pos  = $self->offset;        # position just after "http"
    my $url  = substr $line, $pos;   # url & everything after "http"
    
    for my $c (split //, $url) {
        # if blank, semicolon or closing parenthesis then no longer a URL
        last if $c eq q{ };
        last if $c eq q{;};
        last if $c eq q{)};
        $pos++;
    }    
    
    # wrap the url with http() sub and quotes
    substr( $line, $pos,          0 ) = q{")};
    substr( $line, $self->offset, 0 ) = q{("http};
    
    # pass back changes to parser
    $self->set_linestr( $line );

    return;
}

1;

 

Here is a low level synopsis of how it worked:

  • Devel::Declare tells the perl parser to call parser() when it hits http keyword
  • http://twitter.com/statuses/show/6592721580.json example triggers this (perl has no problem naturally distinguishing “http” keyword from “http://”)
  • Get line of code in question (my $line = $self->get_linestr; )
  • parser() skips along the URL data following “http” ($self->offset) until it reaches a space, semicolon or a closing bracket (this covers “most” cases though comma could be an issue). This marks the end of the URL data
  • We now in essence change http://twitter.com/statuses/show/6592721580.json into http("http://twitter.com/statuses/show/6592721580.json")
  • And plonk the changed line back to the parser ($self->set_linestr($line);) and let it continue along its merry way
  • NB. http() sub was already imported into calling space and returns a LWP::Simple::get of the requested URL

 

Now is URLDSL useful in the real world? It can screw up syntax highlighting a bit (though WordPress highlighter coped extremely well, unlike Github 😦

Its robust enough to cope with normal string interpolation:

my $id = '6592721580';
say decode_json( http://twitter.com/statuses/show/$id.json )->{text};

So perhaps I should upload it to CPAN? (earmarked for ACME:: perhaps!?). Anyone think this is useful little helper module then I wrap it up the next time I get a free moment.

The exercise as been fruitful in allowing me to get my head into the amazing Devel::Declare module for the first time.

I’ve used the Devel::Declare::Context::Simple class which simplifies things. Unfortunately there isn’t a POD on this yet but the main Devel::Declare docs nicely demonstrate the correct mechanics so its easy to adapt from this.

I also found this blog post by franck cuny to be extremely helpful. As was delving through the source code of other modules that used Devel::Declare

/I3az/

Keeping to a schedule

December 13, 2009
tags:

When I made my Blogging Milestone post I decided to have a crack of writing Perl posts to a fixed schedule.

The Blogging Milestone post marked ten days since the previous post (ie. the Iron Man limit!). The following posts would continue to happen but reduced by a day each time. So next was 9 days later… then 8 days later… then 7 days later… until I reached zero days… my last post.

Phew… it did take a bit of effort to keep to a strict deadline but it is a good carrot & stick to keep you going!

Obviously I felt confident enough that I could do it (but not confident enough to announce that I was doing it!) and having lots of blog ideas written down + some partially composed ones does help πŸ˜‰

For all those posters that are doing Perl advent calendars at the moment I know what you must be going through and my hats off to you all.

/I3az/

to DO or not to DO, that is the question

December 6, 2009
tags:

Following on from yesterdays post about do blocks, this is what I would normally do off the bat:

sub word_freq {
    my %words;
    $words{$_}++ for split /\s+/, lc $_[0];
    \%words;
}

Returning back a hash reference is both leaner and meaner πŸ˜‰

use List::Util qw(sum);

my $s = "The green hat is tHe twin of the green hat";

my $num_of_hats = word_freq( $s )->{ hat };   # word count just for 'hat'

# don't worry... always unique hashrefs returned:
my $hash_ref    = word_freq( $s );
my $hash_ref2   = word_freq( $s );       

# thus you can safely:
$hash_ref2->{green} = 100;
say "$hash_ref->{green} : $hash_ref2->{green}"; # => "2 : 100"    

# clean copy for those who prefer there hashes not to be hashrefs!
my %hash = %{ word_freq( $s ) };       

# returns ( 'is', 'of')
my @two_letter_words  = grep { length $_ == 2 } keys %{ word_freq( $s ) };

# number of "green" + "hat" == 4
my $green_plus_hat = sum @{ word_freq( $s ) }{ qw/green hat/ };

 

And what I probably wouldn’t do is:

use List::MoreUtils qw(uniq);

my $s = "The green hat is tHe twin of the green hat";

my %words = do {
    my @words = split /\s+/, lc $s;
    map { 
        my $word = $_; 
        $word => scalar grep { $_ eq $word } @words;
    } uniq @words
};

I actually prefer the code aesthetics of this but the extra cycle (grep) through @words pushes me towards the leaner hash counting solution. Horses for courses? πŸ˜‰

/I3az/

Anything you can DO I can DO better

December 5, 2009
tags: ,

Here is a simple world count in Ruby from recent post at Refactormycode.com:

s = "The green hat is the twin of the green hat"
h = Hash.new(0)
s.split.each do |w|
  h[w.downcase] += 1
end

If you know Ruby then you know this isn’t very idiomatic. Here is something closer to would normally see in Ruby world:

h = s.downcase.split.inject(Hash.new(0)) { |h,k| h[k] += 1; h }

But the style of the original code is something I’ve seen often in Perl:

my $s = "The green hat is tHe twin of the green hat";
my %h; 
for my $w (split /\s+/, $s) {
    $h{ lc $w }++;
}

Now if brevity was key to better code then you could do this:

my %h; $h{$_}++  for split /\s+/, lc $s;

But I think its better to do something like this:

my %words = do { 
    my %h;
    $h{$_}++  for split /\s+/, lc $s;
    %h;
};

OK this is not a great example of do blocks and isn’t even as DRY compared to original code. But I do find this more aesthetic IMHO.

Perhaps a better example of what do blocks can do is to produce another naff example!

my $num_string = do {
    my $num = get_random_num_between_1_and_3();
    if    ($num == 1) { 'one' }
    elsif ($num == 2) { 'two' }
    elsif ($num == 3) { 'three' }
};

do blocks return the last evaluated result. And result can be plural:

my $year = get_year();
my ($champions, $runners_up) = do {
    if    ($year == 2003) { ('England', 'Australia')    }    
    elsif ($year == 2007) { ('South Africa', 'England') }
};

say "Rugby World champions for $year: $champions  Runners up: $runners_up";

So do blocks are useful tools in helping to make code more focused and avoid unnecessary pollution of variables into calling namespace.

But we can either move up another notch by using anonymous subroutines:

my ($champions, $runners_up) = sub {
    given ($_[0]) {
        when (2003) { return ('England', 'Australia')    }
        when (2007) { return ('South Africa', 'England') }
    }
}->( get_year() );

This anon sub block is built and then immediately executed by the ->() bit.

So works much like a do block except we can short circuit flow with return thus enabling us more freedom and control over what these blocks of code can do.

Using do / anon sub blocks is something that Perl can definitely learn from Ruby. Here is another recent example of do usage that I like a lot (see has).

NB. Another advantage of the do / anon sub block approach is that at anytime the block gets big or its needed elsewhere then it doesn’t take much to turn it into a proper subroutine.

 

I’ll end with my obligatory autobox solution of the original code:

my $s = "The green hat is tHe twin of the green hat";

my %words = $s->lc->split( qr{\s+} )->hash_count->flatten;

sub autobox::Core::ARRAY::hash_count {
    my $list = shift;
    my %h;
    $h{$_}++ for @$list;
    \%h;
}

You can even do:

'The green hat is the twin of the green hat'->lc->split( qr{\s+} )->hash_count->flatten;

But I can’t think where something like this would ever be useful in the real world? Though it is nice to look at when running it via the extremely useful Devel::REPL πŸ˜‰

/I3az/

Github and POD

December 3, 2009
tags: , ,

If you look at the Github README formatting guide you will notice a feature request for POD that yours truly left there 10 months ago.

Recently I noticed that POD’s on Github were being rendered now (which may have been the case for quite a while and simply passed me by!). For eg. chromatic’s Modern Perl Book outline.pod.

So I added a README.pod to my Builder repo on Github and it works taking precedence over the plain README when rendering the repo landing page.

So no need to resort to using Markdown or Textile… its POD all the way! Hats off to Github for adding POD.

This is the README.pod I ended up with after a few trial attempts:

=head1 Builder

Build XML, HTML and (eventually!) other outputs in blocks
 

=head2 VERSION

version 0.04

This distribution includes the following modules:

    Builder             (0.04)
    Builder::Utils      (0.02)
    Builder::XML        (0.02)
    Builder::XML::Utils (0.02)
    

=head2 SYNOPSIS

Using building blocks to render XML, CSS, HTML and other outputs.

    use Builder;
    my $builder = Builder->new;
    my $xm      = $builder->block( 'Builder::XML' );
    
    
    # example 1
     
    $xm->parent( { isa => 'Mother' }, $xm->child( 'Hi Mum!' ) );
    say $builder->render;
    
    # <parent isa="Mother"><child>Hi Mum!</child></parent>
    
    
    # example 2
     
    $xm->parent( sub {
        for my $say qw/Mum Dad/ {
            $xm->child( "Hi $say" );
        }
    });
    
    say $builder->render;
        
    # <parent><child>Hi Mum</child><child>Hi Dad</child></parent>


=head2 INSTALLATION

To install this module, run the following commands:

	perl Build.PL
	./Build
	./Build test
	./Build install


=head2 DEPENDENCIES

This module requires these other modules and libraries:

	Carp


=head2 SUPPORT AND DOCUMENTATION

After installing, you can find documentation for this module with the
perldoc command.

    perldoc Builder


=head2 COPYRIGHT AND LICENCE

Copyright (C) 2008,2009 Barry Walsh (Draegtun Systems Ltd)

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

/I3az/

Update 08-Dec-2009: I’ve now amended the GitHub README formatting guide wiki to show that POD is now a supported format

Eulergy

November 30, 2009
tags:

It wasn’t my plan to get into all things Euler when I started this thread two posts ago.

However it has been a nice little tangent and doing a Google on Perl+Euler does throw up a number of links (over 100K of them in fact). Its worth following up some of these and playing around with the problem and the published code.

One such link is the blog post Distrust Simplicity: PROJECT EULER, PROBLEM #1. This post shows solutions to Euler problem 1 in Ruby, Python, Common Lisp, Clojure, Haskell and Perl.

Here is the Perl solution provided in said post:

#!/usr/bin/perl
use strict;
use List::Util qw(reduce);

# find the natural numbers less than 1000 divisible by 3 or 5
my @multiples = ();
foreach (1..999) {
    if ($_ % 3 == 0 || $_ % 5 == 0) { push(@multiples, $_); }
}

# sum them
print reduce { $a + $b } @multiples;

This could be simplified with a functional twist like most of the other solutions provided:

use Modern::Perl;
use List::Util qw(sum);

say sum grep { $_ % 3 == 0 || $_ % 5 == 0 } 1..999;

And lets not forget our mandatory autobox variation!

use Modern::Perl;
use autobox::Core;

[1..999]->grep( sub{ $_ % 3 == 0 || $_ % 5 == 0 } )->sum->say;

 
Another link I noticed which may bear fruit in the future is a very new Github repo for Project Euler solutions in Modern Perl.

To quote the Readme:

This module is intended to provide solutions to the Project Euler problems (http://projecteuler.net) using modern perl best practices and object oriented programming. For this reason I will be making heavy use of the Moose module(s) to wrap the solutions into objects.

I wish the author, Lespea (Adam Lesperance), the best of luck with this spanking new project.

I think thats enough Eulergizing from me for a while πŸ˜‰

/I3az/

Euler, Euler, Euler, Oi, Oi, Oi!

November 26, 2009
tags:

The Last of the Careless Men blog kindly referred to my Euler blog post from last week.

The blog post brought to my attention the Euler Benchmark Suite. To quote from the Readme:

The Euler Benchmark Suite aims at comparing language speeds for the Euler

So I was curious to see what this version of the Euler 4 in Perl5 looked like.

use strict; use warnings;
 
my $max = 0;
for my $a ( 100..999 ){
    for my $b ( $a..999 ){
        my $product = $a * $b;
 
        $max = $product if $product > $max
                       and $product eq reverse $product;
    }
}
 
print "$max\n";

At first glance this doesn’t look as “elegant” as the functional code I posted last week.

However remember the above code was optimised for speed! It comes it at 3.5 times faster than even this slightly more optimised version of last weeks functional code below, which now comes it at around 0.48s here:

say max 
    grep { $_ eq reverse $_ } 
    map {
        my $x = $_;
        map { $x * $_ } $x .. 1000;
    } 100..1000;

 

Another thing of interest from the blog post was the Perl6 example. Like with Ruby example its definitely easier to grok things going in a chain from left to right, ie. just like how we read english text.

autobox to the rescue!

use autobox::Core;

[1..1000]->map( sub{ my $x = $_; map { $x * $_ } $x..1000 } )->grep( sub{ $_ eq reverse $_ } )->max->say;

Not bad. And comes in at respectabe average of 1.25s. However having that extra map within the map method is not too elegant.

Luckily autobox is extensible! So lets add a Cartesian Product method to autobox:

use autobox::Core;

sub autobox::Core::ARRAY::product {
    my $a = shift;
    my @c = map { [ $_ ] } @$a;
    
    for my $b (@_) {
        @c = map { my $x = $_; map { [ $x, @$_ ] } @c } @$b;   
    }
    
    return \@c;
}

[1..1000]->product( [1..1000] )->map( sub{ $_->[0] * $_->[1] } )->grep( sub{ $_ eq reverse $_ } )->max->say;

Now thats really nice. Now if future versions of Perl can provide a mechanism to allow for blocks (ie. anonymous subs) to passed more seamlessly, say like

[1..1000]->product( [1..1000] )->map(){ $_->[0] * $_->[1] }->grep(){ $_ eq reverse $_ }->max->say;

# or even

[1..1000]->product( [1..1000] )->map{ $_->[0] * $_->[1] }->grep{ $_ eq reverse $_ }->max->say;

Then we’re really cooking!

/I3az/

This post is in memory of Colin. My Father-in-law and a fellow blogger who suddenly and unexpectedly passed away yesterday. RIP

Between thought and expression

November 21, 2009

Comparing computer languages can usually be interesting, sometimes informative, often amusing and in lots of cases just damn annoying!

Still this recent Hacker News post about Python vs Clojure did catch my eye.

Despite the fact the author of the blog post had pulled the Python code from answers to Project Euler the pythonista’s quite correctly cried foul because it wasn’t well written idiomatic python example and so was an unfair comparison.

There’s a lot of code out there posted on those intertubes over the years. However languages and practises evolve but unfortunately intertube posts can remain set in stone! Perl is often weighed down by its past history on the intertubes. One good way forward is just to produce more Modern Perl posts.

Anyway i digress, so moving on lets take a look at the Euler 4 – Finding Palindroms. This was the Clojure example that was put forward in the blog post:

(reduce max
    (filter #(let [s (str %)]
               (= (seq s) (reverse s)))
            (for [x (range 100 1000)
                  y (range 100 1000)]
              (* x y))))

Now in reply to this a much more idiomatic python example was provided:

print max(s for s in (x * y 
    for x in range(111, 1000) 
    for y in range(x, 1000))
    if list(str(s)) == list(reversed(str(s))))

This uses Python’s list comprehension. Definitely a very powerful construct. However i do find i get lost very quickly when trying to follow long nested comprehension’s 😦

In this same Python post there is also mention of a twitter post by Yukihiro Matz, the creator of Ruby. Matz provided the following Ruby example:

p [*100..1000].product([*100..1000]).map{|x,y| x*y}.select{|s|s=s.to_s; s==s.reverse}.max

Despite being formatted for twitter (ie. one line) i found it easy to follow through the logic.

Ruby & Python are not the only languages that can produce an elegant solution! So not to be out done here is a Perl example. In fact its the exact same code repeated three times but formatted differently:

use Modern::Perl;
use List::Util q(max);

# twitter one liner
say max grep { $_ eq reverse $_ } map { my $x = $_; map { $x * $_ } 100..1000 } 100..1000;


# again in lispy style format
say 
  max 
    grep { $_ eq reverse $_ } 
      map {
        my $x = $_;
        map { $x * $_ } 100..1000;
      } 100..1000;

# and finally in my preferred more perlish alignment
say max 
    grep { $_ eq reverse $_ } 
    map {
        my $x = $_;
        map { $x * $_ } 100..1000;
    } 100..1000;

The perl code speaks for itself.. its wonderfully clear and succinct. Also its fast, each version runs in under a second on my machine!

/I3az/

RefactorMyCode.com and Perl

November 15, 2009
tags:

Well if you hadn’t heard of Stackoverflow when i mentioned about it last month then chances are you’ve definitely not heard of RefactorMyCode either.

Its yet another interesting and engrossing site which I stumbled across in the past year, funnily enough after hearing about it from an answer to a Stackoverflow question.

The premise of the site is if you have some working code that you’re not totally happy with then offer it up for code review with the hope someone can help refactor it.

The Perl section could do with some more input and engagement. But don’t just stop there because seeing how snippets of code in other languages are refactored is also a good learning experience.

/I3az/

Best things in life come in threes

November 8, 2009

Following on from my last post it seems I have also been waiting for a kind of virtual conjunction between Perl 5.10.1, Parrot 1.0 & Padre being a year old.

Perl 5.10.1

Currently I run 5.8.8 in production on all servers that I manage. I do have Perl 5.10.0 running locally on my Mac but only for playing with.

So first step is to load Perl 5.10.1 on my Mac (Tiger) alongside my other Perl’s and then start testing & with the plan to roll it out to replace 5.8.8 in the not too distant future.

These are my steps to load 5.10.1 locally so that it doesn’t conflict with any other Perl I have here:

  • Download & unpack Perl source code in my normal user login
  • ./Configure -de -Dusethreads -Dprefix=~/local/Perl/perl-5.10.1/
  • gmake
  • gmake test
  • gmake install-all

I now have Perl 5.10.1 running out of my $HOME directory.

This all worked fine except the default location of .cpan directory was in $HOME (~/.cpan). This could clash with other locally installed Perl if nothing is done so I amended everything in cpan shell to use ~/local/Perl/perl-5.10.1/.cpan instead (I did this using “o conf”).

I then quickly blasted my new local Perl 5.10.1 with a few CPAN modules which included:

  • Moose
  • MooseX::Declare
  • autobox::Core
  • DateTime
  • XML::LibXML
  • Devel::REPL

All modules I selected installed without a single hitch. CPAN comes up trumps again!

Devel::REPL was of great interest to me because when I last tried to install this on 5.8.8 & 5.10.0 I did have some problems.

This time it installed & worked wonderfully. Only slight issue was there was no command line history? (ie. readline). This was easily resolved by loading Bundle::CPAN (which also gave cpan shell history as well!)

Padre

Normally I don’t compile Perl with threads. However I needed it for Padre, which is something I forgot about when I last tried installing Padre on my local 5.10.0 😦

I installed the following CPAN modules into my new Perl 5.10.1:

  • Alien::wxWidgets
  • Wx
  • Padre

All compiled & installed seamlessly. On starting Padre I got a nice pretty butterfly splash screen but then unfortunately it crashed 😦

As with most things in life if you not starting off with a clean slate then it may cause problems. I had some residue stuff from previous attempt that was part of the problem.

Two things were needed resolve this stumbling block:

  • Remove WxWidget which was installed via MacPorts (sudo port deactivate wxWidgets)
  • Make sure new Perl 5.10.1 was first Perl in $PATH env variable. Because even though I was running 5.10.1 CPAN shell the Wx module seemed fixated on picking up Alien::wxWidgets from the first Perl it could get its hands on πŸ˜›

After this reinstalling the Wx & Padre modules gave me a fully functional Padre.

Parrot 1.0 / Rakudo / Perl6

I was now using Padre 0.48 to edit & run my Perl 5.10.1 code. Want I wanted now was to add Perl6 into the mix.

For this I just followed the instructions from Rakudo site and installed it in my local user dir with no hitch at all.

Next in Perl 5.10.1 I installed the Padre::Plugin::Perl6 to make Padre Perl6 aware. My first bit of Perl6 code ran from Padre & command line perfectly (don’t forget to add your rakudo path to $PATH env):

use v6;

for 1..10 { .say }

class Dog {
    method bark { "woof" }
}

my Dog $rover .= new;
my $spot = Dog.new;

say $rover.bark;
say $spot.bark;

 

So where do I stand with Padre? Well I do love my Textmate so it is going to be hard to tug me away from it.

But I love the idea of an editor being hosted and extensible in Perl. So come my next round of free time I may find the tugging from Padre just to strong to resist πŸ˜‰

/I3az/