So I thought this might be a good opportunity to get more Modern Perl code across the eyes of the unbelievers

So to start the ball rolling I thought I’d post a link to the code used in the Microsoft Winter Scripting Games 2008, as mentioned by chromatic in his The Opposite of Modern post.

However typically Microsoft they’ve now broken the links. And even worse they seemed to have removed all content related to the Scripting Games from their websites

Tut tut. Luckily the content can be retrieved via WayBackMachine. Here is the article linked in chromatic’s post.

So while the first bird was to bring UseTheSource to everyones attention, the second bird was to make sure the lost code was resurrected from the dead by saving it here.

This was the challenge:

The first event requires the script to request a 7-digit phone number from the user and then select a corresponding phoneword from the “wordlist.txt” file. The letters in the phone number need to be mapped the same way they are represented on a North American phone dial

And below is the code:

use strict;
use warnings;

print "Enter 7 digit phone number: ";
chomp(my $number = <>);
die "Invalid number: '$number'\n" unless $number =~ /^\d{7}$/;

my @groups = qw(ABC DEF GHI JKL MNO PRS TUV WXY);
my($letters, $digits);
foreach my $digit (2..9) {
    my $group = $groups[$digit-2];
    $letters .= $group;
    $digits  .= $digit x length($group);
}

open(my $fh, "<", "C:/Scripts/wordlist.txt") or die;
while (<$fh>) {
    local $_ = $_;
    eval "tr/$letters\L$letters\E/$digits$digits/";
    last if /^$number$/o;
}
print uc if defined;

This is Jan Dubois wonderful idiomatic Perl riposte to (what I believe is) Microsoft’s original stab at a Perl solution:

%dictionary = ();

$dictionary{2} = "ABC";
$dictionary{3} = "DEF";
$dictionary{4} = "GHI";
$dictionary{5} = "JKL";
$dictionary{6} = "MNO";
$dictionary{7} = "PRS";
$dictionary{8} = "TUV";
$dictionary{9} = "WXY";

open (WordList, "C:\\Scripts\\WordList.txt");
@arrWordList = <WordList>;
close (WordList);

$strWordList = join(" ", @arrWordList);

print "Please enter the phone number: ";
$phonenumber = <>;

$low = 0;
$high = 3;

do
{
    $strCharacters = "";

    for ($i = 0; $i < 7; $i++)
        {
            $intValue = substr($phonenumber, $i, 1);
            $letters = $dictionary{$intValue};
            $b = int(rand($high) + $low);
            $substring = substr($letters, $b, 1);
            $strCharacters = $strCharacters . $substring
        }

if ($strWordList =~ m/$strCharacters/i)
    {
        print $strCharacters;
        $x = 1;
    }
}
until $x == 1

Proof that you can really write FORTRAN in any language

This article is now self referentially posted to UseTheSource.

BTW, If you post a link or code to UseTheSource by Monday, July 19 at 0800 BST then you are in with a chance of winning the “Beautiful Code” e-book.

Hopefully that will give you an incentive to waste a bit of time online this weekend

/I3az/

PS. Additionally to this there was another wonderful solution posted by Gav.

PPS. Gav also provided a more idiomatic solution to Game Event 3. The original Microsoft solution can be found here on the WayBackMachine (if you dare look!). I’ve also posted Gav’s solution to this on UseSourceCode.

Here is the direct YouTube link

Don’t worry its not Rails or even Ruby loaded. The keynote goes through an interesting history of programming languages and on route Robert mentions Fortran, Lisp, Algol, BASIC, Simula, BCPL, B, C, Scheme, Smalltalk, C++, Perl, Java, Ruby, Erlang, C#, F#, Haskell and Clojure.

Hopefully I didn’t miss one? Strangely can’t recall Python being mentioned!?

/I3az/

In all bar one of my autobox examples I used $_[0] to pass the iterator object. For eg:

['a'..'z']->iterate( sub{
    print $_[0]->currentIndex, ' => ', $_[0]->current;
});

But in the last code example I went for $_[0] having the value and $_[1] the iterator object:

['a'..'z']->iterate( sub{
    print $_[1]->currentIndex, ' => ', $_[0];
});

And to help avoid getting cross-eyed with $_[] then this is nicer on the eye if a tad longer:

['a'..'z']->iterate( sub{
	my ($v, $iter) = @_;
    print $iter->currentIndex, ' => ', $v;
});

But hold on, is there a preference to which way round these should be assigned to @_? Would it be better other way round because value can be got at from the iterator object anyway? (one shift and away!)

So perhaps using $_ is best?

['a'..'z']->iterate( sub{
    print $_->currentIndex, ' => ', $_->current;
});

I like this a lot. But it would be amiss not to take advantage of using $_ for the value and $_[0] for iterator so that we can write code like this:

['a'..'z']->iterate( sub{
	print $_[0]->getNext if m/[aeiou]/;
});

However note the print $_[0]->getNext and not just plain print

I don’t think there is a canonical answer to this but my preference is to use $_ has the iterator object… but with probably value & the iterator (again!) passed through @_ (ie. the kitchen sink approach!).

sub autobox::Core::ARRAY::iterate {
    my ($array, $code) = @_;
    my $iter = Array::Iterator->new( $array );

    while ($iter->hasNext) {
        local $_ = $iter;
        $code->( $iter->getNext, $iter );
    }

    return wantarray ? @$array : $array;
}

Note the return wantarray ? @$array : $array; addition. This keeps the autobox chaining going and is good adherence to autobox API (though in this iterator context it probably isn’t of much benefit).

/I3az/

PS. Let me just add “Perl” here because despite lots of perl code snippets I haven’t mentioned Perl, CPAN or Ironman at all and I’m still wary whether ironman will pick up the perl tag.

• each
• foreach
• for

each iterates over a hash and works exactly the same as the perl function each (because internally it uses each so same caveats apply that I mentioned in my last post).

%hash->each( sub{
	my ($k, $v) = @_;
	say "$k = $v";
});

The other two methods work on arrays:

my @array = ('a'..'z');

@array->foreach(sub { say $_[0] });

@array->for( sub{
	my ($index, $value) = @_;
	say "$index : $value";
});

foreach just provides the current element. Whereas for works in similar way to how the each function on an array. However it also provides the array ref which allows us to repeat my “vowel” snippet from last post in autobox like so:

use 5.012;
use warnings;
use autobox::Core;

my @tokens = 'a' .. 'z';

@tokens->for( sub{
    my ($i, $v, $array) = @_;
    if ($v =~ m/[aeiou]/) {
        print $array->[ $i + 1 ];    # peeks ahead into @tokens
    }
});

# => bfjpv

OK thats not quite the same because my function each snippet in last post was more optimal because it moved to next iteration in the array so saving a pass in the loop. Stayed tuned because i’ll come back to this later.

So what about my last caveat from previous post? Well foreach & for do not use the each function so its not a problem!

@tokens->for( sub{
    my ($i, $v, $array) = @_;
    print $v;
    last  if $i == 12;
});

# => abcdefghijklm

However (potential caveat warning!) you will get a Exiting subroutine via last at… warning when using above

This can be fixed:

@tokens->for( sub{
    my ($i, $v, $array) = @_;
    print $v;
    if ($i == 12) {
        no warnings 'exiting';
        last;
    }
});

But I get the feeling I’ve brushed something under the carpet here!

So perhaps time to add a method to autobox::Core then:

sub autobox::Core::ARRAY::whileTrue {
    my ($array, $code) = @_; 

    for (my $i = 0; $i <= $#$array; $i++) {
        my $return = $code->( $i, $array->[$i], $array );
        last unless $return;
    }
}

# now go thru @tokens unless the block returns false value

@tokens->whileTrue( sub{
    my ($i, $v, $array) = @_;
    print $v;
    return 0 if $i == 12;
    1;   # <= always remember this!
});

Hmmm… OK it works but is a bit hacky! (even wacky!!).

But something is needed because otherwise it will just iterate through whole array. So a much better way is to integrate something like the Array::Iterator CPAN module that I mentioned in the comments of my last post:

sub autobox::Core::ARRAY::iterate {
    my ($array, $code) = @_;
    my $iter = Array::Iterator->new( $array );

    while ($iter->hasNext) {
        $iter->getNext;
        $code->( $iter );
    }
}

Now lets first jump back a bit and see how this works with my original snippets:

@tokens->iterate( sub{
    # index => value
    print $_[0]->currentIndex, ' => ', $_[0]->current;
});

@tokens->iterate( sub{
    # print next token after a vowel
    print $_[0]->getNext  if $_[0]->current =~ m/[aeiou]/;
});

Wonderbar! And because we are using a full blown iterator it now pulls the next element off the array (see getNext method) just like function each but without any of the side effects!

So for last, its just a matter of subclassing of Array::Iterator with a last method:

use 5.012;
use warnings;
use autobox::Core;

{
    package Array::Iterator::Last;
    use parent 'Array::Iterator';

    sub last {
        my ($self) = @_;
        $self->_current_index = $self->getLength;
    }
}

sub autobox::Core::ARRAY::iterate {
    my ($array, $code) = @_;
    my $iter = Array::Iterator::Last->new( $array );

    while ($iter->hasNext) {
        $code->($iter->getNext, $iter);
    }
}

['a'..'z']->iterate( sub{
    my ($val, $iter) = @_;
    print $val;
    $iter->last  if $iter->currentIndex == 12;
});

And bob’s your uncle

NB. Now the keen eyed among you may have noticed that this time I passed both the element and the iterator object to the callback. Even with just methods, API choices are never easy! More on this in my next post.

/I3az/

use 5.012;
use warnings;

my @array = 'a' .. 'h';

while (my ($i, $val) = each @array) {
    say "$i => $val";
}

each on an array returns two values… the index and the value of the current iteration. Thus we get this output from above code:

  0 => a
  1 => b
  2 => c
  3 => d
  4 => e
  5 => f
  6 => g
  7 => h

Anyway to save me thinking up a blog post please excuse me while I just regurgitate my Stackoverflow answer I gave earlier today about using each with an array:

==start==
Starting with Perl 5.12, each is now more flexible by also working on arrays:

use 5.012;
use warnings;

my @tokens = 'a' .. 'z';

while (my ($i, $val) = each @tokens) {
    if ($val =~ m/[aeiou]/) {
        ($i, $val) = each @tokens;   # get next token after a vowel
        print $val;
    }
}

# => bfjpv

One caveat with each, remember the iterator is global and is not reset if you break out of a loop.

For eg:

while (my ($i, $val) = each @tokens) {
    print $val;
    last if $i == 12;
}

# => abcdefghijklm

my ($i, $val) = each @tokens;
say "Now at => $val ($i)";         # Now at => n (13)

So use keys or values to manually reset the iterator:

keys @tokens;                      # resets iterator
($i, $val) = each @tokens;
say "Now at => $val ($i)";         # Now at => a (0)

==end==

I’ve just come back from a nice weeks break… so I’m still a lazy git in holiday mode here

/I3az/

There is no mention of Perl in the article (a first for me for probably over a year!). But it is tagged with “perl” and “ironman”. Is there an issue with WordPress tags? Is ironman only seeing WordPress categories (which were “blogging” and “programming” for this post).

Thought I better check what my WordPress RSS feed is spewing out using XML::Feed:

use 5.012;
use warnings;
use XML::Feed;

my $feed = XML::Feed->parse(URI->new('http://transfixedbutnotdead.com/feed'))
    or die XML::Feed->errstr;

for my $entry ($feed->entries) {
    say $entry->title;
    for my $category ($entry->category) {
        say "\t", $category;
    }
}

What came back was this:

	What I Would Like To See
		Blogging
		Programming
		perl
		ironman
	Perl block with lexically-scoped method delegation
		Programming
		perl
		Devel::Declare
		dsl
	PDL advert get its 15 minutes of fame!
		Programming
		PDL
		perl
		stackoverflow
	Perlcast website is back
		Blogging
		Programming
		perl
		perlcast
	Podcasts & Perl
		Programming
		perl
		podcast
	Famous Perl programmers
		Programming
		perl
		python
		django
	Caralyst 5.8: The Perl MVC Framework
		Programming
		catalyst
		perl
	Perl ads on Stackoverflow
		Programming
		perl
		stackoverflow
	Two questions… similar answers… same module
		Programming
		moose
		perl
	The unlikely intersection of Boy George and Damian Conway
		Programming
		london.pm
		perl

Both the WordPress tags & categories were coming through has RSS categories. I believe this is correct so why hasn’t Ironman picked up the “What I Would Like To See” post?

So is having Perl, CPAN or ironman in the content mandatory?

/I3az/

No web framework is perfect so I think it maybe insightful to highlight the best & worst features of all these frameworks and see how they stack up against each other.

And to provide complete impartiality for the talk then I think the hair colour should be a mixture of green for django, red for rails and eh, not sure what colour for catalyst?… so lets stick to mst’s natural hair colour for that

/I3az/

PS. BTW… if you think my multi-colour choice was a bit OTT, then its fortunate I didn’t go with my original thought of suggesting using the colours of my favourite Rugby & Footie teams! That would have been eye catching mix of black & gold for London Wasps and the blue & white Superhoops

This is something I always wanted in Perl and immediately marked a note in my list of blog/CPAN ideas with “Devel::Declare and with statement” (with side note that “using” might be more appropriate so not to clash with Moose roles sugar).

Unsurprisingly this just languished in my ever increasing list

However last month I had a few hours spare one weekend so pulled out my laptop and rummaged through my list and decided to see how difficult it would be to implement “with”.

Unfortunately I kept hitting brick walls with local scoping. I came to conclusion that I may have to use eval or even go down a different track using an AUTOLOAD solution.

I left that weekend experiment with at least a very basic AUTOLOAD proof of concept:

use 5.012;
use warnings;

{
    package FileStuff;
    use Moose;

    has name => ( is => 'rw', isa => 'Str' );

    sub save { say "save ",   $_[0]->name }

    sub del  { say "delete ", $_[0]->name }

    sub mv {
        my ($self, $to) = @_;
        say "rename ", $self->name, " to $to";
        $self->name( $to );
    }

    sub say { say "Method say: ", @_ }
}

my $f = FileStuff->new( name => 'foobar' );

# using $f {}
{
    local *AUTOLOAD = sub {
        our $AUTOLOAD;
        my $name = (split '::', $AUTOLOAD)[-1];
        die "method $name NOT FOUND!" unless $f->can( $name );
        $f->$name( @_ );
    };

    # my "DSL" stuff!
    save();               # $f->save();
    mv( "barbaz" );       # $f->mv( "barbaz" );
    del();                # parenthesis are always required
    say( "builtin say" ); # builtin wins over $f->say
}

I wasn’t sure if this would ever evolve into a robust solution. However I found it reassuring to note that other people had similar problems trying to use local scoping in similar way when I came across this Perlmonks post A useful use of goto a few days later. So this gave the AUTOLOAD approach some merit.

Well chances are this blog post or any additional development may never made it any further. What changed that was an email from chocolateboy this morning pointing me at his new Scope::With CPAN module.

Blimey… Father Christmas had delivered my xmas pressie early and without even seeing my xmas list

chocolateboy’s first example of Scope::With even shows how it works with my Builder module:

use Builder;
use Scope::With;

my $builder = Builder->new();
my $xml = $builder->block('Builder::XML');

with ($xml) {
    body(
        div(
            span({ id => 1 }, 'one'),
            span({ id => 2 }, 'two'),
        )
    );
}

say $builder->render();

Which is exactly why I wanted a “with” statement in Perl and it looked like chocolateboy also felt the same!

The documentation even gave an “using” example:

use Scope::With qw(using);

using ($xml) {
    div(
        span( ... ),
        span( ... ),
    );
}

Getting worried now someone was reading my mind

This is truly awesome stuff. chocolateboy has the habit of producing game changing CPAN modules. For eg. autobox and Method::Lexical. To me Scope::With is potentially another one that falls into this lofty category.

I’m deeply honoured to find my Builder module being referenced and also glad to see that a “with” statement using Devel::Declare and AUTOLOAD isn’t such a delusional idea

So many thanks to chocolateboy for writing Scope::With. Keep up the good work.

/I3az/

PS. chocolateboy’s Scope::With docs also references a prior art module with by Vincent Pit. This module achieves similar things but in different way/implementation.

PPS. CPAN is so big and wonderful that its easy to miss or even forget whats on there!

Well the logo achieved its 15 minutes of glory when it was fortuitously screen captured for the following ReadWriteWeb article about Stackoverflow raising venture capital:

• http://www.readwriteweb.com/archives/stackoverflow_business_funding.php

Well done to all those of you voted this up to make this happen

NB. This is the Hacker News post which pointed me to the ReadWriteWeb article.

/I3az/

Bad news, The Perl Report which I list on my blog links as now disappeared

Fingers crossed The Perl Report is only a temporary issue. And touch wood Perlcast can return to more regular podcasts (perhaps its something that TPF can look into has part of their promoting Perl?)

/I3az/

PS. Some blog house keeping:

• Removed use Perl; from my link list. Not much going on their front page these days and it doesn’t look very appealing if you go there with no login/profile.
• Added YAPC TV to my link list.
• And also Presenting Perl
• And yes there are no ironman badges at moment (since ironman site upgrade)