Perl Advent Calendar 2012http://perladvent.org/2012/2024-03-13T21:03:03ZRicardo SignesXML::Atom::SimpleFeedSo long until next year!http://perladvent.org/2012/2012-12-25.html<div class='pod'><p>The Advent calendar has ended. It ended yesterday, so behind this door you're not finding a rich, chocolately article about Perl, but instead a bland note from the editor. Sorry!</p>
<p>As always, the Perl Advent Calendar was a group effort, and I'd like to thank everyone who contributed this year: Arthur Axel "fREW" Schmidt, Breno G. de Oliveira, Chris Prather, Dave Mitchell, David Golden, Jeffrey Ryan Thalhammer, Jesse Luehrs, Jonathan Swartz, Karen Etheridge, Mark Fowler, Philippe Bruhat (BooK), Rafaël Garcia-Suarez, Sawyer X, Shawn M Moore, Toby Inkster, and Yanick Champoux.</p>
<p>If you'd like to contribute an article for next year, you've got just about 365 days to do it! This year — for the first time in years, if not ever — we had more submissions than we could publish, so we might already have fewer than 24 slots open for 2013. Wow!</p>
<p>If you want to help with the site or other things in the meantime, you can <s><a href="http://mail.pm.org/mailman/listinfo/perladvent">join our mailing list</a></a></s> <a href="https://github.com/perladvent/Perl-Advent/">check the perladvent/Perl-Advent GitHub repo</a> where we'll be talking about work that needs to get done on things like the FAQ, the site generator, and all that sort of thing. You can find the <a href="https://github.com/perladvent/Perl-Advent">site's contents on GitHub</a>, which <i>should</i> contain the 2012 articles by the time you see this. It's not exactly how it should be, but it's there.</p>
<p>More importantly, you can find <a href="https://github.com/perladvent/Perl-Advent/issues">our wish list for fixes and features</a>. Help with these and you will earn fame forever (at least in the git logs)!</p>
<p>So until I'm back at Christmas 2013 – if I don't come to my senses and quit this job – have a merry Christmas and an excellent new year!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://github.com/perladvent/Perl-Advent/">the perladvent/Perl-Advent GitHub repo</a></p>
</li>
<li><p><a href="http://www.perladvent.org/FAQ.html">the someday-to-be-rewritten FAQ</a></p>
</li>
<li><p><a href="http://mail.pm.org/mailman/listinfo/perladvent">the mailing list</a> (historical archive)</p>
</li>
</ul>
</div>2012-12-25T00:00:00ZRicardo SignesHave REST-ful Holidayshttp://perladvent.org/2012/2012-12-24.html<div class='pod'><h2 id="Have-REST-ful-Holidays">Have REST-ful Holidays</h2>
<p>Your boss comes to you the day after Thanksgiving vacation (or if you're in Scotland, the day after St. Andrew's Bank Holiday; if you're not in Scotland or the US, adjust accordingly):</p>
<pre><code> Boss: We need a Web API for the Flibber data. I want it to be REST-ful.
You: REST-ful API? Where did you hear about REST?
Boss: I've started reading /r/programming. Everyone is making REST APIs
now. We need one.
You: *sigh* I'll get right on that.</code></pre>
<p>So you need to build a REST-ful Web API in time for the Holidays. You may not even know what REST is, beyond some buzzword your boss picked up in an internet back-alley.</p>
<h2 id="How-to-Explain-REST-to-Anyone-even-Ryan-Tomaykos-wife">How to Explain REST to Anyone … even Ryan Tomayko's wife.</h2>
<p>On Ryan Tomayko blog he has <a href="http://tomayko.com/writings/rest-to-my-wife">a dialog with his wife</a> where he explains REST and why it's important. We really don't have time to go into all of the details so you should read it, but I'll try to cover the most important bits.</p>
<pre><code> Ryan: [...] The web is built on an architectural style called REST. REST
provides a definition of a resource, which is what those things point
to.
Wife: A web page is a resource?
Ryan: Kind of. A web page is a representation of a resource. Resources are
just concepts. URLs--those things that you type into the browser...
Wife: I know what a URL is..
Ryan: Oh, right. Those tell the browser that there's a concept somewhere. A
browser can then go ask for a specific representation of the concept.
Specifically, the browser asks for the web page representation of the
concept.</code></pre>
<p>Basically the way the world wide web works is that clients request Representations of Resources identified by URLs (or URIs if you're pedantic). Clients and Servers use HTTP to give and return these requests. Most requests are by Browsers and they just want an HTML representation, but more and more clients are requesting non-HTML representations too. Thankfully the Web was designed to handle this, if we just write things in the right style.</p>
<p>REST is the style of writing applications so that they take full advantage of HTTP and the design of the Web. Now you know what REST is. Knowing is half the battle.</p>
<h2 id="HTTP-is-Hard">HTTP is Hard</h2>
<center>
<a href="https://raw.github.com/wiki/basho/webmachine/images/http-headers-status-v3.png">
<img src="https://raw.github.com/wiki/basho/webmachine/images/http-headers-status-v3.png" width=600 />
</a>
</center>
<p>This is a diagram of the state machine based on the HTTP protocol. It has 57 states asking 50 different questions about how to process any given HTTP request and generate the right response. That's a lot to keep in your head.</p>
<p>Luckly there are frameworks on CPAN to help out with these. A good one for demonstrating these is <a href="https://metacpan.org/release/Web-Machine">Web::Machine</a> by Stevan Little. It is based on the Erlang Webmachine project by Basho (makers of Riak!) that generated the state machine diagram.</p>
<p><code>Web::Machine</code> is broken into two parts. A Finite State machine that implements the diagram, and a Resource base class that provides sensible defaults that you can override in your own class. Let's just dive in.</p>
<p>A note, while <code>Web::Machine</code> itself works on Perl 5.10.1 or higher, all examples will explicitly be using 5.16.2. Remember if you change the version line to enable strict.</p>
<h2 id="Its-a-Time-Machine">It's a Time Machine!</h2>
<p>So let's start with a basic web service. My Car doesn't have a clock in it, so to be properly Web 2.0 compliant, I'll write a JSON service that I can later target with an iOS client that will run from my phone. That won't be overkill at all.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="version">5.16.2</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Web::Machine</span><span class="structure">;</span><br /><br /><span class="structure">{</span><br /> <span class="keyword">package</span> <span class="word">WasteOfTime::Resource</span><span class="structure">;</span><br /> <span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /> <span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><br /> <span class="keyword">use</span> <span class="pragma">parent</span> <span class="single">'Web::Machine::Resource'</span><span class="structure">;</span><br /><br /> <span class="keyword">use</span> <span class="word">JSON::XS</span> <span class="words">qw(encode_json)</span><span class="structure">;</span><br /><br /> <span class="keyword">sub</span> <span class="word">content_types_provided</span> <span class="structure">{</span> <span class="structure">[{</span> <span class="single">'application/json'</span> <span class="operator">=></span> <span class="single">'to_json'</span> <span class="structure">}]</span> <span class="structure">}</span><br /><br /> <span class="keyword">sub</span> <span class="word">to_json</span> <span class="structure">{</span> <span class="word">encode_json</span><span class="structure">({</span> <span class="word">time</span> <span class="operator">=></span> <span class="word">scalar</span> <span class="word">localtime</span> <span class="structure">})</span> <span class="structure">}</span><br /><span class="structure">}</span><br /><br /><span class="word">Web::Machine</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">resource</span> <span class="operator">=></span> <span class="single">'WasteOfTime::Resource'</span> <span class="structure">)</span><span class="operator">-></span><span class="word">to_app</span><span class="structure">;</span></code></pre>
<p><code>Web::Machine</code> is a toolkit for building Resources. So after the standard boiler plate we start out by defining a resource class. Although <code>Web::Machine</code> was written by the same guy who brough you <code>Moose</code> it actually tries to be minimal about it's dependencies and doesn't sneak <code>Moose</code> in under the covers.</p>
<p>So we create a class <code>WasteOfTime::Resource</code> that will be our Resource class, and we have it inherit from <code>Web::Machine::Resource</code> so that <code>Web::Machine</code> will know it's a Resource and so that the proper defaults are set. We could be done here, and our application would do nothing but throw a 406 NOT ACCEPTABLE. But that's less than useful.</p>
<p>We know we want to provide a JSON API so we override the parent <code>content_types_provided</code> and say we will provide a representation of 'application/json' and that we should use the <code>to_json</code> method to get it.</p>
<p>Then we define the to_json representation. This resource doesn't have any state so we can just build the JSON inline. We use the scalar value of <code>localtime</code> because we want the nice string format not a list of numbers.</p>
<p>Finally once our resource class is built, we create a <code>Web::Machine</code> instance, tell it which resource class to use and then have it provide us a Plack application. If we save all of this in a file (I chose <code>time.psgi</code>) we can run it.</p>
<pre><code> $ plackup time.psgi
HTTP::Server::PSGI: Accepting connections at http://0:5000/</code></pre>
<p>Which we can now access using a web client.</p>
<pre><code> $ curl -v http://0:5000
* About to connect() to 0 port 5000 (#0)
* Trying 127.0.0.1... connected
* Connected to 0 (127.0.0.1) port 5000 (#0)
> GET / HTTP/1.1
> User-Agent: curl/7.21.4 (universal-apple-darwin11.0) libcurl/7.21.4 OpenSSL/0.9.8r zlib/1.2.5
> Host: 0:5000
> Accept: */*
>
* HTTP 1.0, assume close after body
< HTTP/1.0 200 OK
< Date: Sun, 09 Dec 2012 02:04:02 GMT
< Server: HTTP::Server::PSGI
< Content-Length: 35
< Content-Type: application/json
<
* Closing connection #0
{"time":"Sat Dec 8 21:04:02 2012"}</code></pre>
<p>And you can see our Representation there at the end. If we try a request that isn't allowed, say for an HTML representation, we will get the appropriate error too.</p>
<pre><code> $ curl -v http://0:5000 -H'Accept: text/html'
* About to connect() to 0 port 5000 (#0)
* Trying 127.0.0.1... connected
* Connected to 0 (127.0.0.1) port 5000 (#0)
> GET / HTTP/1.1
> User-Agent: curl/7.21.4 (universal-apple-darwin11.0) libcurl/7.21.4 OpenSSL/0.9.8r zlib/1.2.5
> Host: 0:5000
> Accept: text/html
>
* HTTP 1.0, assume close after body
< HTTP/1.0 406 Not Acceptable
< Date: Sun, 09 Dec 2012 02:07:47 GMT
< Server: HTTP::Server::PSGI
< Content-Length: 14
<
* Closing connection #0
Not Acceptable</code></pre>
<p>We get that 406 not acceptable again.</p>
<h2 id="Many-Ways-to-Say-the-Same-Thing">Many Ways to Say the Same Thing</h2>
<p>So far we're not doing bad for 20 lines of code, but what if we want that HTML representation too? Actually it's pretty simple. First we add a new content type.</p>
<pre><code> sub content_types_provided { [
{ 'application/json' => 'to_json' },
{ 'text/html' => 'to_html' },
] }</code></pre>
<p>We say that 'text/html' will be handled by <code>to_html</code>. Now we just define a <code>to_html</code> method to return our HTML representation.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">to_html</span> <span class="structure">{</span><br /> <span class="word">join</span> <span class="double">""</span> <span class="operator">=></span><br /> <span class="single">'<html>'</span><span class="operator">,</span><br /> <span class="single">'<head>'</span><span class="operator">,</span><br /> <span class="single">'<title>The Time Now Is:</title>'</span><span class="operator">,</span><br /> <span class="single">'</head>'</span><span class="operator">,</span><br /> <span class="single">'<body>'</span><span class="operator">,</span><br /> <span class="single">'<h1>'</span><span class="operator">.</span><span class="word">localtime</span><span class="operator">.</span><span class="single">'</h1>'</span><span class="operator">,</span><br /> <span class="single">'</body>'</span><span class="operator">,</span><br /> <span class="single">'</html>'</span><br /><span class="structure">}</span></code></pre>
<p>Notice that <code>Web::Machine</code> doesn't have any opinion on how you generate HTML. You're free to use whatever template system you want. You're also free to write all of the glue code for that. <code>Web::Machine</code> is pretty bare bones about that, this is why it's called a toolkit and not a framework.</p>
<p>So if we add this code and we issue that last request we can see the change.</p>
<pre><code> $ curl -v http://0:5000 -H'Accept: text/html'
* About to connect() to 0 port 5000 (#0)
* Trying 0.0.0.0... connected
* Connected to 0 (0.0.0.0) port 5000 (#0)
> GET / HTTP/1.1
> User-Agent: curl/7.21.4 (universal-apple-darwin11.0) libcurl/7.21.4 OpenSSL/0.9.8r zlib/1.2.5
> Host: 0:5000
> Accept: text/html
>
* HTTP 1.0, assume close after body
< HTTP/1.0 200 OK
< Date: Sun, 09 Dec 2012 02:26:39 GMT
< Server: HTTP::Server::PSGI
< Vary: Accept
< Content-Length: 103
< Content-Type: text/html
<
* Closing connection #0
<html><head><title>The Time Now Is:</title></head><body><h1>Sat Dec 8 21:26:39 2012</h1></body></html></code></pre>
<h2 id="The-Times-They-Are-A-Changing">The Times They Are A Changing</h2>
<p>So we're returning multiple representations, and that's great but what if we want to alter the resource? Let's let ourselves change the timezone. We'll need to <code>use POSX qw(tzset)</code> and add some methods.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">POSIX</span> <span class="words">qw(tzset)</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">allowed_methods</span> <span class="structure">{</span> <span class="structure">[</span><span class="words">qw[ GET POST ]</span><span class="structure">]</span> <span class="structure">}</span><br /><br /><span class="keyword">sub</span> <span class="word">process_post</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$input</span> <span class="operator">=</span> <span class="word">eval</span> <span class="structure">{</span> <span class="word">JSON::XS</span><span class="operator">-></span><span class="word">new</span><span class="operator">-></span><span class="word">decode</span><span class="structure">(</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">request</span><span class="operator">-></span><span class="word">content</span> <span class="structure">);</span> <span class="structure">};</span><br /> <span class="symbol">$ENV</span><span class="structure">{</span><span class="word">TZ</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$input</span><span class="operator">-></span><span class="structure">{</span><span class="word">timezone</span><span class="structure">};</span><br /> <span class="word">tzset</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="number">1</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>Changing the <code>allowed_methods</code> lets <code>Web::Machine</code> know we are expecting POST requests as well as GET requests to this resource. Then when we process the post we simply set the appropriate value.</p>
<pre><code> $ curl -v -X POST http://0:5000 -H 'Content-Type: application/json' -d '{"timezone":"America/Los_Angeles"}'
* About to connect() to 0 port 5000 (#0)
* Trying 127.0.0.1... connected
* Connected to 0 (127.0.0.1) port 5000 (#0)
> POST / HTTP/1.1
> User-Agent: curl/7.21.4 (universal-apple-darwin11.0) libcurl/7.21.4 OpenSSL/0.9.8r zlib/1.2.5
> Host: 0:5000
> Accept: */*
> Content-Type: application/json
> Content-Length: 34
>
* HTTP 1.0, assume close after body
< HTTP/1.0 204 No Content
< Date: Sun, 09 Dec 2012 02:49:22 GMT
< Server: HTTP::Server::PSGI
< Vary: Accept
< Content-Type: application/json
<
* Closing connection #0</code></pre>
<p>If we check now, we'll see that the time has changed.</p>
<pre><code> $ curl -v http://0:5000
* About to connect() to 0 port 5000 (#0)
* Trying 127.0.0.1... connected
* Connected to 0 (127.0.0.1) port 5000 (#0)
> GET / HTTP/1.1
> User-Agent: curl/7.21.4 (universal-apple-darwin11.0) libcurl/7.21.4 OpenSSL/0.9.8r zlib/1.2.5
> Host: 0:5000
> Accept: */*
>
* HTTP 1.0, assume close after body
< HTTP/1.0 200 OK
< Date: Sun, 09 Dec 2012 02:46:56 GMT
< Server: HTTP::Server::PSGI
< Vary: Accept
< Content-Length: 35
< Content-Type: application/json
<
* Closing connection #0
{"time":"Sun Dec 9 02:46:56 2012"}</code></pre>
<p>Since the previous times were <code>America/New_York</code> the new times are the correct 3 hours behind.</p>
<h2 id="Somethign-Witty-HERE">[Somethign Witty HERE]</h2>
<p>In addition to supporting the standard HTTP methods, <code>Web::Machine</code> helps with much of the rest of the HTTP standard including things like Cache Control headers. To enable most basic cache controls simply provide a couple methods to generate ETag and last modified headers.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Digest::SHA</span> <span class="words">qw(sha1_hex)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Web::Machine::Util</span> <span class="words">qw(create_date)</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">generate_etag</span> <span class="structure">{</span> <span class="word">sha1_hex</span><span class="structure">(</span><span class="word">scalar</span> <span class="word">localtime</span><span class="structure">)</span> <span class="structure">}</span><br /><br /><span class="keyword">sub</span> <span class="word">last_modified</span> <span class="structure">{</span> <span class="word">create_date</span><span class="structure">(</span><span class="word">scalar</span> <span class="word">localtime</span><span class="structure">)</span> <span class="structure">}</span></code></pre>
<p>We import two new modules here. <code>Digest::SHA</code> helps us just make a unique identifier for our resource. <code>Web::Machine::Util</code> helps us create the appropriate date object that <code>Web::Machine</code> is expecting.</p>
<p>If we run our client against this now we'll see the new cache control headers.</p>
<pre><code> $ curl -v http://0:5000
* About to connect() to 0 port 5000 (#0)
* Trying 0.0.0.0... connected
* Connected to 0 (0.0.0.0) port 5000 (#0)
> GET / HTTP/1.1
> User-Agent: curl/7.21.4 (universal-apple-darwin11.0) libcurl/7.21.4 OpenSSL/0.9.8r zlib/1.2.5
> Host: 0:5000
> Accept: */*
>
* HTTP 1.0, assume close after body
< HTTP/1.0 200 OK
< Date: Sun, 09 Dec 2012 14:50:21 GMT
< Server: HTTP::Server::PSGI
< ETag: "fa4c7582066e3b42fffd346cfba9714ea66cd645"
< Vary: Accept
< Content-Length: 35
< Content-Type: application/json
< Last-Modified: Sun, 09 Dec 2012 14:50:21 GMT
<
* Closing connection #0
{"time":"Sun Dec 9 09:50:21 2012"}</code></pre>
<p>And if we make a request for a resource that should be cached, we get the right response code.</p>
<pre><code> $ curl -v http://0:5000 -H'If-Modified-Since: Sun, 09, Dec 2012 14:55:21 GMT'
* About to connect() to 0 port 5000 (#0)
* Trying 0.0.0.0... connected
* Connected to 0 (0.0.0.0) port 5000 (#0)
> GET / HTTP/1.1
> User-Agent: curl/7.21.4 (universal-apple-darwin11.0) libcurl/7.21.4 OpenSSL/0.9.8r zlib/1.2.5
> Host: 0:5000
> Accept: */*
> If-Modified-Since: Sun, 09, Dec 2012 14:55:21 GMT
>
* HTTP 1.0, assume close after body
< HTTP/1.0 304 Not Modified
< Date: Sun, 09 Dec 2012 14:55:11 GMT
< Server: HTTP::Server::PSGI
< ETag: "f6da728260ea1563bd14ce999f0246a4817f6fee"
< Vary: Accept
< Last-Modified: Sun, 09 Dec 2012 14:55:11 GMT
<
* Closing connection #0</code></pre>
<p>In addition to cache controls, <code>Web::Machine</code> provides methods for authentication, request validation, URI validation, charset and encoding variation, and most of the rest of the HTTP spec.</p>
<h2 id="The-Downsides">The Downsides</h2>
<p><code>Web::Machine</code> is pretty bare bones. It leaves a lot of opinions beyond HTTP up to the author. This is considered a bonus because these opinions are very much influenced heavily by the environment your application will be deployed in. If you want a framework that provides more pre-built wheels you may want to look at <a href="http://github.com/Tamarou/magpie">Magpie</a> which is a framework based upon the same principles as <code>Web::Machine</code> but takes a very different approach for it's implementation.</p>
<p>One of the principles of REST is that hypertext is the engine of application state. Because <code>Web::Machine</code> has no opinions on templating, or really representation generation at all, it has no tools for building Hypermedia Documents. I highly recomend looking at the <a href="https://metacpan.org/module/stateless.co#hal_specification.html">Hypermedia Application Language</a> (HAL) specification for structuring hypermedia documents. It describes serializations in both JSON and XML depending on how old school you want to go.</p>
<p>Currently <code>Web::Machine</code> also doesn't handle an asynchronous environment. To be honest HTTP really doesn't have an asynchronous mode. The closest HTTP has is multi-part responses which are uni-directional streams. An example of this is the Twitter streaming API. There has been talk about adding support for this to <code>Web::Machine</code> but if you're looking for this, or something like Websockets right now, <code>Web::Machine</code> isn't the right choice.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/release/Web-Machine">Web::Machine</a></p>
</li>
<li><p><a href="https://metacpan.org/module/stateless.co#hal_specification.html">Hypermedia Application Language</a></p>
</li>
</ul>
</div>2012-12-24T00:00:00ZChris PratherGive and Receive the Right Number of Giftshttp://perladvent.org/2012/2012-12-23.html<div class='pod'><h3 id="Making-a-List">Making a List</h3>
<p>Santa is already hard at work preparing for this year's Christmas. Little boys and girls across the world are sending him their Christmas lists, which look like this:</p>
<pre><code> Shawn.txt:
3 wooden toys
1 dog clock
1 hobby horse
2 glider planes</code></pre>
<p>Santa naturally uses Perl to parse this list, as he has been these last 25 Christmases. Santa's Perl script produces the work orders that his elves use to make all those toys.</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/env perl<br /></span><span class="keyword">use</span> <span class="version">5.16.0</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">autodie</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$kid_name</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$toy_count</span> <span class="operator">=</span> <span class="number">0</span><span class="structure">;</span><br /><br /><span class="word">open</span> <span class="word">my</span> <span class="symbol">$handle</span><span class="operator">,</span> <span class="single">'<'</span><span class="operator">,</span> <span class="double">"$kid_name.txt"</span><span class="structure">;</span><br /><span class="keyword">while</span> <span class="structure">(</span><span class="readline"><$handle></span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$quantity</span><span class="operator">,</span> <span class="symbol">$gift</span><span class="structure">)</span> <span class="operator">=</span> <span class="match">/^(\d+) (.+)/</span><span class="structure">;</span><br /> <span class="word">say</span> <span class="double">"$kid_name would like $gift ($quantity)."</span><span class="structure">;</span><br /> <span class="symbol">$toy_count</span> <span class="operator">+=</span> <span class="symbol">$quantity</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="word">say</span> <span class="double">"Dearest Elf, please make $toy_count gifts for $kid_name."</span><span class="structure">;</span></code></pre>
<p>Santa's script simply looks at each line in the child's Christmas list and keeps a tally of how many gifts in total they would like. Here's what Santa sends to his elves on my behalf:</p>
<pre><code> Shawn would like wooden toys (3).
Shawn would like dog clock (1).
Shawn would like hobby horse (1).
Shawn would like glider planes (2).
Dearest Elf, please make 7 gifts for Shawn.</code></pre>
<p>All is well and good in Santa's Workshop!</p>
<h3 id="JavaScript">JavaScript</h3>
<p>In his copious free time, Santa has been learning this year's hot new thing, node.js. After all, Santa has his future to think about. If the giving-billions-of-presents-to-kids-every-year racket doesn't work out, he knows that he can fall back on his hobby, programming. But Santa knows software engineering jobs generally demand fluency in multiple languages, so to get some practical experience, he'll use node.js to process these Christmas lists. Since Perl is so good at text parsing, Santa will continue using that to process the incoming Christmas lists. But he wants to port the work order builder to JavaScript. And of course, Santa knows to use JSON to share data between the two environments.</p>
<p>First, he changes the Perl script to emit JSON instead of text:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/env perl<br /></span><span class="keyword">use</span> <span class="version">5.16.0</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">autodie</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">JSON</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$kid_name</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">@xmas_list</span><span class="structure">;</span><br /><br /><span class="word">open</span> <span class="word">my</span> <span class="symbol">$handle</span><span class="operator">,</span> <span class="single">'<'</span><span class="operator">,</span> <span class="double">"$kid_name.txt"</span><span class="structure">;</span><br /><span class="keyword">while</span> <span class="structure">(</span><span class="readline"><$handle></span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$quantity</span><span class="operator">,</span> <span class="symbol">$gift</span><span class="structure">)</span> <span class="operator">=</span> <span class="match">/^(\d+) (.+)/</span><span class="structure">;</span><br /> <span class="word">push</span> <span class="symbol">@xmas_list</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">gift</span> <span class="operator">=></span> <span class="symbol">$gift</span><span class="operator">,</span><br /> <span class="word">quantity</span> <span class="operator">=></span> <span class="symbol">$quantity</span><span class="operator">,</span><br /> <span class="structure">};</span><br /><span class="structure">}</span><br /><br /><span class="word">say</span> <span class="word">to_json</span><span class="structure">({</span><br /> <span class="word">kid_name</span> <span class="operator">=></span> <span class="symbol">$kid_name</span><span class="operator">,</span><br /> <span class="word">xmas_list</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">@xmas_list</span><span class="operator">,</span><br /><span class="structure">});</span></code></pre>
<p>Now that the Perl script is producing JSON, Santa is ready to write the node code to consume the Christmas list. He structured the JavaScript to register callbacks for interesting events: every time there's new data on <code>STDIN</code>, it is concatenated onto the <code>json</code> variable. Then when <code>STDIN</code> is closed, the full JSON is consumed and examined to print out the work order.</p>
<pre><code class="code-listing">#!/usr/bin/env node<br /><span class="synIdentifier">var</span> json = <span class="synConstant">''</span>;<br /><br />process.stdin.resume();<br /><br />process.stdin.on(<span class="synConstant">'data'</span>, <span class="synIdentifier">function</span>(chunk) <span class="synIdentifier">{</span> json += chunk <span class="synIdentifier">}</span>);<br /><br />process.stdin.on(<span class="synConstant">'end'</span>, <span class="synIdentifier">function</span>() <span class="synIdentifier">{</span><br /> <span class="synIdentifier">var</span> input = JSON.parse(json),<br /> kid_name = input.kid_name,<br /> xmas_list = input.xmas_list,<br /> toy_count = 0;<br /><br /> xmas_list.forEach(<span class="synIdentifier">function</span> (item) <span class="synIdentifier">{</span><br /> console.log(kid_name + <span class="synConstant">" would like "</span> + item.gift + <span class="synConstant">" ("</span> + item.quantity + <span class="synConstant">")."</span>);<br /> toy_count += item.quantity;<br /> <span class="synIdentifier">}</span>);<br /><br /> console.log(<span class="synConstant">"Dearest Elf, please make "</span> + toy_count + <span class="synConstant">" gifts for "</span> + kid_name + <span class="synConstant">"."</span>);<br /><span class="synIdentifier">}</span>);</code></pre>
<p>Santa fires off these two scripts and examines the first work order that comes out.</p>
<pre><code> Shawn would like wooden toys (3).
Shawn would like dog clock (1).
Shawn would like hobby horse (1).
Shawn would like glider planes (2).
Dearest Elf, please make 03112 gifts for Shawn.</code></pre>
<p>Oh no! 3,112 gifts is way too many for one kid! Santa scratches his beard and tries to figure out where things went wrong. He reads the JavaScript again and again, but it all looks right. He reads the Perl again and again, but that looks right too. And where did that zero come from anyway? Elves are certainly eccentric but even they prefer decimal, not octal, numbers.</p>
<p>Do you, beloved reader, see the problem?</p>
<h3 id="Data-Interchange">Data Interchange</h3>
<p>This problem is driving Santa batty, so he starts shifting a little bit more blame than is deserved.</p>
<p>"<i>Does node.js not even get <b>addition</b> right?</i>"</p>
<p>"<i>Is this abominable computer playing tricks on me?</i>"</p>
<p>"<i>That Larry fella? <b>Coal!!</b></i>"</p>
<p>Certainly you've felt the same kind of debugging paranoia before, too. Often a divide and conquer approach will get your foot in the door of these kinds of problems. If Santa can decisively conclude that the bug is in either the Perl or the JavaScript, that halves the problem he is flailing at.</p>
<p>We can figure out which language the bug is in by closely examining the JSON passed from Perl to JavaScript. If the JSON is correct, then the bug can't possibly be in Perl. If the JSON is wrong, then the bug is obviously in Perl. So what does that JSON look like?</p>
<pre><code class="code-listing"> <span class="synIdentifier">{</span><br /> <span class="synConstant">"xmas_list"</span> : <span class="synIdentifier">[</span><br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"wooden toys"</span>,<br /> <span class="synConstant">"quantity"</span> : <span class="synConstant">"3"</span><br /> <span class="synIdentifier">}</span>,<br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"dog clock"</span>,<br /> <span class="synConstant">"quantity"</span> : <span class="synConstant">"1"</span><br /> <span class="synIdentifier">}</span>,<br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"hobby horse"</span>,<br /> <span class="synConstant">"quantity"</span> : <span class="synConstant">"1"</span><br /> <span class="synIdentifier">}</span>,<br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"glider planes"</span>,<br /> <span class="synConstant">"quantity"</span> : <span class="synConstant">"2"</span><br /> <span class="synIdentifier">}</span><br /> <span class="synIdentifier">]</span>,<br /> <span class="synConstant">"kids_name"</span> : <span class="synConstant">"Shawn"</span><br /> <span class="synIdentifier">}</span></code></pre>
<p>That JSON is wrong! Why is each <code>quantity</code> a string? That makes no sense. And since the JSON is wrong, there must be a bug in the Perl program.</p>
<p>Each quantity is a string ultimately because Perl is very forgiving. If you write <code>$str1 + $str2</code>, Perl knows that you meant <i>addition</i> and not <i>concatenation</i> because you chose the <code>+</code> operator instead of the <code>.</code> operator. Concatenation doesn't even cross Perl's mind! So Perl dutifully complies with the <code>+</code> operator by numifying <code>$str1</code> and <code>$str2</code> then adding whatever it pulled out of those two strings.</p>
<p>In Santa's original completely-Perl program, and indeed in most programs, this behavior is very helpful. When Perl deconstructed each line of the Christmas list with a regular expression, it pulled out two substrings: quantity and name. But when Santa summed up the number of gifts, Perl numified each quantity. We didn't need to tell Perl to do that beyond just using addition. This correctly produced the total 7.</p>
<p>However when Santa changed his program to start emitting JSON, there was no more addition to hint to Perl that quantity is actually numeric. Instead, when <a href="https://metacpan.org/module/JSON">JSON</a> came to serialize each quantity, it saw that Perl currently thought the value was a string not a number (since it was produced with a regular expression capture group). So <a href="https://metacpan.org/module/JSON">JSON</a> produced the strings <code>"3"</code>, <code>"1"</code>, <code>"1"</code>, and <code>"2"</code>.</p>
<p>This is problematic because in many other languages that aren't Perl, such as JavaScript, what the <code>+</code> operator will do depends on the types of its operands. <code>number + number</code> means addition and <code>string + string</code> means concatenation. It's not better or worse than how Perl does it; just different. But it means that when the JSON contained strings for quantity, node.js chose <i>concatenation</i>, not <i>addition</i>, during each iteration of <code>toy_count += item.quantity;</code>. This is how Santa accidentally ordered <code>"03112"</code> gifts for me (recall that <code>toy_count</code> was initialized to <code>0</code>, so that's where that leading <code>0</code> came from).</p>
<h3 id="Numification">Numification</h3>
<p>Now we understand the bug. But what is Santa to do about it? It's already December 23rd, he doesn't have much time here!</p>
<p>The fix is to <i>force</i> Perl to treat the quantity value as numeric. You can do this in several different ways: adding zero, multiplying by one, using <code>int(...)</code>, and so on. These operations can only produce numbers, which lets Perl annotate such values as being numeric. That way when <a href="https://metacpan.org/module/JSON">JSON</a> comes to serialize quantity, it sees that the value is a number not a string, so it leaves off the quotation marks. Then when node.js parses this JSON, it treats each quantity as a number, not as a string, so <code>+</code> means addition not concatenation, so we should end up with the correct sum.</p>
<p>Let's add zero to <code>$quantity</code> to produce a number.</p>
<pre><code class="code-listing"><span class="word">push</span> <span class="symbol">@xmas_list</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">gift</span> <span class="operator">=></span> <span class="symbol">$gift</span><span class="operator">,</span><br /> <span class="word">quantity</span> <span class="operator">=></span> <span class="symbol">$quantity</span> <span class="operator">+</span> <span class="number">0</span><span class="operator">,</span><br /><span class="structure">};</span></code></pre>
<p>With this change, the JSON looks like this:</p>
<pre><code class="code-listing"><span class="synIdentifier">{</span><br /> <span class="synConstant">"xmas_list"</span> : <span class="synIdentifier">[</span><br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"wooden toys"</span>,<br /> <span class="synConstant">"quantity"</span> : 3<br /> <span class="synIdentifier">}</span>,<br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"dog clock"</span>,<br /> <span class="synConstant">"quantity"</span> : 1<br /> <span class="synIdentifier">}</span>,<br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"hobby horse"</span>,<br /> <span class="synConstant">"quantity"</span> : 1<br /> <span class="synIdentifier">}</span>,<br /> <span class="synIdentifier">{</span><br /> <span class="synConstant">"gift"</span> : <span class="synConstant">"glider planes"</span>,<br /> <span class="synConstant">"quantity"</span> : 2<br /> <span class="synIdentifier">}</span><br /> <span class="synIdentifier">]</span>,<br /> <span class="synConstant">"kids_name"</span> : <span class="synConstant">"Shawn"</span><br /><span class="synIdentifier">}</span> </code></pre>
<p>And the toy order looks like this:</p>
<pre><code> Shawn would like wooden toys (3).
Shawn would like dog clock (1).
Shawn would like hobby horse (1).
Shawn would like glider planes (2).
In summary, Shawn would like 7 gifts.</code></pre>
<p>Great! Problem solved!</p>
<h3 id="JSON::Types"><a href="https://metacpan.org/module/JSON::Types">JSON::Types</a></h3>
<p>Santa is very happy that orders are now flowing correctly. But he is concerned about that <code>+ 0</code>. It's not particularly obvious what the <code>+ 0</code> is doing, because, practically speaking, when would you ever want to add zero to something? Next year when it comes time to incorporate 2013's cool tech, Santa may have forgotten the reason for the <code>+ 0</code> and outright delete it, or simply drop it when he next refactors the code. He could leave a comment:</p>
<pre><code class="code-listing"><span class="synStatement">push</span> <span class="synIdentifier">@xmas_list</span>, {<br /> <span class="synConstant">gift</span> => <span class="synIdentifier">$gift</span>,<br /> <span class="synConstant">quantity</span> => <span class="synIdentifier">$quantity</span> + <span class="synConstant">0</span>, <span class="synComment"># treat quantity as a number</span><br />};</code></pre>
<p>But he's understandably still concerned about potential maintenance problems because, let's face it, <code>+ 0</code> is fundamentally strange.</p>
<p>Luckily for Santa, there is a new module called <a href="https://metacpan.org/module/JSON::Types">JSON::Types</a> that makes fixing this and other similar problems a treat. <a href="https://metacpan.org/module/JSON::Types">JSON::Types</a> provides a subroutine called <code>number</code> which encapsulates the messy bit of convincing Perl to produce a number.</p>
<pre><code class="code-listing"><span class="word">push</span> <span class="symbol">@xmas_list</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">gift</span> <span class="operator">=></span> <span class="symbol">$gift</span><span class="operator">,</span><br /> <span class="word">quantity</span> <span class="operator">=></span> <span class="word">JSON::Types::number</span><span class="structure">(</span><span class="symbol">$quantity</span><span class="structure">)</span><span class="operator">,</span><br /><span class="structure">};</span></code></pre>
<p>The best part is that just by putting <code>JSON::Types::number</code> into the source code, it's a lot more obvious what is really going on. Even a thousand years from now, Santa will be able to understand what that piece of code means and why it must happen. After all, <a href="https://metacpan.org/module/JSON::Types">JSON::Types</a> has easily-findable documentation explaining the problem. It's hard to document <code>+ 0</code> in general, and it's hard to search for too. Just seeing the word "JSON" in that line of code might even be enough to jog Santa's memory.</p>
<p><a href="https://metacpan.org/module/JSON::Types">JSON::Types</a> also provides <code>string</code> for turning numbers into strings. You could of course use <code>"$number"</code> to force a string into a number, but that has the same kinds of problems as <code>+ 0</code>.</p>
<p>Finally, <a href="https://metacpan.org/module/JSON::Types">JSON::Types</a> also provides a <code>bool</code> subroutine for producing the constants <code>true</code> and <code>false</code> that JSON has. In Perl, we get by just fine with using <code>undef</code> or the empty string for <code>false</code> and <code>1</code> for true, but in other languages, that simply will not stand. <code>bool($value)</code> will use the same kind of logic as Perl's <code>if</code> to decide whether <code>$value</code> should produce <code>true</code> or <code>false</code>. Without <a href="https://metacpan.org/module/JSON::Types">JSON::Types</a>, you'd have to do something silly like <code>$value ? JSON::true : JSON::false</code>.</p>
<p>So, this year, be sure you're using addition, not concatenation, to count how many gifts your loved ones get!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/JSON">JSON</a></p>
</li>
<li><p><a href="https://metacpan.org/module/JSON::Types">JSON::Types</a></p>
</li>
</ul>
</div>2012-12-23T00:00:00ZShawn M MooreGenerate static web sites using your favorite Perl frameworkhttp://perladvent.org/2012/2012-12-22.html<div class='pod'><h2 id="The-best-of-two-worlds">The best of two worlds</h2>
<h3 id="Static-web-sites">Static web sites</h3>
<p>Have you noticed the recent trend of static blogging?</p>
<p>The idea behind static blogging is to use a tool to <i>generate</i> the HTML pages that constitute the blog from a set of simple text files, and to publish these generated pages using a basic web server.</p>
<p>Some would argue that a blog without comments is not really a blog. And how do you comment without <code>POST</code>? One way would be to delegate the <code>POST</code>ing to someone else (like <a href="http://disqus.com/">Disqus</a>).</p>
<p>Also, static web sites don't have to be frozen. Nothing prevents you from generating the site content regularly (especially if it depends on an external source) or from hooking it to your VCS repository, so that every update to the source triggers a regeneration.</p>
<p>Going back to static web sites, here are a few reasons why people like them:</p>
<ul>
<li><p>Speed:</p>
<p>It would be really hard to beat a webserver serving a static file from disk.</p>
</li>
<li><p>Security:</p>
<p>No user input means no SQL injection. If no code is run to produce the response, then no bugs can interfere in the process.</p>
<p>Of course, you're still vulnerable to your webserver's own security issues when it serves static files, but that should be a pretty limited set.</p>
</li>
<li><p>Simplicity:</p>
<p>A static web site is a bunch of files. You can commit them in a VCS and push them to their final destination, or you can use FTP. It's the easiest deployment procedure ever.</p>
</li>
<li><p>Economy:</p>
<p>Generate once, request any time!</p>
</li>
</ul>
<p>Static blogging tools like <a href="http://jekyllrb.com/">Jekyll</a>, <a href="http://pypi.python.org/pypi/pelican">Pelican</a>, <a href="http://middlemanapp.com/">Middleman</a> keep popping up, and new ones are invented almost daily.</p>
<p>(I have myself been using <a href="http://template-toolkit.org/docs/tools/ttree.html">ttree</a> for years, but writing code using <a href="http://template-toolkit.org/">Template Toolkit</a>'s DSL can be limiting.)</p>
<p>The setup is always the same: take a bunch of files in <i>some format</i> (usually <a href="http://daringfireball.net/projects/markdown/">Markdown</a>, <a href="http://docutils.sourceforge.net/rst.html">reStructuredText</a> or <a href="http://www.txstyle.org/">Textile</a>), plus some configuration, and run the tool. The problem with that is always the same: the model fits the original author's needs, and you have to follow <i>their</i> rules. Personalisation not included.</p>
<h3 id="Web-frameworks">Web frameworks</h3>
<p>Perl has plenty of awesome web frameworks, such as <a href="http://www.catalystframework.org/">Catalyst</a>, <a href="http://www.perldancer.org/">Dancer</a>, <a href="http://mojolicio.us/">Mojolicious</a>, and many others, to let you write your web application the way you want. Each has its own set of advantages and disadvantages, but that is not the point of this article.</p>
<p>The point is that using those to run a blog or the framework's marketing^Whome page may seem wasteful, as there's probably little need to regenerate a page for each request, no matter if the content has changed or not.</p>
<h3 id="Static-web-sites-made-with-web-frameworks">Static web sites made with web frameworks</h3>
<p>PSGI is an interface between web servers and applications written in Perl. The Plack implementation of PSGI is supported by most Perl web frameworks. It's also possible to write your own application (a PSGI application is just a subroutine) and connect it to any supported web server — and most web servers are supported.</p>
<p>After having tried to write my own static site generator, and having failed at making it as flexible as I would have liked (which in retrospect would probably have made it a web framework in itself), it seemed wiser to start building a site with one of those nice web frameworks and to use Plack as my entry point to get the to the content.</p>
<p><a href="https://metacpan.org/module/wallflower">wallflower</a> is a command-line tool that takes a PSGI application, and uses Plack to access to the content and save it to local files, ready to be uploaded to your static web server.</p>
<p>After obtaining the coderef for your application, it repeatedly creates the PSGI environment for the URL you want to process and runs your app on it (using <code>Plack::Util::run_app</code>), saving the response content to a local file. If the response content type is <code>text/html</code> or <code>text/css</code>, it will automatically look for embedded links and add them to its queue, thus enabling auto-discovery of the entire web site.</p>
<p>The point of <a href="https://metacpan.org/module/Wallflower">Wallflower</a> is to let you write any static website using all the power of your favorite web framework. It also follows links inside your Plack application, so if your site is properly organized, you only need to point it to <code>/</code>.</p>
<h3 id="Blogging-statically-with-your-favorite-framework">Blogging statically with your favorite framework</h3>
<p>The obvious example for this would be to write a blog. I'll use Dancer, because it's the only web framework I know, but keep in mind that this will work with any PSGI-compliant framework. You could actually write your own PSGI application, if no existing framework suited you.</p>
<p>Since our target is a <i>static</i> web site, the main thing to keep in mind is that the target web server will determine the content type by looking at the extension, each all of our URLs <b>must</b> have an extension.</p>
<p>The sources for our basic blog will be a set of text files in the <i>public/</i> subdirectory, with the content written in Markdown. URL will simply be mapped to those files.</p>
<p>So, we start by writing a route to handle all URL ending with <i>.html</i>:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">ShyBlog</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Dancer</span> <span class="single">':syntax'</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Text::Markdown</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Class</span> <span class="words">qw( file )</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$m</span> <span class="operator">=</span> <span class="word">Text::Markdown</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><br /><span class="word">get</span> <span class="regexp">qr{/(.*)\.html}</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$file</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">splat</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$text</span> <span class="operator">=</span> <span class="word">file</span><span class="structure">(</span> <span class="word">setting</span><span class="structure">(</span><span class="single">'public'</span><span class="structure">)</span> <span class="operator">=></span> <span class="double">"$file.txt"</span> <span class="structure">)</span><span class="operator">-></span><span class="word">slurp</span><span class="structure">;</span><br /> <span class="word">template</span> <span class="single">'blog'</span><span class="operator">,</span> <span class="structure">{</span> <span class="word">content</span> <span class="operator">=></span> <span class="symbol">$m</span><span class="operator">-></span><span class="word">markdown</span><span class="structure">(</span><span class="symbol">$text</span><span class="structure">)</span> <span class="structure">};</span><br /><span class="structure">};</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>Since we put our blog entries in the <i>public/</i> directory, Dancer will automatically serve the source when we end the URL in <i>.txt</i>! And we didn't even need to write a route for that!</p>
<p>Now, we want to get any further than a single blog post, to showing a main page with the latest post, some side bars on every page pointing to the archives by month, and maybe a JSON file with all our tags for making a nice tag cloud in JavaScript, we have a bit of a problem: we need to know about all our blog's posts when generating any individual one.</p>
<p>Remember that our PSGI application is ultimately a subroutine that will be called repeatedly by wallflower, so we just have to make the needed data available to the subroutine by building the list of all posts, once and for all, during the initialisation phase of the application.</p>
<p>A simple call to <a href="https://metacpan.org/module/File::Find">File::Find</a> will help us generate the list of all posts, from which we can create a data structure. In this example it's an array:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">File::Find</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Class</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@entries</span><span class="structure">;</span><br /><br /><span class="word">find</span><span class="structure">(</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /><br /><span class="comment"> # we only care about blog entries<br /></span> <span class="keyword">return</span> <span class="word">if</span> <span class="operator">!</span><span class="match">/\.txt$/</span><span class="structure">;</span><br /><br /><span class="comment"> # get a Path::Class::File for it<br /></span> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="operator">=</span> <span class="word">file</span><span class="structure">(</span><span class="symbol">$File::Find::name</span><span class="structure">);</span><br /> <span class="keyword">my</span> <span class="symbol">$fh</span> <span class="operator">=</span> <span class="symbol">$file</span><span class="operator">-></span><span class="word">openr</span><span class="structure">;</span><br /><br /><span class="comment"> # parse a simple header using the kite secret operator<br /></span> <span class="word">chomp</span><span class="structure">(</span> <span class="keyword">my</span> <span class="structure">(</span> <span class="symbol">$title</span><span class="operator">,</span> <span class="symbol">$date</span><span class="operator">,</span> <span class="symbol">$tags</span> <span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span> <span class="operator">~~<</span><span class="symbol">$fh</span><span class="operator">>,</span> <span class="operator">~~<</span><span class="symbol">$fh</span><span class="operator">>,</span> <span class="operator">~~<</span><span class="symbol">$fh</span><span class="operator">></span> <span class="structure">)</span> <span class="structure">);</span><br /><br /><span class="comment"> # update the structure will all relevant information<br /></span> <span class="keyword">my</span> <span class="symbol">$source</span> <span class="operator">=</span> <span class="word">substr</span><span class="structure">(</span> <span class="symbol">$File::Find::name</span><span class="operator">,</span> <span class="word">length</span><span class="structure">(</span> <span class="word">setting</span><span class="structure">(</span><span class="single">'public'</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">);</span><br /> <span class="structure">(</span> <span class="keyword">my</span> <span class="symbol">$url</span> <span class="operator">=</span> <span class="symbol">$source</span> <span class="structure">)</span> <span class="operator">=~</span> <span class="substitute">s/\.txt$/.html;<br /><br /> push @entries, {<br /> url => '/</span><span class="single">' .<br /> title => $title,<br /> date => $date,<br /> tags => [ split /\s*,\s*/, $tags ],<br /> source => "/$year/$month/$_.txt",<br /> };<br /> },<br /> setting( '</span><span class="word">public</span><span class="single">' )<br />);</span></code></pre>
<p>Actually, for simplicity, and integration with the framework, it would make sense to create a temporary SQLite database, with a few tables for blog entries meta-information, tags, etc. The code in the templates and some special routes (like the main page) can then use that database to fetch all the information they need.</p>
<p>Generating the website is now simply a matter of running:</p>
<pre><code> $ wallflower -a bin/app.pl -d /path/to/the/output/</code></pre>
<p><i>wallflower</i> will start browsing the application from <code>/</code> and will follow all links (from HTML and CSS files) to generate your site content.</p>
<p>You can then copy the content of <i>output/</i> to the proper location on the target web server, and you're done!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/App::Wallflower">App::Wallflower</a></p>
</li>
<li><p><a href="https://metacpan.org/module/wallflower">wallflower</a></p>
</li>
<li><p><a href="https://metacpan.org/module/PSGI">PSGI</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Dancer">Dancer</a></p>
</li>
<li><p><a href="https://metacpan.org/module/perlsecret#Kite">~~<></a></p>
</li>
</ul>
</div>2012-12-22T00:00:00ZPhilippe BruhatSet-based DBIx::Classhttp://perladvent.org/2012/2012-12-21.html<div class='pod'><p>I've been using <a href="https://metacpan.org/module/DBIx::Class">DBIx::Class</a> for a few years, and I've been part of the development team for just a little bit less. Three years ago I wrote a <a href="http://www.catalystframework.org/calendar/2009/20">Catalyst Advent article</a> about the five <a href="https://metacpan.org/module/DBIx::Class::Helpers">DBIx::Class::Helpers</a>, which have since ballooned to twenty-four. I'll be mentioning a few helpers in this post, but the main thing I want to describe is a way of using DBIx::Class that results in efficient applications as well as reduced code duplication.</p>
<p>(Don't know anything about DBIx::Class? Want a refresher before diving in more deeply? Maybe watch <a href="https://www.youtube.com/watch?v=Vm_NlfHNVvg">my presentation</a> on it, or, if you don't like my face, try <a href="http://www.youtube.com/watch?v=N-tbMPyNlM8">this one</a>.)</p>
<p>The thesis of this article is that <b>when you write code to act on things at the set level, you can often leverage the database's own optimizations</b> and thus produce faster code at a lower level.</p>
<h2 id="Set-Based-DBIx::Class">Set Based DBIx::Class</h2>
<p>The most important feature of DBIx::Class is not the fact that it saves you time by allowing you to sidestep database incompatibilities. It's not that you never have to learn the exact way to paginate correctly with SQL Server. It isn't even that you won't have to write DDL for some of the most popular databases. Of course DBIx::Class <b>does</b> do these things. Any ORM worth it's weight in salt should.</p>
<h3 id="Chaining">Chaining</h3>
<p>The most important feature of DBIx::Class is the <a href="https://metacpan.org/module/DBIx::Class::ResultSet">ResultSet</a>. I'm not an expert on ORMs, but I've yet to hear of another ORM which has an immutable[†] query representation framework. The first thing you <b>must</b> understand to achieve DBIx::Class mastery is ResultSet chaining. This is basic but critical.</p>
<p>The basic pattern of chaining is that you can do the following and not hit the database:</p>
<pre><code class="code-listing"><span class="symbol">$resultset</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="word">name</span> <span class="operator">=></span> <span class="single">'frew'</span><span class="operator">,</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="word">job</span> <span class="operator">=></span> <span class="single">'software engineer'</span><span class="operator">,</span><br /><span class="structure">})</span></code></pre>
<p>What the above implies is that you can add methods to your resultsets like the following:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">search_by_name</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$self</span><span class="operator">,</span> <span class="symbol">$name</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">current_source_alias</span> <span class="operator">.</span> <span class="double">".name"</span> <span class="operator">=></span> <span class="symbol">$name</span> <span class="structure">})</span><br /><span class="structure">}</span><br /><br /><span class="keyword">sub</span> <span class="word">is_software_engineer</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">current_source_alias</span> <span class="operator">.</span> <span class="double">".job"</span> <span class="operator">=></span> <span class="single">'software engineer'</span><span class="operator">,</span><br /> <span class="structure">})</span><br /><span class="structure">}</span></code></pre>
<p>And then the query would become merely</p>
<pre><code class="code-listing"><span class="symbol">$resultset</span><span class="operator">-></span><span class="word">search_by_name</span><span class="structure">(</span><span class="single">'frew'</span><span class="structure">)</span><span class="operator">-></span><span class="word">is_software_engineer</span></code></pre>
<p>(microtip: use <a href="https://metacpan.org/module/DBIx::Class::Helper::ResultSet::Me">DBIx::Class::Helper::ResultSet::Me</a> to make defining searches as above less painful.)</p>
<h3 id="Relationship-Traversal">Relationship Traversal</h3>
<p>The next thing you need to know is relationship traversal. This can happen two different ways, and to get the most code reuse out of DBIx::Class you'll need to be able to reach for both when the time arrises.</p>
<p>The first is the more obvious one:</p>
<pre><code class="code-listing"><span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="single">'job.name'</span> <span class="operator">=></span> <span class="single">'goblin king'</span><span class="operator">,</span><br /><span class="structure">}</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">join</span> <span class="operator">=></span> <span class="single">'job'</span><span class="operator">,</span><br /><span class="structure">})</span></code></pre>
<p>The above finds person rows that have the job "<a href="https://www.google.com/search?tbm=isch&q=david+bowie+jareth">goblin king</a>."</p>
<p>The alternative to use <a href="https://metacpan.org/module/DBIx::Class::ResultSet#related_resultset">"related_resultset" in DBIx::Class::ResultSet</a>:</p>
<pre><code class="code-listing"><span class="symbol">$job_rs</span><span class="operator">-></span><span class="word">search_by_name</span><span class="structure">(</span><span class="single">'goblin_king'</span><span class="structure">)</span><br /> <span class="operator">-></span><span class="word">related_resultset</span><span class="structure">(</span><span class="single">'person'</span><span class="structure">)</span></code></pre>
<p>The above generates the same query, but allows you to use methods that are defined on the job resultset.</p>
<h3 id="Subqueries">Subqueries</h3>
<p>Subqueries are less important for code reuse and more important in avoiding incredibly inefficient database patterns. Basically, they allow the database to do more on its own. Without them, you'll end up asking the database for data, then you'll send that data right back to the database as part of your next query. It's not only pointless network overhead but also two queries.</p>
<p>Here's an example of what not to do in <code>DBIx::Class</code>:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@failed_tests</span> <span class="operator">=</span> <span class="symbol">$tests</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="word">pass</span> <span class="operator">=></span> <span class="number">0</span><span class="operator">,</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">all</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@not_failed_tests</span> <span class="operator">=</span> <span class="symbol">$tests</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="word">id</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">-not_in</span> <span class="operator">=></span> <span class="structure">[</span><span class="word">map</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">id</span><span class="operator">,</span> <span class="symbol">@failed_tests</span><span class="structure">]</span> <span class="structure">}</span><span class="operator">,</span> <span class="comment"># XXX: DON'T DO THIS</span><br /><span class="structure">});</span></code></pre>
<p>If you got enough failed tests back, this would probably just error. <b>Just Say No</b> to inefficient database queries:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$failed_tests</span> <span class="operator">=</span> <span class="symbol">$tests</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="word">pass</span> <span class="operator">=></span> <span class="number">0</span><span class="operator">,</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">get_column</span><span class="structure">(</span><span class="single">'id'</span><span class="structure">)</span><span class="operator">-></span><span class="word">as_query</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@not_failed_tests</span> <span class="operator">=</span> <span class="symbol">$tests</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="word">id</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">-not_in</span> <span class="operator">=></span> <span class="symbol">$failed_tests</span> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">});</span></code></pre>
<p>This is much more efficient than before, as it's just a single query and lets the database do what it does best and gives you what you exactly want.</p>
<h3 id="Christmas">Christmas!</h3>
<p>Ok so now you know how to reuse searches as much as is currently possible. You understand the basics of subqueries in <code>DBIx::Class</code> and how they can save you time. My guess is that you actually already knew that. "This wasn't any kind of ninja secret, fREW! You lied to me!" I'm sorry, but now we're getting to the real meat.</p>
<h3 id="Correlated-Subqueries">Correlated Subqueries</h3>
<p>One of the common, albeit expensive, usage patterns I've seen in <code>DBIx::Class</code> is using <code>N + 1</code> queries to get related counts. The idea is that you do something like the following:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@data</span> <span class="operator">=</span> <span class="word">map</span> <span class="operator">+</span><span class="structure">{</span><br /> <span class="cast">%</span><span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">as_hash</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">friend_count</span> <span class="operator">=></span> <span class="magic">$_</span><span class="operator">-></span><span class="word">friends</span><span class="operator">-></span><span class="word">count</span><span class="operator">,</span> <span class="comment"># XXX: BAD CODE, DON'T COPY PASTE</span><br /><span class="structure">}</span><span class="operator">,</span> <span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">all</span></code></pre>
<p>Note that the <code>$_->friends->count</code> is a query to get the count of friends. The alternative is to use correlated subqueries. Correlated subqueries are hard to understand and even harder to explain. The gist is that, just like <a href="#Subqueries">before</a>, we are just using a subquery to avoid passing data to the database for no good reason. This time we are just going to do it for each row in the database. Here is how one would do the above query, except as promised, with only a single hit to the database:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@data</span> <span class="operator">=</span> <span class="word">map</span> <span class="operator">+</span><span class="structure">{</span><br /> <span class="cast">%</span><span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">as_hash</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">friend_count</span> <span class="operator">=></span> <span class="magic">$_</span><span class="operator">-></span><span class="word">get_column</span><span class="structure">(</span><span class="single">'friend_count'</span><span class="structure">)</span><span class="operator">,</span><br /><span class="structure">}</span><span class="operator">,</span> <span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">search</span><span class="structure">(</span><span class="core">undef</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="single">'+columns'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">friend_count</span> <span class="operator">=></span> <span class="symbol">$friend_rs</span><span class="operator">-></span><span class="word">search</span><span class="structure">({</span><br /> <span class="single">'friend.person_id'</span> <span class="operator">=></span><br /> <span class="structure">{</span> <span class="word">-ident</span> <span class="operator">=></span> <span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">current_source_alias</span> <span class="operator">.</span> <span class="double">".id"</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">alias</span> <span class="operator">=></span> <span class="single">'friend'</span><span class="operator">,</span><br /> <span class="structure">})</span><span class="operator">-></span><span class="word">count_rs</span><span class="operator">-></span><span class="word">as_query</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">all</span></code></pre>
<p>There are only two new things above. The first is <code>-ident</code>. All <code>-ident</code> does is tell <code>DBIx::Class</code> "this is the name of a thing in the database, quote it appropriately." In the past people would have written <code>-ident</code> using queries like this:</p>
<pre><code class="code-listing"><span class="single">'friend.person_id'</span> <span class="operator">=></span> <span class="cast">\</span><span class="single">' = foo.id'</span> <span class="comment"># don't do this, it's silly</span></code></pre>
<p>So if you see something like that in your code base, change it to <code>-ident</code> as above.</p>
<p>The next new thing is the <code>alias => 'friend'</code> directive. This merely ensures that the inner rs has it's own alias, so that you have something to correlate against. If that doesn't make sense, just trust me and cargo cult for now.</p>
<p>This adds a virtual column, which is itself a subquery. The column is, basically, <code>$friend_rs->search({ 'friend.person_id' => $_->id })->count</code>, except it's all done in the database. The above is <b>horrible</b> to recreate every time, so I made a helper: <a href="https://metacpan.org/module/DBIx::Class::Helper::ResultSet::CorrelateRelationship">DBIx::Class::Helper::ResultSet::CorrelateRelationship</a>. With the helper the above becomes:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@data</span> <span class="operator">=</span> <span class="word">map</span> <span class="operator">+</span><span class="structure">{</span><br /> <span class="cast">%</span><span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">as_hash</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">friend_count</span> <span class="operator">=></span> <span class="magic">$_</span><span class="operator">-></span><span class="word">get_column</span><span class="structure">(</span><span class="single">'friend_count'</span><span class="structure">)</span><span class="operator">,</span><br /><span class="structure">}</span><span class="operator">,</span> <span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">search</span><span class="structure">(</span><span class="core">undef</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="single">'+columns'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">friend_count</span> <span class="operator">=></span> <span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">correlate</span><span class="structure">(</span><span class="single">'friend'</span><span class="structure">)</span><span class="operator">-></span><span class="word">count_rs</span><span class="operator">-></span><span class="word">as_query</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">all</span></code></pre>
<h3 id="ProxyResultSetMethod"><a href="https://metacpan.org/module/DBIx::Class::Helper::Row::ProxyResultSetMethod">::ProxyResultSetMethod</a></h3>
<p>Correlated Subqueries are nice, especially given that there is a helper to make creating them easier, but it's still not as nice as we would like it. I made another helper which is the icing on the cake. It encourages more forward-thinking DBIx::Class usage with respect to resultset methods.</p>
<p>Let's assume you need friend count very often. You should make the following resultset method in that case:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">with_friend_count</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">search</span><span class="structure">(</span><span class="core">undef</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="single">'+columns'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">friend_count</span> <span class="operator">=></span> <span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">correlate</span><span class="structure">(</span><span class="single">'friend'</span><span class="structure">)</span><span class="operator">-></span><span class="word">count_rs</span><span class="operator">-></span><span class="word">as_query</span><br /> <span class="structure">}</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p>Now you can just do the following to get a resultset with a friend count included:</p>
<pre><code class="code-listing"><span class="symbol">$person_rs</span><span class="operator">-></span><span class="word">with_friend_count</span></code></pre>
<p>But to access said friend count from a result you'll still have to use <code>->get_column('friend')</code>, which is a drag since using <code>get_column</code> on a <code>DBIx::Class</code> result is nearly using a private method. That's where my helper comes in. With <a href="https://metacpan.org/module/DBIx::Class::Helper::Row::ProxyResultSetMethod">DBIx::Class::Helper::Row::ProxyResultSetMethod</a>, you can use the <code>->with_friend_count</code> method <b>from</b> your row methods, and better yet, if you used it when you originally pulled data with the resultset, the result will use the data that it already has! The gist is that you add this to your result class:</p>
<pre><code class="code-listing"><span class="word">__PACKAGE__</span><span class="operator">-></span><span class="word">load_components</span><span class="structure">(</span><span class="words">qw( Helper::Row::ProxyResultSetMethod )</span><span class="structure">);</span><br /><span class="word">__PACKAGE__</span><span class="operator">-></span><span class="word">proxy_resultset_method</span><span class="structure">(</span><span class="single">'friend_count'</span><span class="structure">);</span></code></pre>
<p>and that adds a <code>friend_count</code> method on your row objects that will correctly proxy to the resultset or use what it pulled or cache if called more than once!</p>
<h3 id="ProxyResultSetUpdate"><a href="DBIx:Class::Helper::Row::ProxyResultSetUpdate">::ProxyResultSetUpdate</a></h3>
<p>I have one more, small gift for you. Sometimes you want to do something when either your row or resultset is updated. I posit that the best way to do this is to write the method in your resultset and then proxy to the resultset from the row. If you force your API to update through the result you are doing <code>N</code> updates (one per row), which is inefficient. My helper simply needs to be loaded:</p>
<pre><code class="code-listing"><span class="word">__PACKAGE__</span><span class="operator">-></span><span class="word">load_components</span><span class="structure">(</span><span class="words">qw( Helper::Row::ProxyResultSetUpdate )</span><span class="structure">);</span></code></pre>
<p>and your results will use the update defined in your resultset.</p>
<h3 id="Dont-Stop">Don't Stop!</h3>
<p>This isn't all! DBIx::Class can be very efficient <b>and also</b> reduce code duplication. Whenever you have something that's slow or bound to result objects, think about what you could do to leverage your amazing storage layer's speed (the RDBMS) and whether you can push the code down a layer to be reused more.</p>
<p>[†] if it weren't for the fact that there is an implicit iterator akin to <code>each %foo</code> it would be 100% immutable. It's pretty close though!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/DBIx::Class">DBIx::Class</a></p>
</li>
<li><p><a href="https://metacpan.org/module/DBIx::Class::Helper::ResultSet::Me">DBIx::Class::Helper::ResultSet::Me</a></p>
</li>
<li><p><a href="https://metacpan.org/module/DBIx::Class::Helper::ResultSet::CorrelateRelationship">DBIx::Class::Helper::ResultSet::CorrelateRelationship</a></p>
</li>
<li><p><a href="https://metacpan.org/module/DBIx::Class::Helper::Row::ProxyResultSetMethod">DBIx::Class::Helper::Row::ProxyResultSetMethod</a></p>
</li>
<li><p><a href="DBIx:Class::Helper::Row::ProxyResultSetUpdate">DBIx:Class::Helper::Row::ProxyResultSetUpdate</a></p>
</li>
</ul>
</div>2012-12-21T00:00:00ZArthur Axel "fREW" SchmidtBetter Testinghttp://perladvent.org/2012/2012-12-20.html<div class='pod'><h2 id="Moose-is-slow">Moose is slow!</h2>
<p>At least when testing. Moose's compile time speed isn't typically a problem when running things like web applications, since they only start up once, but tests frequently run many instances of the application in quick succession, and this can add quite a bit of time to the overall runtime of the test suite. This can in fact happen with a lot of different modules - Moose is just the most well known example, but any large module will have a similar effect.</p>
<p>If you look at what's actually happening though, all of this extra time is spent doing the same thing. The same code is loaded at the start, and then only after compilation is finished do things start to diverge (to run the actual tests themselves). There's no reason that the code that runs for <code>use Moose</code> should need to run multiple times during the test suite, since it always does the same thing, and so a lot of time could be saved by loading modules fewer times.</p>
<h3 id="Test::Aggregate">Test::Aggregate</h3>
<p>In the past, people have attacked this problem by combining test files into fewer, bigger ones, or by using something like <a href="https://metacpan.org/module/Test::Aggregate">Test::Aggregate</a> to automate this process. This is error-prone, because a lot of times tests can have global effects - installing subs into packages, creating classes, etc. We really do want tests to run in separate environments, to avoid allowing them to interfere with each other.</p>
<h3 id="App::ForkProve">App::ForkProve</h3>
<p><a href="https://metacpan.org/module/App::ForkProve">App::ForkProve</a> solves this problem. It is a wrapper for <a href="https://metacpan.org/module/App::Prove">App::Prove</a>, which allows you to preload modules, and then instead of running each of the test files via <code>fork</code> and <code>exec</code>, it runs them via <code>fork</code> and <code>eval</code>. This way, the preloaded modules are already loaded in the current interpreter, and so when the test files are run, the <code>use</code> statement is just a no-op.</p>
<p>This actually works remarkably well - the <a href="https://metacpan.org/module/OX">OX</a> test suite takes 30 seconds to run <code>make test</code> on my laptop, which decreases to 14 seconds under <code>prove -rj5 -l t</code> (since it runs the tests in parallel on multiple processors), but <code>forkprove -rj5 -l -MOX -MOX::Request -MOX::Response -MOX::RouteBuilder::Code -MOX::RouteBuilder::ControllerAction -MOX::RouteBuilder::HTTPMethod t</code> runs in just <i>3 seconds</i>.</p>
<h3 id="Tips-and-tricks">Tips and tricks</h3>
<p>That command line did get a bit long though, and it's hard for people who aren't the developer to know what things are useful to preload. It may be useful to provide a module along with your test suite that does the job of loading all of the useful modules, so you only have to specify a single <code>-M</code> option. For instance, here is the contents of <code>t/Preload.pm</code> in the OX repository:</p>
<pre><code class="code-listing"><span class="synStatement">package</span><span class="synType"> t::Preload</span>;<br /><span class="synStatement">use strict</span>;<br /><span class="synStatement">use warnings</span>;<br /><br /><span class="synStatement">use </span>OX;<br /><span class="synStatement">use </span>OX::Request;<br /><span class="synStatement">use </span>OX::Response;<br /><span class="synStatement">use </span>OX::RouteBuilder::Code;<br /><span class="synStatement">use </span>OX::RouteBuilder::ControllerAction;<br /><span class="synStatement">use </span>OX::RouteBuilder::HTTPMethod;<br /><br /><span class="synConstant">1</span>;</code></pre>
<p>Now, you can just run <code>forkprove -rj5 -l -Mt::Preload t</code> to get the same effect.</p>
<p>Another useful trick is that since <code>forkprove</code> is entirely compatible with <code>prove</code> except for the <code>-M</code> option, you can replace <code>prove</code> with <code>forkprove</code> entirely, by adding an alias to your shell configuration:</p>
<pre><code> alias prove="forkprove"</code></pre>
<p>This way, prove will continue to work as it always has in the past, but if you specify any <code>-M</code> options, they will be preloaded.</p>
<h3 id="Caveats">Caveats</h3>
<p>This isn't <i>entirely</i> free, however. One obvious place where this would cause problems is in test files which test to make sure certain modules <i>don't</i> get loaded in certain situations. If you preload those modules, those tests will start failing.</p>
<p>In addition, since the tests are running from <code>forkprove</code> itself, any calls to <code>Carp::confess</code> or similar will report a longer stacktrace than they would otherwise, because all of the App::ForkProve machinery is actually still on the call stack. This is not typically a problem, but can potentially cause failures if you are relying on matching the entire stacktrace in a test.</p>
<h2 id="TAP-is-ugly">TAP is ugly!</h2>
<p>So now we have our tests running nice and quickly, and we make a change in our actual code, and it causes some tests to fail. The trouble is, the actual causes of the failures can be obscured by all of the <code>prove</code> output, especially if it's running in parallel. It'd be nice to have an easily skimmable output that makes it much more apparent what is wrong.</p>
<p>A typical solution here is to run <code>prove -l t</code>, see the list of failures at the end, and run the test files individually with <code>perl -Ilib t/failing-test.t</code>. This isn't great though, since raw TAP isn't the easiest thing to read. Additionally, if your tests don't have descriptions, it can be quite hard to find the test you're looking for.</p>
<h3 id="Test::Pretty">Test::Pretty</h3>
<p><a href="https://metacpan.org/module/Test::Pretty">Test::Pretty</a> modifies the TAP output in order to make it a lot more pleasant to read. It adds colored output, automatically generates a test description based on the line number and contents of tests if they don't have one. For instance:</p>
<img src="test-pretty.png" />
<p>In addition, it cleans up the output of subtests to make them easier to follow:</p>
<img src="test-pretty-subtest.png" />
<h3 id="Tips-and-tricks1">Tips and tricks</h3>
<p>Another shell alias can make using this easier:</p>
<pre><code class="code-listing">function t <span class="synSpecial">{</span><br /> <span class="synStatement">if </span><span class="synSpecial">[[</span> <span class="synStatement">-d</span> <span class="synConstant">blib</span> <span class="synSpecial">]]</span><span class="synStatement">;</span> <span class="synStatement">then</span><br /> perl <span class="synSpecial">-Mblib</span> <span class="synSpecial">-MTest</span>::Pretty <span class="synStatement">"</span><span class="synPreProc">$@</span><span class="synStatement">"</span><br /> <span class="synStatement">else</span><br /> perl <span class="synSpecial">-Ilib</span> <span class="synSpecial">-MTest</span>::Pretty <span class="synStatement">"</span><span class="synPreProc">$@</span><span class="synStatement">"</span><br /> <span class="synStatement">fi</span><br /><span class="synSpecial">}</span></code></pre>
<p>This way, <code>t t/foo.t</code> will run the given test file, using <code>blib</code> if appropriate.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/forkprove">forkprove</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Test::Pretty">Test::Pretty</a></p>
</li>
</ul>
</div>2012-12-20T00:00:00ZJesse LuehrsA Cache Presenthttp://perladvent.org/2012/2012-12-19.html<div class='pod'><p>People love receiving <i>cash</i> for Christmas, but a <i>cache</i> is a much more useful gift for your performance-hungry web server or application.</p>
<p>Today we'll talk about <a href="https://metacpan.org/module/CHI">CHI</a>, a modern Cache Handling Interface for Perl -- sort of a <a href="https://metacpan.org/module/DBI">DBI</a> for caching.</p>
<h2 id="USING-CHI">USING CHI</h2>
<p>Creating a cache looks like:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cache</span> <span class="operator">=</span> <span class="word">CHI</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">driver</span> <span class="operator">=></span> <span class="single">'...'</span><span class="operator">,</span><br /> <span class="word">namespace</span> <span class="operator">=></span> <span class="single">'...'</span><span class="operator">,</span><br /><span class="comment"> # driver specific args<br /></span><span class="structure">);</span></code></pre>
<p><i>driver</i> indicates the cache backend, which controls how the cache data will be stored. Available backends include <a href="https://metacpan.org/module/CHI::Driver::Memory">Memory</a>, <a href="https://metacpan.org/module/CHI::Driver::File">File</a>, <a href="https://metacpan.org/module/CHI::Driver::BerkeleyDB">BDB</a>, <a href="https://metacpan.org/module/CHI::Driver::Memcached">Memcached</a>, and <a href="https://metacpan.org/module/CHI::Driver::Redis">Redis</a> - see <a href="https://metacpan.org/search?q=CHI%3A%3ADriver">CPAN</a> for a complete list - and creating your own driver is <a href="https://metacpan.org/module/CHI::Driver::Development">simple</a>.</p>
<p><i>namespace</i> is a string that keeps this cache from other caches on the same backend. Often it's the name of the caller's Perl package or script.</p>
<p><code>CHI</code> honors the standard <i>get</i>/<i>set</i> API that most cache modules use:</p>
<pre><code class="code-listing"><span class="comment"># Try to get value from cache.<br />#<br /></span><span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="symbol">$cache</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><span class="symbol">$key</span><span class="structure">);</span><br /><span class="keyword">if</span> <span class="structure">(</span> <span class="operator">!</span><span class="core">defined</span> <span class="symbol">$data</span> <span class="structure">)</span> <span class="structure">{</span><br /><br /><span class="comment"> # Was not in cache. Compute $data here.<br /> #<br /></span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="operator">...</span><span class="structure">;</span><br /><br /><span class="comment"> # Store in cache with a 10 minute expiration time.<br /> #<br /></span> <span class="symbol">$cache</span><span class="operator">-></span><span class="word">set</span><span class="structure">(</span> <span class="symbol">$key</span><span class="operator">,</span> <span class="symbol">$data</span><span class="operator">,</span> <span class="double">"10m"</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>It also provides an all-in-one <i>compute</i> API, which is shorter and less error-prone:</p>
<pre><code class="code-listing"><span class="comment"># Try to get value from cache; if missing, call the sub<br /># and store the returned value.<br />#<br /></span><span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="symbol">$cache</span><span class="operator">-></span><span class="word">compute</span><span class="structure">(</span><span class="symbol">$key</span><span class="operator">,</span> <span class="double">"10m"</span><span class="operator">,</span> <span class="keyword">sub</span> <span class="structure">{</span><br /><span class="comment"> # Compute and return value here<br /></span><span class="structure">});</span></code></pre>
<h2 id="FEATURES">FEATURES</h2>
<p>With <code>CHI</code> you get a lot of caching features under the tree, and you can use them no matter which backend you've chosen.</p>
<h3 id="Automatic-key-value-serialization">Automatic key/value serialization</h3>
<p>You can store arbitrary <i>values</i> in the cache, including listrefs, hashrefs and combinations thereof; <code>CHI</code> will automatically serialize and deserialize them for you. Automatic compression over a certain size is also an option.</p>
<p>You can also use arbitrary references as cache <i>keys</i>, e.g.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$key</span> <span class="operator">=</span> <span class="structure">[</span><span class="symbol">$pub_id</span><span class="operator">,</span> <span class="symbol">$article_id</span><span class="operator">,</span> <span class="symbol">$page_id</span><span class="structure">];</span><br /><span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="symbol">$cache</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><span class="symbol">$key</span><span class="operator">,</span> <span class="operator">...</span><span class="structure">);</span></code></pre>
<p>This saves you from the tedious and failure-prone process of composing multiple values into a key. And if your key is too long or too weird for your driver, CHI will digest and/or escape it for you.</p>
<h3 id="Multilevel-caches">Multilevel caches</h3>
<p>You can chain multiple caches together in various ways. For example, here we place a size-limited memory <a href="http://en.wikipedia.org/wiki/CPU_cache#Multi-level_caches">L1 cache</a> in front of a memcached cache. <code>CHI</code> will look in the memory cache first; on a miss, it will consult memcached and write back the value into the memory cache.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cache</span> <span class="operator">=</span> <span class="word">CHI</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">driver</span> <span class="operator">=></span> <span class="single">'Memcached'</span><span class="operator">,</span><br /> <span class="word">servers</span> <span class="operator">=></span> <span class="structure">[</span> <span class="double">"10.0.0.15:11211"</span><span class="operator">,</span> <span class="double">"10.0.0.15:11212"</span> <span class="structure">]</span><span class="operator">,</span><br /> <span class="word">l1_cache</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">driver</span> <span class="operator">=></span> <span class="single">'Memory'</span><span class="operator">,</span> <span class="word">global</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">max_size</span> <span class="operator">=></span> <span class="number">1024</span><span class="operator">*</span><span class="number">1024</span> <span class="structure">}</span><br /><span class="structure">);</span></code></pre>
<h3 id="Miss-stampede-avoidance">Miss stampede avoidance</h3>
<p>A <a href="http://lists.danga.com/pipermail/memcached/2007-July/004810.html">miss stampede</a> occurs when a popular cache item expires, and a large number of processes all rush to recompute it. CHI provides <a href="https://metacpan.org/module/CHI#Getting-and-setting">two ways</a> to reduce or avoid this common cache problem - <i>probablistic expiration</i> (in which expiration occurs over a range, instead of a single fixed time) and <i>busy locks</i> (in which the first process sets a lock so that other processes know not to start recomputing).</p>
<h3 id="Logging-and-statistics">Logging and statistics</h3>
<p>You can tell CHI to <a href="https://metacpan.org/module/CHI#LOGGING">log</a> every cache hit, miss and set for debugging purposes. You can also tell CHI to output <a href="https://metacpan.org/module/CHI#STATS">statistics</a> about the performance of your caches, including the hit/miss rate and the average compute time for each namespace.</p>
<p>Happy caching all!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p>CHI</p>
</li>
</ul>
</div>2012-12-19T00:00:00ZJonathan SwartzSynchronous Operations are So Outdatedhttp://perladvent.org/2012/2012-12-18.html<div class='pod'><h2 id="Understanding-asynchronous-events">Understanding asynchronous events</h2>
<p>The best way to explain why synchronous code can sometimes be daunting is to use an example from Real Life™. A single day in our lives can contain plenty of actions that make us cringe and growl. Take, for instance, trying to make a meal.</p>
<p>Imagine you're cooking. You wouldn't wait for the water to boil before you prepared the potatoes. Nor would you wait for the potatoes to be done before you started working on the salad.</p>
<p>Asynchronous programming means having multiple events happen at the same time. It allows you to get more things done while you're waiting for other things to happen.</p>
<p>The fundamental element of asynchronous programming is the callback, so let's review that first, and then take a look at some examples of async in code-land.</p>
<p>We will be using <a href="https://metacpan.org/module/AnyEvent">AnyEvent</a> for this article, but the same principles exist in all other async frameworks.</p>
<h2 id="Introduction-to-callbacks">Introduction to callbacks</h2>
<p>Since multiple events run at the same time, the application (much like the spice) must flow. To make this work, whenever we start one event we include references to the code that should be run when it finishes or hits other milestones. Since the event then "knows" how to proceed on its own, it can start up and work in the background while the rest of the program continues on doing more things.</p>
<p>We're going to be using a technique that some are not familiar with: <b>callbacks</b>. Just to get you up to speed, let me start by explaining callbacks in a nutshell: callbacks are just references to subroutines.</p>
<p>These subroutines can be defined using names or they can be anonymous. We can call those subroutines by their reference instead of their name.</p>
<pre><code class="code-listing"><span class="comment"># callbacks to named subroutines<br /></span><span class="keyword">sub</span> <span class="word">func</span> <span class="structure">{</span> <span class="operator">...</span> <span class="structure">}</span><br /><span class="keyword">my</span> <span class="symbol">$func_reference</span> <span class="operator">=</span> <span class="cast">\</span><span class="symbol">&func</span><span class="structure">;</span><br /><span class="symbol">$func_reference</span><span class="operator">-></span><span class="structure">(</span><span class="symbol">@arguments</span><span class="structure">);</span><br /><br /><span class="comment"># callbacks to anonymous subroutines<br /></span><span class="keyword">my</span> <span class="symbol">$func_reference</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="operator">...</span> <span class="structure">};</span><br /><span class="symbol">$func_reference</span><span class="operator">-></span><span class="structure">(</span><span class="symbol">@arguments</span><span class="structure">);</span></code></pre>
<p>If we use <code>sub</code> to create a reference to a subroutine, we can pass the callback as a parameter directly, without saving it first:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">some_cb_handler</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$callback</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="symbol">$callback</span><span class="operator">-></span><span class="structure">(</span><span class="double">"hello"</span><span class="structure">);</span><br /><span class="structure">}</span><br /><br /><span class="comment"># We pass in the callback without ever giving it a name or making it<br /># globally accessible.<br /></span><span class="word">some_cb_handler</span><span class="structure">(</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$greeting</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="word">say</span> <span class="double">"$greeting, world!"</span><span class="structure">;</span><br /><span class="structure">}</span> <span class="structure">);</span></code></pre>
<h2 id="Reading-from-input">Reading from input</h2>
<p>You have an application that needs to read from a handle (which could be a file descriptor, a socket, or even the standard input), but you don't know when it will be ready to be read.</p>
<p>In a synchronous application, you'll be waiting for it to become available, possibly calling <code>sleep</code> in between. But these days, we're busy people, we can't just be waiting by the phone. We have stuff to do!</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">alert_action</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$action</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="word">say</span> <span class="double">"New action found: $action"</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="keyword">my</span> <span class="symbol">$io_watcher</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">io</span><span class="structure">(</span><br /> <span class="word">fh</span> <span class="operator">=></span> <span class="symbol">$fh</span><span class="operator">,</span><br /> <span class="word">poll</span> <span class="operator">=></span> <span class="single">'r'</span><span class="operator">,</span><br /> <span class="word">cb</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /><span class="comment"> # we can now read!<br /></span> <span class="keyword">my</span> <span class="symbol">$input</span> <span class="operator">=</span> <span class="readline"><$fh></span><span class="structure">;</span><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="symbol">$input</span> <span class="operator">=~</span> <span class="match">/^New action: (\w+)/</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">alert_action</span><span class="structure">(</span><span class="magic">$1</span><span class="structure">);</span><br /> <span class="structure">}</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="comment"># continue to do something else</span></code></pre>
<p>How does that work? By calling <a href="https://metacpan.org/module/AnyEvent">AnyEvent</a>'s <code>io</code> method, you're creating a new watcher that checks a file handle for new read events. If it has something to read, it will call the code reference we provided. Both the checks and the subroutine call will happen in the background.</p>
<p>Also, since we've given it all the information it needs (which file handle to poll, what kind of events we want, and what to do in that case), it doesn't need to hold us back. That way we can continue with some other code, and the watcher will wait and run the background, without bothering us.</p>
<h2 id="Keeping-the-watchers-alive">Keeping the watchers alive</h2>
<p>There is a problem I haven't mentioned. That code is fine, except that once it executes the additional code, the application will close, simply because it reached the end of the file. We want to keep the application running, so our watchers will continue to work. How do we do that? Condition variables!</p>
<p>Condition variables are variables that represent a condition waiting to come true, like your cat waiting for you to get comfortable with a laptop. When the variable becomes true, the cat comes over and lies on your lap, disrupting your work.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$done</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">condvar</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$watcher</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">io</span><span class="structure">(</span><br /> <span class="word">fh</span> <span class="operator">=></span> <span class="symbol">$fh</span><span class="operator">,</span><br /> <span class="word">poll</span> <span class="operator">=></span> <span class="single">'r'</span><span class="operator">,</span><br /> <span class="word">cb</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$input</span> <span class="operator">=</span> <span class="readline"><$fh></span><span class="structure">;</span><br /> <span class="operator">...</span><br /> <span class="word">if</span> <span class="structure">(</span> <span class="symbol">$input</span> <span class="operator">=~</span> <span class="match">/^End of processing file/</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="symbol">$done</span><span class="operator">-></span><span class="word">send</span><span class="structure">;</span><br /> <span class="structure">}</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="operator">...</span><br /><span class="symbol">$done</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"All done!"</span><span class="structure">;</span></code></pre>
<p>This time we created a condition variable that is available to the watcher. The watcher still dilligently continues its work. Only this time as soon as it finds a line in the file indicating the end of it, it will call <code>send</code> on the condition variable, making the condition true, effectively saying "that's it, we're done".</p>
<p>If someone has called <code>recv</code> on the condition variable, it will wait until something else in the background (like our watcher) will call <code>send</code> and then will continue running.</p>
<p>That means that the line "All done!" will only get written once our worker finished reading the line.</p>
<p>Another ramification of the condition variable's behavior is that it is possible to create an infinite loop by creating a condition variable, calling <code>recv</code>, and not having anything call <code>send</code> on it. It looks exactly like this:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cv</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">condvar</span><span class="structure">;</span><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span><br /><br /><span class="comment"># or in short<br /></span><span class="word">AnyEvent</span><span class="operator">-></span><span class="word">condvar</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>Since the application is now waiting for a condition variable to come true, it will not terminate. Because nothing can call <code>send</code> on this variable, it basically means the application will stay up indefinitely. The most common usage for this are daemons, which should always be running.</p>
<h2 id="Timing-your-cooking">Timing your cooking</h2>
<p>The last element in <a href="https://metacpan.org/module/AnyEvent">AnyEvent</a> that we'll be looking at is the timer. Timers are events (any kind of event) that gets run at some point in time. It can be in a few minutes from now or at a specific hour. It can happen once or it can repeat itself several times, or even forever.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$timer</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">timer</span><span class="structure">(</span><br /> <span class="word">after</span> <span class="operator">=></span> <span class="float">3.5</span><span class="operator">,</span><br /> <span class="word">interval</span> <span class="operator">=></span> <span class="number">5</span><span class="operator">,</span><br /> <span class="word">cb</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="word">say</span> <span class="double">"Ping? Pong!"</span><span class="structure">;</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>This defines a timer that will wait 3.5 seconds, and then call the subroutine every 5 seconds. Fairly simple. Let's try a few timers.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@steps</span> <span class="operator">=</span> <span class="words">qw<Cutting Simmering Cooking Seasoning Serving></span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$current_step</span> <span class="operator">=</span> <span class="single">'Preparing'</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$done</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">condvar</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$t1</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">timer</span><span class="structure">(</span><br /> <span class="word">interval</span> <span class="operator">=></span> <span class="number">60</span> <span class="operator">*</span> <span class="number">7</span><span class="operator">,</span><br /> <span class="word">cb</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="word">say</span> <span class="double">"Current cooking state: $current_step"</span><span class="structure">;</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$t2</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">timer</span><span class="structure">(</span><br /> <span class="word">after</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># two seconds to wash hands before working!</span><br /> <span class="word">interval</span> <span class="operator">=></span> <span class="number">60</span> <span class="operator">*</span> <span class="number">10</span><span class="operator">,</span> <span class="comment"># assuming every action takes 10 minutes</span><br /> <span class="word">cb</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="symbol">$current_step</span> <span class="operator">=</span> <span class="core">shift</span> <span class="symbol">@steps</span> <span class="operator">or</span> <span class="keyword">return</span> <span class="symbol">$done</span><span class="operator">-></span><span class="word">send</span><span class="structure">;</span><br /> <span class="word">do_step</span><span class="structure">(</span><span class="symbol">$current_step</span><span class="structure">);</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="symbol">$done</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"Dinner is served!"</span><span class="structure">;</span></code></pre>
<p>What we have here isn't the best example for how to make a meal, but it does give us an example showing multiple timers. The first timer (<code>$t1</code>) keeps alerting us every seven minutes about our progress. Meanwhile, our second timer picks up an action to do every 10 minutes, and does it. Once no more actions are available, it tells the condition variable that it's done. It does this by simply returning out of the subroutine (so we don't call <code>do_step</code> again) and calling <code>send</code> at the same time.</p>
<p>After we created our timers, we set up a <code>recv</code> on a condition variable, meaning "don't continue running the rest of the application until we are notified that the timers finished their work". It will wait in that point in time (without blocking the timers) until the <code>send</code> is called. Then it will continue and say dinner is finally served. Since it's the end of the application, the timers will close and the application will end.</p>
<p>Here is the output we'll get from running the application:</p>
<pre><code> Current cooking state: Preparing
(do_step() called with "Cutting")
Current cooking state: Cutting
(do_step() called with "Simmering")
Current cooking state: Simmering
Current cooking state: Simmering
(do_step() called with "Cooking")
Current cooking state: Cooking
(do_step() called with "Seasoning")
Current cooking state: Seasoning
(do_step() called with "Serving")
Current cooking state: Serving
Current cooking state: Serving
Dinner is served!</code></pre>
<h2 id="Condition-variables-with-multiple-calls">Condition variables with multiple calls</h2>
<p>Sometimes the behavior of the condition variable's <code>send</code> and <code>recv</code> is not flexible enough to handle instances in which you need to be able to wait on multiple calls.</p>
<p>Suppose you have a calculation to do that depends on the result of multiple database queries. Before the SQL experts jump at it, let's also suppose these queries are made across different databases.</p>
<p>A database connection is in fact a network operation, which means it blocks. This is an ideal example for async programming. You could initiate several connections and queries concurrently instead of consequtively. Using condition variables, you would probably try to open three condition variables, and then waiting for each to come true. That won't work, since you can only call <code>recv</code> on one variable at a time.</p>
<p>Instead, condition variables can accept a <code>begin</code> and <code>end</code> call to signify a multi-call request. Once there's been an <code>end</code> call for each <code>begin</code> call, it will return to the <code>recv</code> method.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cv</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">condvar</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$sum</span> <span class="operator">=</span> <span class="number">0</span><span class="structure">;</span><br /><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$db</span> <span class="structure">(</span><span class="symbol">@dbs</span><span class="structure">)</span> <span class="structure">{</span><br /><span class="comment"> # beginning an event<br /></span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">;</span><br /><br /> <span class="symbol">$db</span><span class="operator">-></span><span class="word">query</span><span class="structure">(</span> <span class="symbol">$query</span><span class="operator">,</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$amount</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="symbol">$sum</span> <span class="operator">+=</span> <span class="symbol">$amount</span><span class="structure">;</span><br /><br /><span class="comment"> # finishing an event<br /></span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">end</span><span class="structure">;</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">}</span><br /><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"All database queries finished."</span><span class="structure">;</span></code></pre>
<h2 id="Bringing-it-all-together">Bringing it all together</h2>
<p>After we've gone over a few elements of AnyEvent, we can build a small useful application. We'll add a few more elements such as <a href="https://metacpan.org/module/AnyEvent::HTTP">AnyEvent::HTTP</a>, <a href="https://metacpan.org/module/Regexp::Common">Regexp::Common</a>, and <a href="https://metacpan.org/module/File::Basename">File::Basename</a>.</p>
<p>Suppose we have a file that has contains a lot of links and we want to download every image listed in it. These are two different actions: (1) reading the file and (2) downloading the images. We will also have a timer that gives us the progress every two seconds.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">AnyEvent</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">AnyEvent::HTTP</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Regexp::Common</span> <span class="single">'URI'</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">File::Basename</span> <span class="single">'basename'</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">autodie</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$counter</span> <span class="operator">=</span> <span class="number">0</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$cv</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">condvar</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$fh</span> <span class="operator">=</span> <span class="word">open</span> <span class="keyword">my</span> <span class="symbol">$fh</span><span class="operator">,</span> <span class="single">'<'</span><span class="operator">,</span> <span class="single">'links.txt'</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$fhwatcher</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">io</span><span class="structure">(</span><br /> <span class="word">fh</span> <span class="operator">=></span> <span class="symbol">$fh</span><span class="operator">,</span><br /> <span class="word">poll</span> <span class="operator">=></span> <span class="single">'r'</span><span class="operator">,</span><br /> <span class="word">cb</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$line</span> <span class="operator">=</span> <span class="readline"><$fh></span><span class="structure">;</span><br /><br /><span class="comment"> # ignoring lines that aren't HTTP URIs<br /></span> <span class="symbol">$line</span> <span class="operator">=~</span> <span class="match">/^$RE{URI}{HTTP}$/</span> <span class="operator">or</span> <span class="keyword">return</span><span class="structure">;</span><br /><br /><span class="comment"> # call an HTTP request<br /></span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">;</span><br /> <span class="word">http_get</span> <span class="symbol">$line</span><span class="operator">,</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$body</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$filename</span> <span class="operator">=</span> <span class="word">basename</span><span class="structure">(</span><span class="symbol">$line</span><span class="structure">);</span><br /><br /> <span class="word">syswrite</span> <span class="symbol">$filename</span><span class="operator">,</span> <span class="symbol">$body</span> <span class="operator">?</span><br /> <span class="symbol">$counter</span><span class="operator">++</span> <span class="operator">:</span><br /> <span class="operator">or</span> <span class="word">warn</span> <span class="double">"Couldn't write to $filename: $!"</span><span class="structure">;</span><br /><br /> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">end</span><span class="structure">;</span><br /> <span class="structure">};</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$progress</span> <span class="operator">=</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">timer</span><span class="structure">(</span><br /> <span class="word">after</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># giving it two seconds before starting</span><br /> <span class="word">interval</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># report every two seconds</span><br /> <span class="word">cb</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="word">printf</span> <span class="double">"[%s] Update: finished downloading $counter images.\n"</span><span class="operator">,</span><br /> <span class="word">scalar</span> <span class="word">AnyEvent</span><span class="operator">-></span><span class="word">now</span><span class="structure">;</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span><br /><span class="word">close</span> <span class="symbol">$fh</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"Finished downloading all files"</span><span class="structure">;</span></code></pre>
<p>Let's analyze what we've got here. We use some modules that you should recognize. If you don't, you should check them out.</p>
<p>The next thing is opening a file handle. We then set up a watcher for some I/O operations using <a href="https://metacpan.org/module/AnyEvent">AnyEvent</a>'s <code>io</code> method. It needs the file handle we are going to operate on, and the kind of operation we'll do (we pick <code>r</code> for reading) and a callback to run. This callback is the main thing that takes a bit to understand.</p>
<p>Every time we read a line that has a URL, we call <code>begin</code> on the condition variable. We issue an HTTP request for that URL and once we finish fetching it and saving it, we issue the corresponding <code>end</code> call. When all <code>begin</code> calls have <code>end</code>ed, it will return to the <code>recv</code> method, much like calling <code>send</code>.</p>
<p>We also created a progress timer that announces, every two seconds, the number of links we've sent. You'll notice it uses <a href="https://metacpan.org/module/AnyEvent">AnyEvent</a>'s <code>now</code>, which is the recommended way to call <code>time</code> when running in an event loop.</p>
<p>The <code>recv</code> call in the end will wait until all <code>begin</code> calls will be closed. Once we've worked on the entire file, it will print a nice message and the application will end.</p>
<h2 id="Just-the-beginning">Just the beginning...</h2>
<p>Once you get used to programming asynchronously, it's like having scissors: you just run with it! <b>Note:</b> Do not run with scissors. ✂ 🏃</p>
<p>Try out an event framework and see how much fun it is for yourself. Perl has many to offer, such as <a href="https://metacpan.org/module/AnyEvent">AnyEvent</a>, <a href="https://metacpan.org/module/POE">POE</a>, <a href="https://metacpan.org/module/IO::Async">IO::Async</a>, <a href="https://metacpan.org/module/Reflex">Reflex</a>, <a href="https://metacpan.org/module/IO::Lambda">IO::Lambda</a>, <a href="https://metacpan.org/module/Coro">Coro</a>, and more.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/AnyEvent">AnyEvent</a></p>
</li>
<li><p><a href="https://metacpan.org/module/POE">POE</a></p>
</li>
<li><p><a href="https://metacpan.org/module/IO::Async">IO::Async</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Reflex">Reflex</a></p>
</li>
<li><p><a href="https://metacpan.org/module/IO::Lambda">IO::Lambda</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Coro">Coro</a></p>
</li>
</ul>
</div>2012-12-18T00:00:00ZSawyer XSanta Has Dependencies Toohttp://perladvent.org/2012/2012-12-17.html<div class='pod'><p>In the old days, Santa's elves would build every toy from scratch, but now he outsources most of the parts for the toys. Naturally, he has created a sophisticated supply-chain management system to ensure that each toy is consistently built from the same parts.</p>
<p>The same is true for software development. These days, our applications depend on lots of frameworks and libraries. So we also need to manage the supply of those dependencies to ensure that every build has the same "parts."</p>
<p><a href="https://metacpan.org/module/Pinto">Pinto</a> helps you manage your supply of dependencies by creating a custom repository of Perl modules. The repository is fully compatible with CPAN installers (e.g. <code>cpan</code>, <code>cpanm</code>, <code>cpanp</code>), but unlike the public CPAN, the modules in your Pinto repository only change when you want to change them. You'll get the exact same result each and every time you build.</p>
<p>The <code>pinto</code> command line utility does all the work of creating the repository, and provides some helpful tools for managing change as your dependencies evolve over time. Let's take a look at some of the things you can do...</p>
<p>First, let's create a repository. All you need is a directory where the repository will live (we'll use <i>~/my_repo</i> here) and the name of the stack (we'll use <code>prod</code> here). A stack is just a named subset of modules in your repository (more on that later). Here's what the command would look like:</p>
<pre><code> $ pinto -r ~/my_repo init --stack=prod</code></pre>
<p>Suppose we want to use <a href="https://metacpan.org/module/Catalyst">Catalyst</a> for a new application. Let's get it from the CPAN and put it in our Pinto repository. This command will put the latest (at this moment) version of Catalyst and all of its dependencies into our Pinto repository:</p>
<pre><code> $ pinto -r ~/my_repo pull Catalyst</code></pre>
<p>To install Catalyst, we just point <code>cpanm</code> (or <code>cpan</code> or <code>cpanp</code>) at the stack inside the repository. Every time we do this, we'll get exactly the same version of Catalyst and its dependencies, even if newer versions have been released to the public CPAN:</p>
<pre><code> $ cpanm --mirror=file:///home/jeff/my_repo/prod --mirror-only Catalyst</code></pre>
<p>From time to time, Santa decides to upgrade the parts used to build a toy, or even switch to a new parts supplier entirely. To ensure quality, Santa always sets up a separate assembly line for the elves to test the new parts before committing them to mass production.</p>
<p>With Pinto, you can do the same thing. Suppose that Catalyst 4.0 is released to the CPAN and we want to try upgrading our application, which now has several other dependencies of its own. We can make an experimental duplicate of those dependencies by copying the stack like this:</p>
<pre><code> $ pinto -r ~/my_repo copy prod catalyst-upgrade</code></pre>
<p>Any changes we make to the "catalyst-upgrade" stack are completely separate from the "prod" stack. So we can now go ahead and upgrade Catalyst (and whatever new modules it may require) like this:</p>
<pre><code> $ pinto -r ~/my_repo pull --stack=catalyst-upgrade Catalyst~4.0</code></pre>
<p>To test our upgraded application dependencies, we just make a new build by pointing cpanm at the "catalyst-upgrade" stack inside the repository:</p>
<pre><code> $ cpanm --mirror=file:///home/jeff/my_repo/catalyst-upgrade --mirror-only Catalyst</code></pre>
<p>If our application (and all of its dependencies) build cleanly then we can just merge two stacks together and throw away the experimental stack:</p>
<pre><code> $ pinto -r ~/my_repo merge catalyst-upgrade prod
$ pinto -r ~/my_repo delete catalyst-upgrade</code></pre>
<p>Occasionally, Santa's elves find that a new version of a part is flawed or just not compatible with current their line of toys. Since the workshop is pretty big, it can be hard to ensure that every elf foreman doesn't mistakenly order the new (flawed) part for his assembly line. So Santa keeps a real-time blacklist of all the part numbers that are not allowed in the workshop.</p>
<p>This happens all the time in software development, so Pinto allows you to "pin" the modules in your repository, which prevents them from being upgraded. Suppose we already have Plack 2.0 in our Pinto repository and we learn that Plack 3.0 is not compatible with our application. So we can pin Plack to let everyone know that it can't be upgraded yet:</p>
<pre><code> $ pinto -r ~/my_repo pin Plack</code></pre>
<p>If anyone tries to upgrade Plack directly or to satisfy the prerequisites for some other module, then Pinto will refuse to comply. Once you've resolved the problem, then you can unpin Plack and upgrade it as needed.</p>
<p>Keeping lists of all the naughty and nice children is huge task, so Santa has become very good at record keeping. He also keeps excellent records of everything that happens in the workshop. This helps him to identify the critical links in his supply chain or reward deserving elves.</p>
<p>Pinto keeps records too, so you can see what's in the repository right now and how it has changed over time. Here are some of the things you can do:</p>
<pre><code> # Show all the modules in the stack right now:
$ pinto -r ~/my_repo list</code></pre>
<p></p>
<pre><code> # Show who's responsible for the current modules in the stack:
$ pinto -r ~/my_repo blame</code></pre>
<p></p>
<pre><code> # Show how and why the stack has changed over time:
$ pinto -r ~/my_repo log --detailed</code></pre>
<p>As you can imagine, Santa Claus has pretty much perfected the science of supply-chain management, so when it comes to managing our supply of module dependencies, we software developers could probably learn a lot from him. Perhaps Pinto should have been called "Donner" or "Vixen."</p>
<h2 id="SEE-ALSO">SEE ALSO</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Pinto">Pinto on CPAN</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Pinto::Manual">Pinto::Manual on CPAN</a></p>
</li>
<li><p><a href="http://www.youtube.com/watch?v=oaBBVZFhJUk">Pinto presentation at YAPC</a></p>
</li>
</ul>
</div>2012-12-17T00:00:00ZJeffrey Ryan ThalhammerCreating Your Own Perlhttp://perladvent.org/2012/2012-12-16.html<div class='pod'><pre><code class="code-listing"><span class="keyword">use</span> <span class="word">List::Util</span> <span class="words">qw( reduce )</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@numbers</span> <span class="operator">=</span> <span class="number">1</span> <span class="operator">..</span> <span class="number">10</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$even_sum</span> <span class="operator">=</span> <span class="word">reduce</span> <span class="structure">{</span> <span class="symbol">$a</span> <span class="operator">+</span> <span class="symbol">$b</span> <span class="structure">}</span> <span class="word">grep</span> <span class="structure">{</span> <span class="magic">$_</span> <span class="operator">%</span> <span class="number">2</span> <span class="operator">==</span> <span class="number">0</span> <span class="structure">}</span> <span class="symbol">@numbers</span><span class="structure">;</span></code></pre>
<p>See what I did there? Unlike some functional programming languages, Perl doesn't have a built-in <code>fold</code> or <code>reduce</code> keyword, so I cleverly imported the <code>reduce</code> function from <a href="https://metacpan.org/module/List::Util">List::Util</a>. (Of course, if I'd been really clever, I'd have noticed List::Util also has a <code>sum</code> function available.)</p>
<p>Due to some trickery with sub prototypes and manipulating its caller's symbol table, List::Util manages to make its <code>reduce</code> function feel just like a built-in language feature. It uses the same codeblock syntax as <code>grep</code> and <code>map</code>, and the same magic <code>$a</code> and <code>$b</code> variables as <code>sort</code>.</p>
<p>Via tricks like these, plus ties, overloads, custom <code>import</code> functions, source filters, <a href="https://metacpan.org/module/Devel::Declare">Devel::Declare</a>, <code>%^H</code>, and (in newer versions of Perl) the pluggable keyword API, Perl modules have the power to affect their caller in ways far beyond the mechanisms that other programming languages make available. When you use a module that does this, you're not just loading a library and using it at arm's length; you're changing the very syntax of Perl - lexically, within your module.</p>
<p>When starting a new script, or a new module, this is what we do. We add a bunch of <code>use</code> statements to the top of the file to tweak Perl's flavour to our liking. We make Perl a more suitable language for getting the job done; we turn a general purpose programming language into a domain-specific language suitable for our exact task. This will often begin with something like:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="version">v5.14</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span></code></pre>
<p>but if you're writing anything non-trivial, it's likely that a bunch of other <code>use</code> statements will join them.</p>
<p>(Of course, some modules are plain old object-oriented code that make no attempt to alter their caller's syntax. Different approaches are appropriate for different tasks.)</p>
<h3 id="Twelve-Lords-A-Leaping">Twelve Lords A Leaping</h3>
<p>Here are some of my favourite syntax-bending modules:</p>
<h4 id="List::Util-List::MoreUtils">List::Util / List::MoreUtils</h4>
<p><a href="https://metacpan.org/module/List::Util">List::Util</a> is a core Perl module with a small collection of array munging functions; <a href="https://metacpan.org/module/List::MoreUtils">List::MoreUtils</a> is a collection of extras that didn't quite make the shortlist.</p>
<p>Many of these make creative use of sub prototypes to look and act like Perl's built-in list manipulation functions. The <code>first</code>, <code>uniq</code> and <code>reduce</code> functions are especially useful, and should be in every Perl programmer's toolkit.</p>
<h4 id="PerlX::Maybe">PerlX::Maybe</h4>
<p><a href="https://metacpan.org/module/PerlX::Maybe">PerlX::Maybe</a> provides a tiny function making it easier to work with optional named parameters, a la:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$santa</span> <span class="operator">=</span> <span class="word">Person</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">title</span> <span class="operator">=></span> <span class="double">"Saint"</span><span class="operator">,</span><br /> <span class="word">name</span> <span class="operator">=></span> <span class="double">"Nicholas"</span><span class="operator">,</span><br /> <span class="word">maybe</span> <span class="word">telephone</span> <span class="operator">=></span> <span class="symbol">$phone</span><span class="operator">,</span> <span class="comment"># $phone might be undef</span><br /> <span class="word">maybe</span> <span class="word">email</span> <span class="operator">=></span> <span class="symbol">$email</span><span class="operator">,</span> <span class="comment"># $email might be undef</span><br /><span class="structure">);</span></code></pre>
<h4 id="Syntax::Keyword::Junction">Syntax::Keyword::Junction</h4>
<p><a href="https://metacpan.org/module/Syntax::Keyword::Junction">Syntax::Keyword::Junction</a> implements support for something approaching the Perl 6 concept of junctions; that is, variables which have multiple values at once.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$reindeer</span> <span class="operator">=</span> <span class="word">any</span><span class="structure">(</span><span class="words">qw/<br /> Dasher Dancer Prancer Vixen Comet Cupid Donder Blitzen<br />/</span><span class="structure">);</span><br /><span class="symbol">$reindeer</span> <span class="operator">eq</span> <span class="double">"Dasher"</span><span class="structure">;</span> <span class="comment"># true</span><br /><span class="symbol">$reindeer</span> <span class="operator">eq</span> <span class="double">"Prancer"</span><span class="structure">;</span> <span class="comment"># true</span><br /><span class="symbol">$reindeer</span> <span class="operator">eq</span> <span class="double">"Rudolf"</span><span class="structure">;</span> <span class="comment"># false</span></code></pre>
<p>It achieves this with nothing more than careful use of overloading.</p>
<h4 id="aliased">aliased</h4>
<p><a href="https://metacpan.org/module/aliased">aliased</a> provides short aliases for long class names.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">aliased</span> <span class="double">"Rangifer::Tarandus"</span> <span class="operator">=></span> <span class="double">"Reindeer"</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$rudolf</span> <span class="operator">=</span> <span class="word">Reindeer</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span></code></pre>
<p>The short alias is just a constant that returns the class name as a string. Simple idea, but useful.</p>
<h4 id="Safe::Isa">Safe::Isa</h4>
<p>Ever get the <i>Can't call method "isa" on an undefined value</i> blues? <a href="https://metacpan.org/module/Safe::Isa">Safe::Isa</a> gives you a way to call methods like <code>isa</code> and <code>can</code> on scalars without checking that they are defined and blessed.</p>
<pre><code class="code-listing"><span class="comment"># Might return undef if there are no cheap desserts<br /></span><span class="keyword">my</span> <span class="symbol">$pudding</span> <span class="operator">=</span> <span class="symbol">$menu</span><span class="operator">-></span><span class="word">find_food</span><span class="structure">(</span><span class="word">max_price</span> <span class="operator">=></span> <span class="number">5</span><span class="operator">,</span> <span class="word">category</span> <span class="operator">=></span> <span class="word">DESSERT</span><span class="structure">);</span><br /><br /><span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$pudding</span><span class="operator">-></span><span class="symbol">$_isa</span><span class="structure">(</span><span class="single">'Plum::Pudding'</span><span class="structure">))</span> <span class="structure">{</span><br /> <span class="word">say</span> <span class="double">"Yum!"</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>It takes advantage of the fact that coderefs may be called as methods even on unblessed or undefined invocants.</p>
<h4 id="Try::Tiny">Try::Tiny</h4>
<p>While <code>eval</code> and <code>$@</code> can be used as a try-catch mechanism in Perl, there are numerous gotchas. <a href="https://metacpan.org/module/Try::Tiny">Try::Tiny</a> works around them for you, giving you a nice syntax for exception catching.</p>
<pre><code class="code-listing"><span class="word">try</span> <span class="structure">{</span><br /> <span class="symbol">$gift</span><span class="operator">-></span><span class="word">give</span><span class="structure">(</span><span class="symbol">$recipient</span><span class="structure">);</span><br /><span class="structure">}</span><br /><span class="word">catch</span> <span class="structure">{</span><br /> <span class="keyword">when</span> <span class="structure">(</span><span class="match">/^Can't call method "give"/</span><span class="structure">)</span> <span class="structure">{</span> <span class="structure">}</span> <span class="comment"># ignore</span><br /> <span class="keyword">default</span> <span class="structure">{</span> <span class="word">die</span> <span class="magic">$_</span> <span class="structure">}</span><br /><span class="structure">};</span></code></pre>
<p>There are even nicer modules like <a href="https://metacpan.org/module/TryCatch">TryCatch</a> available, but Try::Tiny's zero-dependency approach - it uses nothing more than prototypes and guards (dummy objects with just a destructor) - is perfect for even small projects.</p>
<h4 id="NEXT">NEXT</h4>
<p><a href="https://metacpan.org/module/NEXT">NEXT</a> adds a <code>SUPER</code>-like pseudo-class to your module, but with more control of method redispatch than <code>SUPER</code> gives you. Good if you're programming with multiple inheritance.</p>
<p>These days you should probably use <a href="https://metacpan.org/module/mro">mro</a> instead, but NEXT deserves a mention for its clever use of AUTOLOAD and capitalised package names to create the illusion of new syntax.</p>
<h4 id="Web::Simple">Web::Simple</h4>
<p>This Plack-based web app framework uses a sub prototype hack for dispatching.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="prototype">(POST + /naughty_list/person+ ?name=&*)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$self</span><span class="operator">,</span> <span class="symbol">$name</span><span class="operator">,</span> <span class="symbol">$misc_params</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="operator">...</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<h4 id="autovivification">autovivification</h4>
<p>Perl's autovivification feature can sometimes be counterintuitive.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$menu</span> <span class="operator">=</span> <span class="core">undef</span><span class="structure">;</span><br /><span class="word">exists</span> <span class="symbol">$menu</span><span class="operator">-></span><span class="structure">{</span><span class="word">plum</span><span class="structure">}{</span><span class="word">pudding</span><span class="structure">};</span> <span class="comment"># false</span><br /><span class="word">exists</span> <span class="symbol">$menu</span><span class="operator">-></span><span class="structure">{</span><span class="word">plum</span><span class="structure">};</span> <span class="comment"># true !!!</span></code></pre>
<p>The <a href="https://metacpan.org/module/autovivification">autovivification</a> module can selectively disable autovivification for particular scopes, or get Perl to issue a warning or fatal error when autovivification occurs. Very handy.</p>
<p>Lots of deep XS magic in this module.</p>
<h4 id="PerlX::QuoteOperator">PerlX::QuoteOperator</h4>
<p>Perl has various built-in quote-like operators. <code>qw()</code> constructs arrays; <code>qr()</code> quotes regular expressions and <code>qx()</code> acts like backticks. <a href="https://metacpan.org/module/PerlX::QuoteOperator">PerlX::QuoteOperator</a> allows you to define your own.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">PerlX::QuoteOperator</span> <span class="word">qdeer</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">-with</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="prototype">($)</span> <span class="structure">{</span> <span class="word">Reindeer</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="word">name</span> <span class="operator">=></span> <span class="magic">$_</span><span class="structure">[</span><span class="number">0</span><span class="structure">])</span> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">};</span><br /><br /><span class="keyword">my</span> <span class="symbol">$rudolf</span> <span class="operator">=</span> <span class="word">qdeer</span><span class="structure">(</span><span class="word">Rudolf</span><span class="structure">);</span></code></pre>
<p>PerlX::QuoteOperator uses <a href="https://metacpan.org/module/Devel::Declare">Devel::Declare</a> to rewrite <code>qdeer(...)</code> to <code>qdeer qq(...)</code> while Perl is compiling your code.</p>
<h4 id="Function::Parameters">Function::Parameters</h4>
<p><a href="https://metacpan.org/module/Function::Parameters">Function::Parameters</a> provides parameter lists for Perl subs. Instead of:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">give</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$gift</span><span class="operator">,</span> <span class="symbol">$recipient</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="operator">...</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>You can write:</p>
<pre><code class="code-listing"><span class="word">fun</span> <span class="word">give</span> <span class="structure">(</span><span class="symbol">$gift</span><span class="operator">,</span> <span class="symbol">$recipient</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>It supports named and positional parameters, optional parameters and methods with invocants. It provides an introspection API, and if you're using <a href="https://metacpan.org/module/Moose">Moose</a>, then it can hook into the Moose type constraint system to validate parameter types. Such <code>fun</code>!!</p>
<p>Function::Parameters uses Perl's new(ish) pluggaable keyword API, so is only available for Perl 5.14 and above.</p>
<h4 id="MooseX::Declare">MooseX::Declare</h4>
<p>Where to start? MooseX::Declare gives you <code>class</code> and <code>role</code> keywords for declaring Moose classes and Moose roles; <code>extends</code>, <code>with</code> and <code>is</code> for inhertitance, role composition and meta traits; <code>method</code> for declaring methods with signatures; <code>before</code>, <code>after</code>, <code>around</code>, <code>override</code> and <code>augment</code> for method modifiers; and <code>clean</code> for scrubbing away helper functions so that outside code can't call them.</p>
<pre><code class="code-listing"><span class="word">role</span> <span class="word">Flight</span><br /><span class="structure">{</span><br /> <span class="word">method</span> <span class="word">fly</span> <span class="structure">(</span><span class="word">DateTime</span> <span class="symbol">$when</span><span class="operator">,</span> <span class="word">Location</span> <span class="symbol">$where</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><span class="structure">;</span><br /> <span class="structure">}</span><br /><span class="structure">}</span><br /><br /><span class="word">class</span> <span class="word">MagicReindeer</span> <span class="word">extends</span> <span class="word">Reindeer</span> <span class="word">with</span> <span class="word">Flight</span><br /><span class="structure">{</span><br /> <span class="word">before</span> <span class="word">fly</span> <span class="structure">(</span><span class="word">DateTime</span> <span class="symbol">$when</span><span class="operator">,</span> <span class="word">Location</span> <span class="symbol">$where</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">TimingException</span><span class="operator">-></span><span class="word">throw</span><span class="structure">(</span><span class="double">"not Christmas Eve"</span><span class="structure">)</span><br /> <span class="word">unless</span> <span class="symbol">$when</span><span class="operator">-></span><span class="word">month</span> <span class="operator">==</span> <span class="number">12</span> <span class="operator">&&</span> <span class="symbol">$when</span><span class="operator">-></span><span class="word">day</span> <span class="operator">==</span> <span class="number">24</span><span class="structure">;</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p>It uses Devel::Declare. Extensively. And a partridge in a pear tree.</p>
<h3 id="Bundle-Up">Bundle Up!</h3>
<p>If you're working on a large project with many modules, you may find that you are repeating the same set of imports at the top of almost every file. Perhaps something like:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="version">v5.14</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Try::Tiny</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Scalar::Util</span> <span class="words">qw( blessed )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">List::Util</span> <span class="words">qw( first reduce )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">List::MoreUtils</span> <span class="words">qw( uniq )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Class</span> <span class="words">qw( file dir )</span><span class="structure">;</span></code></pre>
<p>OK, so you can copy and paste, but copy-paste code is the enemy. Don't repeat yourself. Wouldn't it be nice to bundle up all the above functionality into a single module?</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">My::Syntax</span><span class="structure">;</span></code></pre>
<p>Well, here's an example of how you could write that module:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">My::Syntax</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="version">v5.14</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Try::Tiny</span> <span class="words">qw()</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Scalar::Util</span> <span class="words">qw()</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">List::Util</span> <span class="words">qw()</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">List::MoreUtils</span> <span class="words">qw()</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Class</span> <span class="words">qw()</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">import::into</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">import</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$caller</span> <span class="operator">=</span> <span class="word">caller</span><span class="structure">;</span><br /> <span class="word">feature</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="operator">,</span> <span class="single">':5.14'</span><span class="structure">);</span><br /> <span class="word">strict</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="structure">);</span><br /> <span class="word">warnings</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="structure">);</span><br /> <span class="word">Try::Tiny</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="structure">);</span><br /> <span class="word">Scalar::Util</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="operator">,</span> <span class="single">'blessed'</span><span class="structure">);</span><br /> <span class="word">List::Util</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="operator">,</span> <span class="single">'first'</span><span class="operator">,</span> <span class="single">'reduce'</span><span class="structure">);</span><br /> <span class="word">List::MoreUtils</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="operator">,</span> <span class="single">'uniq'</span><span class="structure">);</span><br /> <span class="word">Path::Class</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller</span><span class="operator">,</span> <span class="single">'file'</span><span class="operator">,</span> <span class="single">'dir'</span><span class="structure">);</span><br /><span class="structure">}</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>Alternatively, <a href="https://metacpan.org/module/Syntax::Collector">Syntax::Collector</a> makes it a little neater:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">My::Syntax</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="version">v5.14</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Syntax::Collector</span> <span class="word">-collect</span> <span class="operator">=></span> <span class="literal">q/<br />use strict 1.00 ;<br />use warnings 1.00 ;<br />use feature 1.00 qw( :5.14 );<br />use Try::Tiny 0.11 ;<br />use Scalar::Util 1.23 qw( blessed );<br />use List::Util 1.23 qw( first reduce );<br />use List::MoreUtils 0.33 qw( uniq );<br />use Path::Class 0.26 qw( file dir );<br />/</span><span class="structure">;</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>Yes, that's a big quoted string (<code>q/.../</code>), but no, it's not just <code>eval</code>ed.</p>
<p>Bundling up imports into a single module makes it easier to encourage project-wide coding standards. You can't "forget" to enable warnings any more (but of course you can explicitly unimport it). You no longer have any excuse for using <code>ref</code> when you mean <code>blessed</code>, or <code>grep</code> when you want <code>first</code>.</p>
<p>Bundling up imports allows you to consider ideas like <a href="https://metacpan.org/module/true">true.pm</a> which would seem ridiculous if you needed to repeat them at the top of every file, but become more appealing if they are included as part of an import collection.</p>
<p>And bundling up imports allows you to manage your project's dependencies from a single place. Don't want to depend on List::MoreUtils any more? Then write your own replacement for <code>uniq</code> and get My::Syntax to export that instead. (The Syntax::Collector documentation includes examples of how to write a syntax collection that also acts as an exporter.)</p>
<p>So go on; create your own Perl. Make it your gift to yourself.</p>
<h2 id="SEE-ALSO">SEE ALSO</h2>
<ul>
<li><p><a href="https://metacpan.org/module/List::Util">List::Util</a>, <a href="https://metacpan.org/module/List::MoreUtils">List::MoreUtils</a></p>
</li>
<li><p><a href="https://metacpan.org/module/PerlX::Maybe">PerlX::Maybe</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Syntax::Keyword::Junction">Syntax::Keyword::Junction</a></p>
</li>
<li><p><a href="https://metacpan.org/module/aliased">aliased</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Safe::Isa">Safe::Isa</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Try::Tiny">Try::Tiny</a></p>
</li>
<li><p><a href="https://metacpan.org/module/NEXT">NEXT</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Web::Simple">Web::Simple</a></p>
</li>
<li><p><a href="https://metacpan.org/module/autovivification">autovivification</a></p>
</li>
<li><p><a href="https://metacpan.org/module/PerlX::QuoteOperator">PerlX::QuoteOperator</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Function::Parameters">Function::Parameters</a></p>
</li>
<li><p><a href="https://metacpan.org/module/MooseX::Declare">MooseX::Declare</a></p>
</li>
<li><p><a href="https://metacpan.org/module/import::into">import::into</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Syntax::Collector">Syntax::Collector</a></p>
</li>
</ul>
</div>2012-12-16T00:00:00ZToby InksterGift Wrapping, part II: Locking the Roomhttp://perladvent.org/2012/2012-12-15.html<div class='pod'><p>Continuing on the topic of gift wrapping, another traditional manoeuver to wrap gifts in peace consist on locking yourself in a room (typically, with a sign reading <i>Do Not Enter</i> on the door) as you perform the deed.</p>
<p>With programs, you'll want to do the same thing if your program should only have one instance running at any given time. You want to have a lock file, but then you have to see how arcane things like <code><a href="https://metacpan.org/module/perlfunc#flock">flock</a></code> works, think about cross-platform issues… or, maybe, you could use <a href="https://metacpan.org/module/File::Flock::Tiny">File::Flock::Tiny</a>:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">File::Flock::Tiny</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$lock</span> <span class="operator">=</span> <span class="word">File::Flock::Tiny</span><span class="operator">-></span><span class="word">write_pid</span><span class="structure">(</span><span class="single">'/tmp/bedroom'</span><span class="structure">)</span> <br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"somebody else is hogging the wrapping space already"</span><span class="structure">;</span><br /><br /><span class="word">wrap_presents</span><span class="structure">();</span><br /><br /><span class="comment"># all done<br /></span><span class="symbol">$lock</span><span class="operator">-></span><span class="word">release</span><span class="structure">;</span></code></pre>
<p>Niftier still, it turns out that the above example is overkill, because <code>File::Flock::Tiny</code> will automatically release the lock when its <code>$lock</code> object goes out of scope. Knowing that, the <code>$lock->release</code> line is not necessary. This auto-release trick plays also very nicely with <a href="https://metacpan.org/module/Moose">Moose</a>. Want to have a script with lockfile functionality? Here goes:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Gift::Wrapping</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moose</span><span class="structure">;</span><br /><br /><span class="word">has</span> <span class="word">lockfile</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="single">'ro'</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="single">'Str'</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="single">'/tmp/bedroom'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">lock</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="single">'ro'</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="single">'File::Flock::Tiny::Lock'</span><span class="operator">,</span><br /> <span class="word">lazy</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="word">File::Flock::Tiny</span><span class="operator">-></span><span class="word">write_pid</span><span class="structure">(</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">lockfile</span><span class="structure">)</span> <br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"resource already locked\n"</span><span class="structure">;</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">before</span> <span class="word">gather_presents</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">lock</span><span class="structure">;</span><br /><span class="structure">};</span><br /><br /><span class="operator">...</span><br /><br /><span class="word">__PACKAGE__</span><span class="operator">-></span><span class="word">meta</span><span class="operator">-></span><span class="word">make_immutable</span><span class="structure">;</span><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>With that, your script will judicously lock itself in the bedroom before taking out the presents from their secret place. As soon as the object is done and get out of scope (most likely as the the script terminates), the lock will be automatically removed.</p>
<p>Oh. This being said, check under the bed. Chances are that locking the room, no matter how cleverly, won't help you if your tikes are already hidding under the bed. Just saying…</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/File::Flock::Tiny">File::Flock::Tiny</a></p>
</li>
<li><p><a href="https://metacpan.org/module/perlfunc#flock">flock</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Fcntl">Fcntl</a> (if you must)</p>
</li>
</ul>
</div>2012-12-15T00:00:00ZYanick ChampouxSelf-contained applicationshttp://perladvent.org/2012/2012-12-14.html<div class='pod'><h2 id="In-No-Dependency-Land">In No-Dependency Land</h2>
<p>While the proliferation of solutions like <a href="https://metacpan.org/module/local::lib">local::lib</a> and <a href="https://metacpan.org/module/cpanminus">cpanminus</a> has made it a breeze to manage dependencies, there are still some rare occassions in which we need to be able to ship code that has no external non-core dependencies.</p>
<p>There are a few existing solutions for them, but we're going to concentrate on a new one called <b>FatPacker</b>.</p>
<h2 id="Our-application">Our application</h2>
<p>Of course, we just happen to have a sample application we want to pack. It downloads various pages from our website and compiles a statistics report. It uses <a href="https://metacpan.org/module/HTTP::Tiny">HTTP::Tiny</a> as a user agent. Our application begins with the lines:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">HTTP::Tiny</span><span class="structure">;</span></code></pre>
<p>Our app is, surprisingly, saved as the file <i>ourapp.pl</i>.</p>
<h2 id="Packing-the-deps">Packing the deps</h2>
<p><a href="https://metacpan.org/module/App::FatPacker">App::FatPacker</a> comes with an application called <i>fatpack</i>. You'll use <i>fatpack</i> to get at all of App::FatPacker's features. There are four simple steps for packing your dependencies. Let's go over them.</p>
<h3 id="Tracing">Tracing</h3>
<p>To find out what dependencies our code has, we <code>trace</code> our app. This will create a file called <i>fatpacker.trace</i>, which includes a list of modules that <i>fatpack</i> has discovered.</p>
<pre><code class="code-listing">$ fatpack trace ourapp.pl</code></pre>
<p>In case some modules aren't successfully traced, you can ask <code>fatpack</code> to include them:</p>
<pre><code class="code-listing">$ fatpack trace --use=Additional::Module ourapp.pl</code></pre>
<p>If we open the <i>fatpacker.trace</i> file, we can see it collected a few modules, including both <i>HTTP/Tiny.pm</i> and <i>Carp.pm</i> (which <a href="https://metacpan.org/module/HTTP::Tiny">HTTP::Tiny</a> uses).</p>
<h3 id="Gathering-packlists">Gathering packlists</h3>
<p>Packlists are files that distributions install. They contain information on which modules are included in the distribution. FatPacker needs to find the packlist for each module in order to make sure it includes all dependencies recursively and does not miss anything. One module is likely to use another module, which might use another module in turn, and so on.</p>
<p>We can call <code>packlists-for</code> with a list of modules, or we can feed it the content of the trace output we created with the previous command. It will print out a list of all the packlists, which we'll simply redirect to a file so we can reuse this information.</p>
<pre><code class="code-listing">$ fatpack packlists-for `cat fatpacker.trace` > packlists</code></pre>
<p>The <i>packlists</i> file will include the path to the packlists of <a href="https://metacpan.org/module/Carp">Carp</a> and <a href="https://metacpan.org/module/HTTP::Tiny">HTTP::Tiny</a>.</p>
<h3 id="Forming-the-tree">Forming the tree</h3>
<p>In this step FatPacker collects all the dependencies recursively into a directory called <i>fatlib</i>, which it will then be able to pack together.</p>
<p><code>tree</code> needs a list of packlists. Lucky for us, we saved the packlists that our previous command has found in a file called <i>packlists</i>. Let's just call <code>tree</code> and feed it that file.</p>
<pre><code class="code-listing">$ fatpack tree `cat packlists`</code></pre>
<p>Taking a look at our <i>fatlib</i> directory, we'll see the following structure:</p>
<pre><code> fatlib/
├── Carp
│ └── Heavy.pm
├── Carp.pm
└── HTTP
└── Tiny.pm</code></pre>
<p>You can clearly see it added <a href="https://metacpan.org/module/HTTP::Tiny">HTTP::Tiny</a> and <a href="https://metacpan.org/module/Carp">Carp</a>, but you can also see it added <a href="https://metacpan.org/module/Carp::Heavy">Carp::Heavy</a> which comes with <a href="https://metacpan.org/module/Carp">Carp</a>. This is what recursively copying dependencies means.</p>
<h3 id="Packing-dependencies">Packing dependencies</h3>
<p>Once we have all our dependencies in a directory, we can finally pack it all nicely using the last command: <code>file</code>. This command packs all the modules in the current <i>fatlib</i> directory. It will also try to pack any <i>lib</i> directory that exists in the current directory. If none is present, you will need to create it.</p>
<p>Since the command only packs the modules, we're still missing our code that uses them, so we will concatenate that as well. We will also print this to a new file so we could ship it.</p>
<pre><code class="code-listing">$ (fatpack file; cat ourapp.pl) > ourapp.packed.pl</code></pre>
<p>Stick a shebang line at the top of <i>ourapp.packed.pl</i> and that's all there is to it!</p>
<p>You can now ship <i>ourapp.packed.pl</i> to any location, and it will include all dependencies recursively.</p>
<p>You can open our newly-packed application file and see the way it has packed everything together:</p>
<pre><code class="code-listing"><span class="keyword">BEGIN</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">%fatpacked</span><span class="structure">;</span><br /><br /> <span class="symbol">$fatpacked</span><span class="structure">{</span><span class="double">"Carp.pm"</span><span class="structure">}</span> <span class="operator">=</span> <span class="heredoc"><<'CARP'</span><span class="structure">;</span><br /><span class="heredoc_content"> ... # entire Carp<br /> CARP<br /><br /> $fatpacked{"Carp/Heavy.pm"} = <<'CARP_HEAVY';<br /> ... # entire Carp::Heavy<br /> CARP_HEAVY<br /><br /> $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';<br /> ... # entire HTTP::Tiny<br /> HTTP_TINY<br /><br /> # fixing of @INC to load these<br /> ...<br />} # END OF FATPACK CODE<br />#!perl<br />use strict;<br />use warnings;<br />use HTTP::Tiny;<br /><br /># rest of our code<br />...</span><span class="heredoc_terminator">CARP<br /></span></code></pre>
<h2 id="Its-already-being-used">It's already being used!</h2>
<p>There is at least one famous project which uses this method to create a self-contained program: <a href="https://metacpan.org/module/cpanminus">cpanminus</a> proved this method to be useful for beginners and seasoned system administrators in providing a self-contained full-fledged CPAN client, always available at your finger-tips without any installations required (other than having a Perl interpreter, of course).</p>
<p>You can always download a packed <code>cpanminus</code> program and use it, wherever you are, using the following command:</p>
<pre><code class="code-listing">$ curl -kL cpanmin.us > cpanm<br />$ perl cpanm Some::Module</code></pre>
<h2 id="Caveat">Caveat</h2>
<p>There are some considerations still:</p>
<h3 id="Compile-time-code-will-be-run">Compile time code will be run</h3>
<p>If you have any compile-time code (think <code>BEGIN</code> blocks), they will be run as part of the tracing step. Generally, these aren't recommended for most use cases anyway.</p>
<p>If you have any compile-time code which shouldn't run upon tracing, you might want to consider refactoring it into run-time code.</p>
<h3 id="Lazily-loaded-modules-wont-be-found">Lazily loaded modules won't be found</h3>
<p>Any modules that are loaded lazily (such as <code>require</code> statements) will not be traced successfully. You can, however, provide them as additional modules for the <code>trace</code> command, as described above.</p>
<h3 id="XS-modules-are-not-supported">XS modules are not supported</h3>
<p><a href="https://metacpan.org/module/App::FatPacker">App::FatPacker</a> only supports Pure-Perl modules, so if you're using any XS modules, you'll need to have them installed remotely.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/App::FatPacker">App::FatPacker</a></p>
</li>
</ul>
</div>2012-12-14T00:00:00ZSawyer XTake a little RESThttp://perladvent.org/2012/2012-12-13.html<div class='pod'><p>About six months ago I learned about <a href="https://github.com/micha/resty">resty</a>. I think Stevan Little may have mentioned it in his <a href="https://metacpan.org/module/Web::Machine">Web::Machine</a> talk. Unfortunately <code>resty</code> had problems running in <code>zsh</code>. I initially tried to fix the problem, but then I ported it to Perl instead, which was not only easier but also ended up having a lot of other exciting benfits.</p>
<h2 id="What-even-is-that-thing"><a href="https://www.youtube.com/watch?v=H4w0_n1Yras&t=3m29s">What even is that thing?</a></h2>
<p>Adenosine is a tool that allows you to fiddle with <a href="https://en.wikipedia.org/wiki/Representational_state_transfer">RESTful</a> services easily. The basic gist is that you can use <code>HTTP</code> verbs (<code>POST</code>, <code>PUT</code>, <code>HEAD</code>, <code>GET</code>, <code>OPTIONS</code>, <code>TRACE</code>) directly in your shell. You get the body of the response as stdout, headers and more as stderr if you turn on <code>-v</code>, the exit code is directly related to the error code, and there's a minimal plugin architecture (with more hooks on their way.)</p>
<h2 id="How-do-I-use-it">How do I use it?</h2>
<p>The first thing you need to do with adenosine is to set up your environment to use it:</p>
<pre><code> $ eval $(adenosine exports)</code></pre>
<p>The next thing you need to do is set the base URI. The base URI is just a URI with a <code>*</code> in it. So for example, why don't we start with the DuckDuckGo API. A simple, useful base URI could be set as follows:</p>
<pre><code> $ adenosine 'http://api.duckduckgo.com/?q=*&o=json'</code></pre>
<p>So with that set all you need to do is:</p>
<pre><code> $ GET test | pp</code></pre>
<p>The above will put <code>test</code> into the base URI in place of the <code>*</code>. <a href="https://metacpan.org/module/pp">pp</a> is just a tiny json pretty printer bundled with adenosine.</p>
<p>If you don't specify a URI scheme (<code>http://</code> or <code>https://</code>), your URI will be prepended with <code>http://</code>, and if you don't specify a <code>*</code> it will be appended to your URI.</p>
<p><code>GET</code> isn't all you can do, though it's certainly what <i>I</i> do most often. Here's an example of how I might send a text message with our API at work:</p>
<pre><code class="code-listing">$ adenosine 'http://our.api.com/api/2/*/sms'<br />$ POST myaccount '{"message":"Hello Frew!","destinations":[8675309]}' \<br /> -H 'Content-Type: application/json' -H 'Accept: application/json'</code></pre>
<p>If you want to edit the data you are about to post, use adenosine's <code>-V</code> switch to open your <code>$EDITOR</code>.</p>
<p>There's more in the <a href="https://metacpan.org/module/adenosine">documentation</a>, but that's basically how it works.</p>
<h2 id="Too-much-to-type">Too much to type!</h2>
<p>Sometimes you'll want to set certain headers for a given host. For example, in my previous example I need to set the <code>Content-Type</code> and <code>Accept</code> headers so that my application will do the right thing. I actually <b>always</b> want to set those headers when interacting with my application. The way to do this nicely is to create a configuration file for my server. For example, I could create the following:</p>
<p><i>~/.resty/our.api.com</i>:</p>
<pre><code class="code-listing">POST -H 'Content-Type: application/json' -H 'Accept: application/json'<br />PUT -H 'Content-Type: application/json' -H 'Accept: application/json'<br />DELETE -H 'Content-Type: application/json' -H 'Accept: application/json'<br />GET -H 'Content-Type: application/json' -H 'Accept: application/json'</code></pre>
<p>That will set those two headers for all four of the major HTTP verbs, so the previous example could now be merely:</p>
<pre><code> $ POST myaccount '{"message":"Hello Frew!","destinations":[8675309]}'</code></pre>
<h2 id="Plugins">Plugins</h2>
<p>One of the most exciting new features of adenosine (vs. resty) is that it supports plugins. I initially just wrote two: Stopwatch and Rainbow.</p>
<h3 id="Stopwatch"><code>Stopwatch</code></h3>
<p><code>Stopwatch</code> adds timing info to the output from <code>-v</code>. I like to know how long various commands and requests take, especially when I am the implementor of said command. If something takes longer than 0.5s, I did a bad job. So <code>Stopwatch</code> gives me exactly what information I need to know. To enable it put the following in <i>~/.adenosinerc.yml</i>:</p>
<pre><code class="code-listing"><span class="synIdentifier">plugins</span><span class="synSpecial">:</span><br /> <span class="synStatement">- </span>::Stopwatch</code></pre>
<h3 id="Rainbow"><code>Rainbow</code></h3>
<p><code>Rainbow</code> color codes the output from <code>-v</code>. I really like this, but obviously it's not for everyone. At the most basic, you can enable it the same way that you enable <code>Stopwatch</code>, but that just gives you the most basic color coding. <code>Rainbow</code> is implemented to be easily themable as well as overridable. If you just wanted to override the color of the method from the request, put the following in <i>~/.adenosinerc.yml</i>:</p>
<pre><code class="code-listing"><span class="synIdentifier">plugins</span><span class="synSpecial">:</span><br /> <span class="synStatement">- </span><span class="synIdentifier">::Rainbow</span><span class="synSpecial">:</span> <span class="synSpecial">{</span><br /> <span class="synIdentifier">request_method_color</span><span class="synSpecial">:</span> cyan<br /> <span class="synSpecial">}</span></code></pre>
<p>That's fine for experimentation, but I'd like to encourage everyone to make their own themes and submit them as pull requests. To make a theme, all you need to do is create a file as follows:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">App::Adenosine::Plugin::Rainbow::Halloween</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moo</span><span class="structure">;</span><br /><span class="word">extends</span> <span class="single">'App::Adenosine::Plugin::Rainbow'</span><span class="structure">;</span><br /><span class="word">has</span> <span class="single">'+response_header_colon_color'</span> <span class="operator">=></span> <span class="structure">(</span><span class="word">default</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="single">''</span> <span class="structure">});</span><br /><span class="word">has</span> <span class="single">'+response_header_name_color'</span> <span class="operator">=></span> <span class="structure">(</span><span class="word">default</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="single">'orange1'</span> <span class="structure">});</span><br /><span class="word">has</span> <span class="single">'+response_header_value_color'</span> <span class="operator">=></span> <span class="structure">(</span><span class="word">default</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="single">'orange2'</span> <span class="structure">});</span><br /><span class="comment"># ...</span></code></pre>
<p><code>Rainbow</code> uses <a href="https://metacpan.org/module/Term::ExtendedColor">Term::ExtendedColor</a>, so to see what colors are available run the <code>color_matrix</code> script that comes with it. Also note that while in the example above only a single color is specified, the foreground, backround, and even a few other (spottily supported) attributes may be set:</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="single">'+response_header_value_color'</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="structure">{</span><br /> <span class="word">fg</span> <span class="operator">=></span> <span class="single">'orange2'</span><span class="operator">,</span><br /> <span class="word">bg</span> <span class="operator">=></span> <span class="single">'cyan'</span><span class="operator">,</span> <span class="comment"># what a bad choice</span><br /> <span class="word">bold</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">italic</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">underline</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="structure">}</span><br /> <span class="structure">}</span><br /><span class="structure">);</span></code></pre>
<p>Once you've done that, your <i>~/.adenosinerc.yml</i> can reference your theme directly:</p>
<pre><code class="code-listing"><span class="synIdentifier">plugins</span><span class="synSpecial">:</span><br /> <span class="synStatement">- </span>::Rainbow::Halloween<br /> <span class="synStatement">- </span>::Stopwatch</code></pre>
<p>…and that's adenosine! Please play with it and let me know if you like it!</p>
<h2 id="Installing-adenosine-without-CPAN">Installing <code>adenosine</code> without CPAN</h2>
<p>Most readers of this article are likely to be comfortable installing adenosine from the CPAN, but if you don't want to use CPAN, or you somehow got to this post as a non-<a href="http://en.wikipedia.org/wiki/Just_another_Perl_hacker">japh</a>, this might be more your speed:</p>
<pre><code> git clone http://github.com/frioux/app-adenosine-prefab
source app-adenosine-prefab/adenosine-exports</code></pre>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/adenosine">adenosine</a></p>
</li>
<li><p><a href="https://github.com/micha/resty">resty</a></p>
</li>
</ul>
</div>2012-12-13T00:00:00ZArthur Axel "fREW" SchmidtTesting networking client code using Test::LWP::UserAgenthttp://perladvent.org/2012/2012-12-12.html<div class='pod'><p><a href="https://metacpan.org/module/Test::LWP::UserAgent">Test::LWP::UserAgent</a> is a module I wrote after writing several networking client libraries for <code>$work</code> with inconsistent and spotty test coverage — what I most wanted to do was fully simulate the server end of a network connection, without having to delve deeply into <a href="https://metacpan.org/module/LWP">LWP</a>'s internal implementation, nor mock a lot of methods, which the traditional mock object approach would require.</p>
<p>Exploring the options available led me to Yury Zavarin's <a href="https://metacpan.org/module/Test::Mock::LWP::Dispatch">Test::Mock::LWP::Dispatch</a>, whose API I adapted into the initial version of <a href="https://metacpan.org/module/Test::LWP::UserAgent">Test::LWP::UserAgent</a>. It behaves exactly like <a href="https://metacpan.org/module/LWP::UserAgent">LWP::UserAgent</a>, one of the most popular HTTP client libraries in perl, in all respects except for the portion that actually sends the request out to the network - at that point it returns the first response that you have preconfigured that matches the outbound request.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$useragent</span> <span class="operator">=</span> <span class="word">Test::LWP::UserAgent</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><span class="symbol">$useragent</span><span class="operator">-></span><span class="word">map_response</span><span class="structure">(</span><span class="regexp">qr/example.com/</span><span class="operator">,</span> <span class="word">HTTP::Response</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="number">200</span><span class="structure">));</span><br /><br /><span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$useragent</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><span class="single">'http://example.com'</span><span class="structure">);</span><br /><span class="comment"># prints 200<br /></span><span class="word">say</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">code</span><span class="structure">;</span><br /><br /><span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$useragent</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><span class="single">'http://google.com'</span><span class="structure">);</span><br /><span class="comment"># prints 404<br /></span><span class="word">say</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">code</span><span class="structure">;</span></code></pre>
<p>In the above example, no outbound reqest passing through this user agent will use the live network (this is the default behaviour). Any request whose URI matches <code>/example.com/</code> will receive an HTTP 200 response, and the remaining requests will return a 404.</p>
<p>If, however, you wish to capture only some requests, while letting the remainder use the network normally, you can enable the <code>network_fallback</code> feature:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$useragent</span> <span class="operator">=</span> <span class="word">Test::LWP::UserAgent</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><span class="symbol">$useragent</span><span class="operator">-></span><span class="word">network_fallback</span><span class="structure">(</span><span class="number">1</span><span class="structure">);</span><br /><span class="symbol">$useragent</span><span class="operator">-></span><span class="word">map_response</span><span class="structure">(</span><span class="regexp">qr/example.com/</span><span class="operator">,</span> <span class="word">HTTP::Response</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="number">200</span><span class="structure">));</span><br /><br /><span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$useragent</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><span class="single">'http://example.com'</span><span class="structure">);</span><br /><span class="comment"># prints 200<br /></span><span class="word">say</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">code</span><span class="structure">;</span><br /><br /><span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$useragent</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><span class="single">'http://google.com'</span><span class="structure">);</span><br /><span class="comment"># prints 200 … if Google is up!<br /></span><span class="word">say</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">code</span><span class="structure">;</span></code></pre>
<p>And indeed if you inspect the <code>$response</code> object returned, you will see that it contains the actual network response from contacting <a href="http://google.com">http://google.com</a>.</p>
<p>Configuration can also be done globally, if you want all user agents in your program to use the same settings (or if you do not have direct control over the actual user agent object being used, but just its class):</p>
<pre><code class="code-listing"><span class="word">Test::LWP::UserAgent</span><span class="operator">-></span><span class="word">map_response</span><span class="structure">(</span><span class="operator">...</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="word">Test::LWP::UserAgent</span><span class="operator">-></span><span class="word">new</span><span class="operator">-></span><span class="word">request</span><span class="structure">(</span><span class="operator">...</span><span class="structure">);</span></code></pre>
<p><a href="https://metacpan.org/module/Test::LWP::UserAgent">Test::LWP::UserAgent</a> inherits from <a href="https://metacpan.org/module/LWP::UserAgent">LWP::UserAgent</a>, so it satisfies <code>isa</code> requirements that you may have via <a href="https://metacpan.org/module/Moose">Moose</a> or another system that uses type checking. This means that all the normal options available in <a href="https://metacpan.org/module/LWP::UserAgent">LWP::UserAgent</a> are still available to you, and work identically, for example:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$useragent</span> <span class="operator">=</span> <span class="word">Test::LWP::UserAgent</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">timeout</span> <span class="operator">=></span> <span class="number">10</span><span class="operator">,</span><br /> <span class="word">cookie_jar</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">file</span> <span class="operator">=></span> <span class="double">"$ENV{HOME}/.cookies.txt"</span> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>You can also use <a href="https://metacpan.org/module/Test::LWP::UserAgent">Test::LWP::UserAgent</a> to connect to a local <a href="https://metacpan.org/module/PSGI">PSGI</a> application seamlessly, which can be very useful when you have a client and server installed on the same box but do not want to fuss with separate code for handling this case, or if you want more fine-grained control over what responses to send:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="word">Plack::Util::load_psgi</span><span class="structure">(</span><span class="single">'./myapp.psgi'</span><span class="structure">);</span><br /><span class="symbol">$useragent</span><span class="operator">-></span><span class="word">register_psgi</span><span class="structure">(</span><span class="single">'mytestdomain.com'</span><span class="operator">,</span> <span class="symbol">$app</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$useragent</span><span class="operator">-></span><span class="word">request</span><span class="structure">(</span><span class="operator">...</span><span class="structure">);</span></code></pre>
<h2 id="CODE-EXAMPLES">CODE EXAMPLES</h2>
<p>The code examples above are fleshed out as fully-working code in the examples/ directory under <a href="http://metacpan.org/release/Test-LWP-UserAgent">http://metacpan.org/release/Test-LWP-UserAgent</a>, along with a detailed example of some unit tests for a hypothetical networking client library.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Test::LWP::UserAgent">Test::LWP::UserAgent</a></p>
</li>
<li><p><a href="https://metacpan.org/module/LWP::UserAgent">LWP::UserAgent</a></p>
</li>
</ul>
</div>2012-12-12T00:00:00ZKaren EtheridgeMaking a list and checking it twicehttp://perladvent.org/2012/2012-12-11.html<div class='pod'><p>Poor Santa. It's getting close to Christmas, and he still hasn't made his list of CPAN authors yet! Who will get coal? Who will get a present?</p>
<p>With the clock ticking, he decides to automate his list building with Perl, but still needs to check it twice.</p>
<p>Santa doesn't need a GUI, he likes the terminal just fine, so he's going to write a program to decide if the CPAN authors are naughty or nice and then prompt him to confirm each one.</p>
<p>How should he prompt? He likes the nice simple prompt of ExtUtils::MakeMaker, should he use it?</p>
<pre><code> $ perl -MExtUtils::MakeMaker -wE 'prompt("Naughy?", "yes")'
Naughty? [yes]</code></pre>
<p>Loading all of ExtUtils::MakeMaker just to get a prompt is just a little bit gross, so maybe he can do better. Next stop… CPAN!</p>
<p>So many prompting modules to choose from… (sigh)… the usual problem with CPAN. But wait, look! A "Tiny" module, and it works <b>exactly</b> like ExtUtils::MakeMaker… <a href="https://metacpan.org/module/IO::Prompt::Tiny">IO::Prompt::Tiny</a>.</p>
<p>Santa decides to give it a try:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="version">v5.14</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">File::Slurp</span> <span class="words">qw/write_file/</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">IO::Prompt::Tiny</span> <span class="words">qw/prompt/</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">ORDB::CPANUploads</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Time::Piece</span><span class="structure">;</span><br /><br /><span class="comment"># Find each CPAN author's latest release date<br /># If they didn't release in 2012, let's call them naughty<br /></span><span class="keyword">my</span> <span class="symbol">$results</span> <span class="operator">=</span> <span class="word">ORDB::CPANUploads</span><span class="operator">-></span><span class="word">selectall_arrayref</span><span class="structure">(</span><br /> <span class="single">'select author, max(released) from uploads group by author'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="comment"># Make a list<br /></span><span class="keyword">my</span> <span class="symbol">%list</span><span class="structure">;</span><br /><br /><span class="keyword">for</span> <span class="keyword">my</span> <span class="symbol">$author</span> <span class="structure">(</span><span class="cast">@</span><span class="symbol">$results</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$id</span> <span class="operator">=</span> <span class="symbol">$author</span><span class="operator">-></span><span class="structure">[</span><span class="number">0</span><span class="structure">];</span><br /> <span class="keyword">my</span> <span class="symbol">$date</span> <span class="operator">=</span> <span class="word">gmtime</span><span class="structure">(</span> <span class="symbol">$author</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="structure">);</span><br /><br /><span class="comment"> # Check it once<br /></span> <span class="keyword">my</span> <span class="symbol">$prompt</span> <span class="operator">=</span> <span class="word">sprintf</span><span class="structure">(</span> <span class="double">"\n%-9s released on %s. Naughty? (yes/no)"</span><span class="operator">,</span> <span class="symbol">$id</span><span class="operator">,</span> <span class="symbol">$date</span> <span class="structure">);</span><br /> <span class="keyword">my</span> <span class="symbol">$ans</span> <span class="operator">=</span> <span class="word">prompt</span><span class="structure">(</span> <span class="symbol">$prompt</span><span class="operator">,</span> <span class="symbol">$date</span><span class="operator">-></span><span class="word">year</span> <span class="operator"><</span> <span class="number">2012</span> <span class="operator">?</span> <span class="double">"yes"</span> <span class="operator">:</span> <span class="double">"no"</span> <span class="structure">);</span><br /> <span class="symbol">$list</span><span class="structure">{</span><span class="symbol">$id</span><span class="structure">}</span> <span class="operator">=</span> <span class="structure">(</span> <span class="symbol">$ans</span> <span class="operator">=~</span> <span class="match">/^y/i</span> <span class="operator">?</span> <span class="double">"naughty"</span> <span class="operator">:</span> <span class="double">"nice"</span> <span class="structure">);</span><br /><br /><span class="comment"> # Check it twice<br /></span> <span class="keyword">my</span> <span class="symbol">$check</span> <span class="operator">=</span> <span class="word">prompt</span><span class="structure">(</span> <span class="double">"Are you sure $id is $list{$id}? (yes/no)"</span><span class="operator">,</span> <span class="double">"yes"</span> <span class="structure">);</span><br /> <span class="word">redo</span> <span class="word">unless</span> <span class="symbol">$check</span> <span class="operator">=~</span> <span class="match">/^y/i</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="word">write_file</span><span class="structure">(</span><br /> <span class="single">'list.txt'</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">atomic</span> <span class="operator">=></span> <span class="number">1</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">map</span> <span class="structure">{</span> <span class="double">"$_ is $list{$_}\n"</span> <span class="structure">}</span> <span class="word">sort</span> <span class="word">keys</span> <span class="symbol">%list</span><br /><span class="structure">);</span></code></pre>
<p>Excellent, now he's ready to make his list and find all those naughty CPAN authors who haven't released in 2012:</p>
<pre><code> $ perl naughty-or-nice.pl
AADLER released on Sun Feb 13 20:32:59 2011. Naughty? (yes/no) [yes]
Are you sure AADLER is naughty? (yes/no) [yes]
AAKD released on Wed Nov 9 06:26:08 2005. Naughty? (yes/no) [yes]
Are you sure AAKD is naughty? (yes/no) [yes]
AAKHTER released on Thu Nov 10 03:18:33 2005. Naughty? (yes/no) [yes]
Are you sure AAKHTER is naughty? (yes/no) [yes]
AALLAN released on Fri Nov 17 20:44:54 2006. Naughty? (yes/no) [yes]
Are you sure AALLAN is naughty? (yes/no) [yes]
AANOAA released on Sat Feb 12 09:10:34 2011. Naughty? (yes/no) [yes]
Are you sure AANOAA is naughty? (yes/no) [yes]
AAR released on Sun Mar 11 19:50:00 2012. Naughty? (yes/no) [no]
Are you sure AAR is nice? (yes/no) [yes]
AARDEN released on Wed Apr 30 16:19:59 2003. Naughty? (yes/no) [yes]
Are you sure AARDEN is naughty? (yes/no) [yes]
⋮
ZWON released on Thu Sep 1 15:21:14 2011. Naughty? (yes/no) [yes] yes
Are you sure ZWON is naughty? (yes/no) [yes] yes
ZZZ released on Tue Aug 16 17:05:53 2011. Naughty? (yes/no) [yes] yes
Are you sure ZZZ is naughty? (yes/no) [yes] yes</code></pre>
<p>After bouncing on the return key almost 12,000 times, Santa is ready for Christmas on CPAN!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/IO::Prompt::Tiny">IO::Prompt::Tiny</a></p>
</li>
<li><p><a href="https://metacpan.org/module/IO::Prompt::Hooked">IO::Prompt::Hooked</a> - a handy, minimalist validation wrapped around IO::Prompt::Tiny</p>
</li>
<li><p><a href="https://metacpan.org/module/IO::Prompter">IO::Prompter</a> - a feature-packed all-singing all-dancing bit of Damianware</p>
</li>
<li><p>IO::Prompter::Tinier - not yet written</p>
</li>
</ul>
</div>2012-12-11T00:00:00ZDavid GoldenThe Greatest Tradition of Allhttp://perladvent.org/2012/2012-12-10.html<div class='pod'><p>The Holidays. No time in the calendar can boast a higher density of traditions per diem than this glorious tail end of the year. But amidst this gleefull storm of traditions dealing with the culinary, the jocose, the social, one particularly stands out for being almost universally observed.</p>
<p>I'm talking about the hallowed ritual of returning presents.</p>
<p>This problem, funnily enough, isn't restricted to packages that come with bows and glitter. Perl distributions, historically, don't come with a return policy. That is, once distribution <code>Foo-Bar</code> is installed, it stays installed. Like aunt Thelma's pan-chromatic acrylic sweater, it would linger at the back of the closet -- dusty, unused and untouched by more-discriminating-than-that moths, an immutable testament that taste isn't a trait passed through genetic lines. Which usually isn't such a big problem: computers usually have deep closet spaces.</p>
<h2 id="When-Gifts-Turn-to-Time-Bombs">When Gifts Turn to Time-Bombs</h2>
<p>There are, however, a few cases where that lingering can cause issues. The most common is when those ghosts of installation pasts interfere with the current festivities.</p>
<p>For example, if version 1 of the distribution <code>Holidays-Activities</code> contains</p>
<pre><code> /lib/Holidays/Activities/SingSongs.pm
/lib/Holidays/Activities/BeMerry.pm
/lib/Holidays/Activities/MeetFriends.pm
/lib/Holidays/Activities/DressUpAsElf.pm</code></pre>
<p>and version 2, after realising that tights, bell-adorned curly slippers and short skirts aren't for everybody, revises its payload to be:</p>
<pre><code> /lib/Holidays/Activities/SingSongs.pm
/lib/Holidays/Activities/BeMerry.pm
/lib/Holidays/Activities/MeetFriends.pm
/lib/Holidays/Activities/DressUpAsSanta.pm</code></pre>
<p>then somebody first installing version 1, and then version 2, will end up with some of last year's leftovers, so to speak:</p>
<pre><code> /lib/Holidays/Activities/SingSongs.pm
/lib/Holidays/Activities/BeMerry.pm
/lib/Holidays/Activities/MeetFriends.pm
/lib/Holidays/Activities/DressUpAsElf.pm
/lib/Holidays/Activities/DressUpAsSanta.pm</code></pre>
<p>Yet, this is still not guaranteed to cause problem. If the <code>Holidays-Activities</code> modules are called piecemeal, nobody with a lick of good sense will ever call <code>use Holidays::Activities::DressUpAsElf</code>, and everybody's eyeballs will be spared. But if, say, <code>Holidays::Activities</code> use a snazzy module like <a href="https://metacpan.org/module/Module::Pluggable">Module::Pluggable</a> to find all the activities one needs to do during those merry times:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Holidays::Activities</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Module::Pluggable</span><br /> <span class="word">search_path</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'Holidays::Activities'</span><span class="structure">]</span><span class="operator">,</span><br /> <span class="word">require</span> <span class="operator">=></span> <span class="number">1</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">celebrate</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="magic">$_</span><span class="operator">-></span><span class="word">perform</span><span class="structure">(</span><span class="symbol">$self</span><span class="structure">)</span> <span class="word">for</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">plugins</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="operator">...</span></code></pre>
<p><b>BAM!</b> We end up with a user sporting tights, a cheerfully rotund pot-belly, lots of facial hair and a pointy nose. That sound you're hearing in your head? That's the screams of millions of children for whom the Holidays will never be the same.</p>
<h2 id="Ghost-Of-Installs-Yet-To-Come-Give-Me-a-Chance">Ghost Of Installs Yet To Come, Give Me a Chance!</h2>
<p>Fortunately, all is not lost. As it happens, most modern CPAN clients provide a little-known-yet-handy stash of Pepto-Bismol alongside the milk and cookies: the installation of a distribution will also include a <i>.packlist</i> file listing all installed files (the modules, the scripts, the manpages, the whole deal). For example, for a <code>Dist::Zilla</code> installed in <i>/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla.pm</i>, a <i>.packlist</i> will be created in <i>/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/x86_64-linux/auto/Dist/Zilla/.packlist</i> and will look like:</p>
<pre><code> /opt/perlbrew/perls/perl-5.16.1/bin/dzil
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla.pm
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla/App.pm
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla/App/Command.pm
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla/App/Command/add.pm
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla/App/Command/authordeps.pm
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla/App/Command/build.pm
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla/App/Command/clean.pm
/opt/perlbrew/perls/perl-5.16.1/lib/site_perl/5.16.1/Dist/Zilla/App/Command/install.pm
... and so on, and so forth ...</code></pre>
<p>Word of caution: there are some instances where those <i>.packlist</i> will be missing. Some Linux distributions, belonging squarely on the <b>naughty</b> list, don't include them in their packaging of perl distributions. It's also possible, if you still celebrate the Saturnalia and run on a pre-modern era perl, that you won't have them.</p>
<h2 id="Are-the-Batteries-Included-With-That-Toy">Are the Batteries Included With That Toy?</h2>
<p>Partially. If one dig deeps in the <a href="https://metacpan.org/module/Module::Build::Cookbook">lore of Module::Build</a>, one would find an almost-undocumented <code>--uninst</code> option that stands for exactly what you think. So it's possible to do, during a manual installation dance:</p>
<pre><code> perl Build.PL
./Build test
./Build install --uninst 1</code></pre>
<p><a href="https://metacpan.org/module/ExtUtils::MakeMaker">ExtUtils::MakeMaker</a> also offer a similar command:</p>
<pre><code> perl Makefile.Pl
make test
make UNINST=1</code></pre>
<p>As was <a href="http://blogs.perl.org/users/joel_berger/2012/11/rfc-modulebuildcleaninstall.html">discussed recently</a>, however, both systems seem to have issues. And, beside, while a mechanism is offered, it puts the onus of cleaning the leftover of past parties to the user. <i>Manual cleaning</i>, to boot. Hardly optimal.</p>
<h2 id="We-Need-the-Help-of-Elves-just-skip-the-tights-please">We Need the Help of Elves (just skip the tights, please)</h2>
<p>Fairly recently, <a href="https://metacpan.org/module/Module::Build::CleanInstall">Module::Build::CleanInstall</a> made its appearance to help with this problem. This module is a subclass of <a href="https://metacpan.org/module/Module::Build">Module::Build</a> that simply adds an automatic uninstallation of previous versions of a distribution (provided that the <i>.packlist</i> file is found) before doing the new install. Its usage couldn't be simplier: change all mention of Module::Build to Module::Build::CleanInstall in the <i>Build.PL</i>:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Module::Build::CleanInstall</span><span class="structure">;</span><br /><br /><span class="word">Module::Build::CleanInstall</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">dist_name</span> <span class="operator">=></span> <span class="double">"Holidays-Activities"</span><span class="operator">,</span><br /> <span class="operator">...</span> <span class="comment"># same as Module::Build</span><br /><span class="structure">)</span><span class="operator">-></span><span class="word">create_build_script</span><span class="structure">;</span></code></pre>
<p>and you're good to go (just don't forget to add Module::Build::CleanInstall as a build dependency in your distribution <i>META.json</i> or <i>META.yml</i>).</p>
<p>A different solution has also emerged for the special case of <a href="https://metacpan.org/module/File::ShareDir">File::ShareDir</a>-based shared files. Instead of trying to remove past files, this approach proposes to bundle all shared files in a single tarball. As the name of the tarball remains the same from one version to the next, one is thus assured that the new file will always clobber its previous incarnation. And the space saving brought by the compression could easily be seen as a nice dollop of whipped cream atop an already appealing hot cocoa. Of course, for the author, dealing with the tarballing of the shared files at release time, and handling their uncompression in the code is one more fixing that must be added to the already extensive work-feast that is release management. And that is why two modules have been created to help there: <a href="https://metacpan.org/module/Dist::Zilla::Plugin::ShareDir::Tarball">Dist::Zilla::Plugin::ShareDir::Tarball</a> auto-tarballs share directories at release time (provided that you use <a href="https://metacpan.org/module/Dist::Zilla">Dist::Zilla</a>, natch):</p>
<pre><code class="code-listing"><span class="synComment">; in your dist.ini file</span><br /><br /><span class="synSpecial">[ShareDir]</span><br /><span class="synSpecial">[ShareDir::Tarball]</span></code></pre>
<p>and <a href="https://metacpan.org/module/File::ShareDir::Tarball">File::ShareDir::Tarball</a> takes care of that pesky extraction business for you, and transparently provides the user with the extracted temporary directory/files.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">File::ShareDir::Tarball</span> <span class="single">':all'</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$dir</span> <span class="operator">=</span> <span class="word">dist_dir</span><span class="structure">(</span><span class="single">'Holidays-Activities'</span><span class="structure">);</span><br /><span class="comment"># $dir is now the path to a temporary directory holding<br /># the extracted content of the shared files tarball</span></code></pre>
<h2 id="Aunts-Will-Be-Aunts-Garish-Sweaters-Will-Still-Pop-Up">Aunts Will Be Aunts, Garish Sweaters Will Still Pop Up</h2>
<p>... but at least now we have a few more venues to quietly deal with those presents once the party is over. And this is good, for a sage once said</p>
<pre><code> "To receive is pleasure, and to give is higher pleasure still. But to
give back and get what you really wanted all along with a minimum of fuss
and without waiting in line with your coat on and screaming brats right
behind you for hours on end is the greatest pleasure of
them all."</code></pre>
<p>Or something like that. I might be paraphrasing.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/File::ShareDir::Tarball">File::ShareDir::Tarball</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Dist::Zilla::Plugin::ShareDir::Tarball">Dist::Zilla::Plugin::ShareDir::Tarball</a></p>
</li>
</ul>
</div>2012-12-10T00:00:00ZYanick ChampouxFixing the regexep code block facilityhttp://perladvent.org/2012/2012-12-09.html<div class='pod'><p>The <code>/(?{})/</code> code-execution facility was added to regular expressions back in 1998, in the 5.005 release. Since then it's been sitting there, marked experimental, until in 2012, the implementation was completely re-written for the 5.17.1 release.</p>
<p>The way it originally worked was that during regex compilation, if an opening <code>(?{</code> was seen, the balancing <code>}</code> was found, and the text between the braces was passed to perl's internal eval mechanism. But after compiling the code, the execution was skipped, and instead the optree and pad of the compiled eval were saved and attached to the regexp object. Later when the regexp was being executed, the current pad would be set to the saved pad, and the ops in the optree called.</p>
<p>So, what's wrong with that?</p>
<p>Well, everything really.</p>
<p>First, at the most trivial level, the code isn't properly parsed, so something like <code>/(?{ $x = '{' })/</code> is an error, due the simplistic counting of balancing braces. This is in contrast to something like <code>"foo$hash{ $x ? '{' : '[' }bar"</code>, where the expression for the hash index doesn't require balanced braces.</p>
<pre><code class="code-listing"><span class="match">/(?{ $x = '{' })/</span> <span class="comment"># <-- was an error</span><br /><br /><span class="double">"foo$hash{ $x ? '{' : '[' }bar"</span> <span class="comment"># <-- not an error</span></code></pre>
<p>So the first change was to integrate the parsing of the code blocks with the parsing of the surrounding Perl code, at least for literal regexes.</p>
<p>The second big issue was that by just saving the <a href="https://metacpan.org/module/perlglossary#scratchpad">pad</a> and resurrecting it from time to time, lexicals at best did the wrong thing, and at worst caused segfaults. In particular, the behaviour of closures didn't match reasonable expectations. For example, this code:</p>
<pre><code class="code-listing"><span class="keyword">for</span> <span class="keyword">my</span> <span class="symbol">$i</span> <span class="structure">(</span><span class="number">0</span><span class="operator">..</span><span class="number">2</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">push</span> <span class="symbol">@r</span><span class="operator">,</span> <span class="regexp">qr/^(??{$i})$/</span><span class="structure">;</span><br /><span class="structure">}</span><br /><span class="word">print</span> <span class="double">"ok 0\n"</span> <span class="word">if</span> <span class="double">"0"</span> <span class="operator">=~</span> <span class="symbol">$r</span><span class="structure">[</span><span class="number">0</span><span class="structure">];</span><br /><span class="word">print</span> <span class="double">"ok 1\n"</span> <span class="word">if</span> <span class="double">"1"</span> <span class="operator">=~</span> <span class="symbol">$r</span><span class="structure">[</span><span class="number">1</span><span class="structure">];</span><br /><span class="word">print</span> <span class="double">"ok 2\n"</span> <span class="word">if</span> <span class="double">"2"</span> <span class="operator">=~</span> <span class="symbol">$r</span><span class="structure">[</span><span class="number">2</span><span class="structure">];</span></code></pre>
<p>prints out three ok's now, but formerly printed nothing. It works because in terms of pads, closures, etc, these:</p>
<pre><code class="code-listing"><span class="match">/A(?{B})C/</span><span class="structure">;</span><br /><span class="symbol">$r</span> <span class="operator">=</span> <span class="regexp">qr/A(?{B})C/</span><span class="structure">;</span></code></pre>
<p>(where B is a block of code) are now parsed (in terms of lexicals) roughly as:</p>
<pre><code class="code-listing"><span class="match">/A/</span> <span class="operator">&&</span> <span class="word">do</span> <span class="structure">{</span><span class="word">B</span><span class="structure">}</span> <span class="operator">&&</span> <span class="match">/C/</span><span class="structure">;</span><br /><span class="symbol">$r</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="match">/A/</span> <span class="operator">&&</span> <span class="word">do</span> <span class="structure">{</span><span class="word">B</span><span class="structure">}</span> <span class="operator">&&</span> <span class="match">/C/</span> <span class="structure">};</span></code></pre>
<p>That is, in the first line, the code block shares the same pad as the surrounding code, while in the second example it uses the pad of a hidden anonymous sub, which is cloned anew on each call to <code>qr//</code>. This makes it all Just Do the Right Thing. <code>qr//</code> constructs that contain arbitrary code now act like closures.</p>
<p>However, Perl also supports patterns that are determined at runtime, or which contain a mixture of compile- and runtime patterns, such as</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$pat</span> <span class="operator">=</span> <span class="single">'C(?{D})'</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">re</span> <span class="single">'eval'</span><span class="structure">;</span><br /><span class="match">/A(?{B})-$pat/</span><span class="structure">;</span></code></pre>
<p>Formerly, as the run-time pattern was being assembled, any bits of literal code (such as the <code>B</code> above) would be recompiled, destroying any closure information. Now, such code snippets are preserved, and only the non-literal bits are compiled. Similarly where regexp objects are included within a larger pattern:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$re</span> <span class="operator">=</span> <span class="regexp">qr/C(?{D})/</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">re</span> <span class="single">'eval'</span><span class="structure">;</span><br /><span class="match">/A(??{B})-$re/</span><span class="structure">;</span></code></pre>
<p>Although the text of the <code>$re</code> pattern is interpolated and recompiled, any code blocks within <code>$re</code> are <i>not</i> recompiled.</p>
<p>Finally, because pads are handled properly now, things don't go awry during recursion:</p>
<pre><code class="code-listing"><span class="comment"># test-recurse-regex.pl<br /></span><span class="keyword">sub</span> <span class="word">recurse</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$n</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="word">if</span> <span class="symbol">$n</span> <span class="operator">></span> <span class="number">2</span><span class="structure">;</span><br /> <span class="word">print</span> <span class="double">"ok\n"</span> <span class="word">if</span> <span class="double">"A$n"</span> <span class="operator">=~</span> <span class="match">/^A(??{$n})$/</span><span class="structure">;</span><br /> <span class="word">recurse</span><span class="structure">(</span><span class="symbol">$n</span><span class="operator">+</span><span class="number">1</span><span class="structure">);</span><br /><span class="structure">}</span><br /><span class="word">recurse</span><span class="structure">(</span><span class="number">0</span><span class="structure">);</span></code></pre>
<p>…and then…</p>
<pre><code class="code-listing">$ perl test-recurse-regex.pl<br />ok<br />ok<br />ok</code></pre>
<p>There were lots of other subtleties involved, but those are the ones I can think of off the top my head. These bugs made the entire <code>(?{})</code> and <code>(??{})</code> features unreliable in earlier perls, but with the upcoming perl 5.18 release, it should work sanely and predictably!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/perlre#code">code in regex</a></p>
</li>
<li><p><a href="https://metacpan.org/module/perlre#code-1">postponed regex</a></p>
</li>
<li><p><a href="https://metacpan.org/module/re#eval-mode">regex 'eval' mode</a></p>
</li>
</ul>
</div>2012-12-09T00:00:00ZDave MitchellAtomic Gift Wrappinghttp://perladvent.org/2012/2012-12-08.html<div class='pod'><p>Gift wrapping. You rarely want to do it by the Christmas Tree because you know, you just <b>know</b> that just when you're in the middle of wrapping that huge <i>Dino-Rampage Total Combat Battlezone</i> box, one of your child processes will innocently try to access the living room resources, see the half-ready present, go totally ape-boinker, and make every single day till Christmas a grueling hell. So instead, you usually wrap the presents in some dark corner of the house — usually the attic, the shed, or the secret room you built specifically for that purpose. Then, when the pile o' prezzies is ready, you carefully peek out in the hallway, make sure there is no living being in sight, rush down the stairs holding the loot with every prehensible limb available, and dump the whole thing under the tree. When the amazed kids ask how the glittery boxes got there? Well… <i>Magic</i>.</p>
<p>Atomic file writing? Exactly the same thing.</p>
<p>Most of the time, you can write files at your leisure, but sometimes you have other programs that can access it at any time, and you don't want them to end up bits and pieces. So you either begin to play with locking the file ("No one enter the room until I'm done!") or you write the new file in a different place, and when everything is ready, you do a quick switcheroo where you replace the old copy with its new incarnation. There is still a window where things can go wrong, but it's a minimal one.</p>
<p>Of course, the switcheroo is much easier (and funnier) to say than to do. That is, unless you use <a href="https://metacpan.org/module/File::AtomicWrite">File::AtomicWrite</a>, which takes care of all the nitty gritty details for you. To wit:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">File::AtomicWrite</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$present_list</span> <span class="operator">=</span> <span class="word">File::AtomicWrite</span><span class="operator">-></span><span class="word">new</span><span class="structure">({</span> <span class="word">file</span> <span class="operator">=></span> <span class="single">'/etc/wishlist'</span> <span class="structure">});</span><br /><br /><span class="keyword">my</span> <span class="symbol">$fh</span> <span class="operator">=</span> <span class="symbol">$present_list</span><span class="operator">-></span><span class="word">fh</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="structure">{</span><span class="symbol">$fh</span><span class="structure">}</span> <span class="single">'For Xmas, I want:'</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="structure">{</span><span class="symbol">$fh</span><span class="structure">}</span> <span class="single">'A pony'</span><span class="structure">;</span><br /><br /><span class="comment"># snip 10,000 lines<br /></span><br /><span class="word">say</span> <span class="structure">{</span><span class="symbol">$fh</span><span class="structure">}</span> <span class="single">'And a Rocket-Raptor Sky Armageddon action figure'</span><span class="structure">;</span><br /><br /><span class="symbol">$present_list</span><span class="operator">-></span><span class="word">commit</span><span class="structure">;</span></code></pre>
<p>Or, alternatively:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">File::AtomicWrite</span><span class="structure">;</span><br /><br /><span class="word">File::AtomicWrite</span><span class="operator">-></span><span class="word">write_file</span><span class="structure">({</span><br /> <span class="word">file</span> <span class="operator">=></span> <span class="single">'/etc/wishlist'</span><span class="operator">,</span><br /> <span class="word">input</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$all_i_want</span><span class="operator">,</span><br /><span class="structure">});</span></code></pre>
<p>To accomodate different levels of paranoia, the module allows for several options, including the directory in which the temporary file is written, the template for the name of said temporary file, optional checksum of the data to be written, the minimal size that data should be (wishlist under 50K? IMPOSSIBLE!), and much, much more. But, and this is the good news, all the hard stuff has been taken off your plate. Now all you need to do is to write to the file (easy) or, in the real world equivalent, find the gift that needs to be appended under the tree (… okay, maybe not that easy).</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/File::AtomicWrite">File::AtomicWrite</a></p>
</li>
</ul>
</div>2012-12-08T00:00:00ZYanick ChampouxIs your code… Safe?http://perladvent.org/2012/2012-12-07.html<div class='pod'><p>Today we'll have a little chat about the <code>Safe</code> module. What does it do, how does it work and when to use it?</p>
<h3 id="The-Purpose">The Purpose</h3>
<p><a href="https://metacpan.org/module/Safe">Safe</a>'s purpose is to provide a <i>restricted <code>eval()</code> function</i> to perl, which will function as the regular <code>eval(STRING)</code> built-in, except in two important points:</p>
<ul>
<li><p>This restricted <code>eval()</code> will refuse to compile certain built-ins (the list being customizable, so for example you can prevent compilation of all filesystem access functions, or just some, or none)</p>
</li>
<li><p>Moreover, it will compile code in a separate, quarantined namespace, where the data of your main program will not be accessible.</p>
</li>
</ul>
<h3 id="The-Example">The Example</h3>
<p>Quick, a code example, to see what it looks like:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="version">v5.14.0</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Safe</span><span class="structure">;</span><br /><br /><span class="comment"># create a Safe compartment<br /></span><span class="keyword">my</span> <span class="symbol">$compartment</span> <span class="operator">=</span> <span class="word">Safe</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><span class="symbol">$compartment</span><span class="operator">-></span><span class="word">deny</span><span class="structure">(</span><span class="words">qw(:base_loop)</span><span class="structure">);</span><br /><br /><span class="magic">$_</span> <span class="operator">=</span> <span class="number">2</span><span class="structure">;</span><br /><br /><span class="comment"># First try<br /></span><span class="keyword">my</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="symbol">$compartment</span><span class="operator">-></span><span class="word">reval</span><span class="structure">(</span> <span class="literal">q{ 40 + $_ }</span> <span class="structure">);</span><br /><span class="core">defined</span> <span class="symbol">$result</span> <span class="operator">or</span> <span class="word">die</span> <span class="double">"Safe compilation error: $@"</span><span class="structure">;</span><br /><span class="word">say</span> <span class="symbol">$result</span><span class="structure">;</span><br /><br /><span class="comment"># Second try<br /></span><span class="symbol">$result</span> <span class="operator">=</span> <span class="symbol">$compartment</span><span class="operator">-></span><span class="word">reval</span><span class="structure">(</span> <span class="literal">q{ $_++ for 1..40 }</span> <span class="structure">);</span><br /><span class="core">defined</span> <span class="symbol">$result</span> <span class="operator">or</span> <span class="word">die</span> <span class="double">"Safe compilation error: $@"</span><span class="structure">;</span><br /><span class="word">say</span> <span class="symbol">$result</span><span class="structure">;</span></code></pre>
<p>In this example we start by creating a fairly restricted Safe compartment, where not only the default set of built-ins is forbidden, but also all loop built-ins (<code>for</code>, <code>while</code>, etc.)</p>
<p>The result of the first try will be 42, since the addition and the variable fetching are still permitted operations. The second try will fail with the error message:</p>
<pre><code> 'foreach loop entry' trapped by operation mask</code></pre>
<h3 id="The-Basics">The Basics</h3>
<p>There are a couple of points worth noting even in such a small example.</p>
<p>First, we use the <code>deny()</code> method to deny more operations than the default set. Safe provides <code>deny()</code>, <code>permit()</code>, <code>deny_only()</code> and <code>permit_only()</code> to customize this set more finely; you can pass to those methods lists of individual op names (as known to the perl internals) or handy predefined bundles (like <code>:base_loop</code>). Those bundles are listed in the <code>Opcode</code> man page.</p>
<p>Secondly, just like <code>eval()</code>, a compilation error reported by the <code>reval()</code> method will be in the <code>$@</code> variable.</p>
<p>Thirdly, we used <code>$_</code> in the string we've been reval-ing. But the namespaces were supposed to be separated? Did I lie? Of course not, I did not lie, and this isn't a bug in Safe either. The fact is that <code>$_</code> is one of the few variables that are <i>shared</i> by default between the program's global namespace and the compartment's one.</p>
<p>To verify this, change the "first try" lines to this, and observe how the <code>$result</code> will now be 40 instead of 42:</p>
<pre><code class="code-listing"><span class="keyword">our</span> <span class="symbol">$x</span> <span class="operator">=</span> <span class="number">2</span><span class="structure">;</span> <span class="comment"># or "my $x = 2", does not matter</span><br /><span class="keyword">my</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="symbol">$compartment</span><span class="operator">-></span><span class="word">reval</span><span class="structure">(</span> <span class="literal">q{ 40 + $x }</span> <span class="structure">);</span></code></pre>
<p>Of course, the list of variables you want to share can be changed, too:</p>
<pre><code class="code-listing"><span class="keyword">our</span> <span class="symbol">$x</span> <span class="operator">=</span> <span class="number">2</span><span class="structure">;</span><br /><span class="symbol">$compartment</span><span class="operator">-></span><span class="word">share</span><span class="structure">(</span><span class="single">'$x'</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="symbol">$compartment</span><span class="operator">-></span><span class="word">reval</span><span class="structure">(</span> <span class="literal">q{ 40 + $x }</span> <span class="structure">);</span><br /><span class="word">say</span> <span class="symbol">$result</span><span class="structure">;</span> <span class="comment"># will now say '42'</span></code></pre>
<p>You can specify that you want to share functions as well, so the reval-ed code will be able to call them. By default, Safe will share the <code>*_</code> glob (so, <code>$_</code>, <code>@_</code>, etc.) and a quite long list of built-in functions that are often called behind the scenes (like <code>&UNIVERSAL::isa</code> or <code>&utf8::downgrade</code>). Use the Source for the full list, which is perl-version-dependent.</p>
<h3 id="The-Details">The Details</h3>
<p>So what exactly is this new namespace that Safe is masking <code>main::</code> under? The <code>root()</code> method allows you to access it, as in the following example:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="version">v5.14.0</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Safe</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$compartment</span> <span class="operator">=</span> <span class="word">Safe</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$root</span> <span class="operator">=</span> <span class="symbol">$compartment</span><span class="operator">-></span><span class="word">root</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="double">"root namespace name: $root"</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="symbol">$compartment</span><span class="operator">-></span><span class="word">reval</span><span class="structure">(</span> <span class="literal">q{ $x = 42 }</span> <span class="structure">);</span><br /><span class="word">say</span> <span class="double">"result = $result"</span><span class="structure">;</span><br /><br /><span class="keyword">no</span> <span class="pragma">strict</span> <span class="single">'refs'</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"safe's \$x : "</span><span class="operator">,</span> <span class="cast">$</span><span class="structure">{</span> <span class="symbol">$root</span><span class="operator">.</span><span class="single">'::x'</span> <span class="structure">};</span> <span class="comment"># 42 too !</span></code></pre>
<p>On My Machine the <code>root()</code> method will return the string <code>Safe::Root0</code> in this example. So consequently the variable introduced as <code>$x</code> in the evaluated code will be known as <code>$Safe::Root0::x</code> in the outer program.</p>
<p>Also, you'll notice that <code>$x</code> has been compiled by Safe without fussing about <i>Global symbol "$x" requires explicit package name</i>: the ambient pragmas are not passed to the <code>reval()</code>. If you want to enforce strictures in the compilation phase, you have to call <code>reval()</code> with a second boolean parameter set to true:</p>
<pre><code> my $result = $compartment->reval( q{ our $x = 42 }, 1 );</code></pre>
<h3 id="The-Lengths">The Lengths</h3>
<p>As you can imagine a popular game is to get Safe execute code that it shouldn't. Safe goes to some lengths to avoid this. Here are two of those, just to excite your imagination:</p>
<p><i>Destructor destruction</i>. Before exiting from a <code>reval()</code>, Safe will check whether any class gained new methods, and if so, it will delete every <code>DESTROY</code> and <code>AUTOLOAD</code> it finds under its root namespace. This is to prevent destructors or functions created inside the department from being run outside of it (for example if the <code>reval()</code> returns to its caller a newly crafted object).</p>
<p><i>Closure closing</i>. Safe provides a method <code>wrap_code_ref()</code> that will take a code reference as an argument, and return a version of it wrapped in a <code>reval()</code> (that's the short story -- check the source for the gory details). Subsequently, <code>reval()</code> will check its return values for any code references (recursively, if it returns hash or array references), and will invoke <code>wrap_code_ref()</code> on any code reference found there before passing them to you.</p>
<h3 id="The-Caveats">The Caveats</h3>
<p>TL;DR: No silver bullet, etc.</p>
<p>Longer version (but really it's just common sense): the name of the Safe module is misleading. If should have been called <code>Restricted::Sortof</code> or something. It has its uses, but making evaluating foreign code safer is not one of these. Even in a very restricted compartment, it's possible to introduce a pathologically slow regular expression, or a pathologically long loop, or a pathologically big string. Any use of Safe for serious security purposes is basically misguided.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Safe">Safe</a></p>
</li>
</ul>
</div>2012-12-07T00:00:00ZRafaël Garcia-SuarezChecking Out Your Data Structureshttp://perladvent.org/2012/2012-12-06.html<div class='pod'><h2 id="Have-Your-Variables-Been-Naughty-or-Nice">Have Your Variables Been Naughty or Nice?</h2>
<p>Every once in a while you expect your variables to contain a certain value, only to realize, sometimes a bit too late, that something's off. We've all been there, and having a way to quickly and neatly view the contents of your variables can make all the difference in the world.</p>
<p>Enter <a href="https://metacpan.org/module/Data::Printer">Data::Printer</a>, a module that formats and prints your data structures on screen, in a way that lets you easily check them and spot errors. Its output is colored by default, and it also contains several filters to help you debug objects.</p>
<p>Using it couldn't be simpler: Data::Printer exports a <code>p()</code> function to your namespace that you use to dump your data to STDERR (or <a href="https://metacpan.org/module/Data::Printer#Changing-output-targets">anywhere else</a> in fact):</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Data::Printer</span><span class="structure">;</span><br /><br /><span class="operator">...</span><br /><br /><span class="word">p</span> <span class="symbol">$some_variable</span><span class="structure">;</span></code></pre>
<p>Since it's a debugging module you'll likely be turning it on and off everywhere in your code. If that's the case, a common idiom is to simply add this line when you need to check some data:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">DDP</span><span class="structure">;</span> <span class="word">p</span> <span class="symbol">$some_variable</span><span class="structure">;</span></code></pre>
<p>Which takes advantage of <a href="https://metacpan.org/module/DDP">DDP</a>, a shorter alias for Data::Printer.</p>
<h2 id="Optimized-for-Humans">Optimized for Humans</h2>
<p>Now, if you were using it to view the content of a complex data structure, this is what you might get:</p>
<table class="code-listing">
<tbody>
<tr>
<td class="code" style="font-weight:normal">
\ [
<span style="color:#fff">[0]</span> "<span style="color:#ff7">/path/from/env</span>" <span style="color:#b11">(TAINTED)</span>,
<span style="color:#fff">[1]</span> [
<span style="color:#fff">[0]</span> "<span style="color:#ff7">foo</span>",
<span style="color:#fff">[1]</span> "<span style="color:#ff7">bar</span>"
],
<span style="color:#fff">[2]</span> {
<span style="color:#b40486">name</span> "",
<span style="color:#b40486">gifts</span> <span style="background-color:#f00;color:#ccc">var[1]</span>
},
<span style="color:#fff">[3]</span> \ "<span style="color:#ff7">Some string reference</span>" <span style="color:#01dfa5">(weak)</span>
]
</td>
</tr>
</tbody>
</table>
<p>Did you see what just happened? Not only did Data::Printer show you the contents of your variable in a clear, colored and indented fashion, it also let you see array indices, know about circular references, tainted data, and weak references, and it can detect and describe many more facts about your data!</p>
<p>But enough about plain data structures. Let's try it with an object:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">My::Class</span> <span class="structure">{</span><br /> <span class="keyword">sub</span> <span class="word">new</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$class</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="word">bless</span> <span class="structure">{</span> <span class="word">num</span> <span class="operator">=></span> <span class="number">42</span> <span class="structure">}</span><span class="operator">,</span> <span class="symbol">$class</span><span class="structure">;</span><br /> <span class="structure">}</span><br /><br /> <span class="keyword">sub</span> <span class="word">foo</span> <span class="structure">{}</span><br /> <span class="keyword">sub</span> <span class="word">bar</span> <span class="structure">{}</span><br /> <span class="keyword">sub</span> <span class="word">_baz</span> <span class="structure">{}</span><br /><span class="structure">};</span></code></pre>
<p>If you use Data::Printer on an instance of the class defined above, you'll see something like this when you dump it:</p>
<table class="code-listing">
<tbody>
<tr>
<td class="code" style="font-weight:normal">
<span style="color:#5f5">My::Class</span> {
public methods (3) : <span style="color:#5f5">bar</span>,<span style="color:#5f5">foo</span>,<span style="color:#5f5">new</span>
private methods (1) : <span style="color:#5f5">_baz</span>
internals: {
<span style="color:#b40486">num</span> <span style="color:#0a4bac">42</span>
}
}
</td>
</tr>
</tbody>
</table>
<p>Pretty neat, huh? It would even show inheritance if we had any =)</p>
<h2 id="Filters">Filters</h2>
<p>Another of Data::Printer's strenghts lies in how it lets you easily filter Perl types and classes. The basic distribution includes formatters for some popular modules like <a href="https://metacpan.org/module/DateTime">DateTime</a>, <a href="https://metacpan.org/module/Digest">Digest</a> and <a href="https://metacpan.org/module/DBI">DBI</a>, so if you have enabled them in your <a href="https://metacpan.org/module/Data::Printer#CUSTOMIZATION">settings</a>, then this:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="structure">{</span><br /> <span class="word">datetime</span> <span class="operator">=></span> <span class="word">DateTime</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">year</span> <span class="operator">=></span> <span class="number">2012</span><span class="operator">,</span> <span class="word">month</span> <span class="operator">=></span> <span class="number">12</span><span class="operator">,</span> <span class="word">day</span> <span class="operator">=></span> <span class="number">25</span> <span class="structure">)</span><span class="operator">,</span><br /> <span class="word">dbh</span> <span class="operator">=></span> <span class="word">DBI</span><span class="operator">-></span><span class="word">connect</span><span class="structure">(</span><span class="symbol">$dsn</span><span class="operator">,</span> <span class="symbol">$user</span><span class="operator">,</span> <span class="symbol">$pass</span><span class="structure">)</span><span class="operator">,</span><br /> <span class="word">digest</span> <span class="operator">=></span> <span class="word">Digest::MD5</span><span class="operator">-></span><span class="word">new</span><span class="operator">,</span><br /><span class="structure">};</span><br /><br /><span class="keyword">use</span> <span class="word">DDP</span><span class="structure">;</span> <span class="word">p</span> <span class="symbol">$data</span><span class="structure">;</span></code></pre>
<p>Might show you something like this:</p>
<table class="code-listing">
<tbody>
<tr>
<td class="code" style="font-weight:normal">
\ {
<span style="color:#b40486">datetime</span> <span style="color:#5f5">2012-12-25T00:00:00 [floating]</span>,
<span style="color:#b40486">dbh</span> mysql Database Handle (<span style="color:#5f5">connected</span>) {
database: mydb
Auto Commit: 1
Statement Handles: 0
Last Statement: <span style="color:#ff7">-</span>
}
<span style="color:#b40486">digest</span> <span style="color:#5f5">d41d8cd98f00b204e9800998ecf8427e [reset]</span>,
}
</td>
</tr>
</tbody>
</table>
<p>Notice how, in this example, Data::Printer showed you:</p>
<ul>
<li><p>DateTime objects as formatted strings with the timezone (in this case, 'floating');</p>
</li>
<li><p>Database handles with information regarding connection, current database, amount of active statement handles, last run statement and even extra properties that might influence your program (like <code>AutoCommit</code>);</p>
</li>
<li><p>Digest objects (like <a href="https://metacpan.org/module/Digest::MD5">Digest::MD5</a>) as formatted hexdumps, including a mention when, like in the example above, the digest is actually is the one of a reset (empty) element.</p>
</li>
</ul>
<p>There are <a href="https://metacpan.org/module/Data::Printer::Filter#EXISTING-FILTERS">several different filters available on CPAN</a> and you can make some new ones yourself!</p>
<h2 id="In-Short">In Short</h2>
<p><a href="https://metacpan.org/module/Data::Printer">Data::Printer</a> is a shiny tool for your Perl utility belt that not only pretty-prints variables, but also provides very useful information regarding your data. It is also extremely easy to tweak to suit your own taste and debugging needs, from colors to formatting to new filters.</p>
<p>If you're not using it already, give it a go!</p>
</div>2012-12-06T00:00:00ZBreno G. de OliveiraReindeer Gameshttp://perladvent.org/2012/2012-12-05.html<div class='pod'><p><a href="http://perldancer.org">Dancer</a> is a Perl micro-web framework originally based on Ruby's <a href="http://www.sinatrarb.com">Sinatra</a>. Its status as a micro-framework means, amongst other things, that it is a very nimble creature, and can be thus showed many nifty tricks.</p>
<h2 id="Have-Your-Party-MCed-by-One-of-Santas-Close-Collaborator">Have Your Party MC'ed by One of Santa's Close Collaborator</h2>
<p>It doesn't take a lot of boilerplate to create a minimalistic web service with <code>Dancer</code>. For example, want to have a web service returning a random song in the current directory to help the party's DJ? There we go:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="pragma">autodie</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Dancer</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">List::Util</span> <span class="words">qw/ shuffle /</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MP3::Info</span><span class="structure">;</span><br /><br /><span class="word">get</span> <span class="single">'/song'</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="word">opendir</span> <span class="word">my</span> <span class="symbol">$dir</span><span class="operator">,</span> <span class="single">'.'</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="structure">(</span> <span class="symbol">$file</span> <span class="structure">)</span> <span class="operator">=</span> <span class="word">shuffle</span> <span class="word">grep</span> <span class="structure">{</span> <span class="match">/\.mp3$/</span> <span class="structure">}</span> <span class="word">readdir</span> <span class="symbol">$dir</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$song</span> <span class="operator">=</span> <span class="word">MP3::Info</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="symbol">$file</span><span class="structure">);</span><br /><br /> <span class="keyword">return</span> <span class="word">sprintf</span> <span class="double">"%s (%s)"</span><span class="operator">,</span> <span class="symbol">$song</span><span class="operator">-></span><span class="word">title</span><span class="operator">,</span> <span class="symbol">$song</span><span class="operator">-></span><span class="word">artist</span><span class="structure">;</span><br /><span class="structure">};</span><br /><br /><span class="word">dance</span><span class="structure">;</span></code></pre>
<p>The result is bare-bone, but oh-so-wonderfully functional:</p>
<pre><code> $ perl next_song.pl
>> Dancer 1.311 server 6046 listening on http://0.0.0.0:3000
== Entering the development dance floor ...
# meanwhile, on the DJ side
$ curl http://localhost:3000/song
01 A Tap Dancer's Dilemma (DIABLO SWING ORCHESTRA)</code></pre>
<h2 id="Shorter">Shorter!</h2>
<p>Can we make this shorter? You bet we can. For example, to be able to create mini-web services that only answer to their index route, we can create the module <i>C.pm</i>:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">C</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Dancer</span><span class="structure">;</span><br /><br /><span class="structure">{</span> <span class="keyword">package</span> <span class="word">::main</span><span class="structure">;</span> <span class="keyword">use</span> <span class="word">Dancer</span> <span class="single">':syntax'</span><span class="structure">;</span> <span class="structure">}</span><br /><br /><span class="keyword">END</span> <span class="structure">{</span><br /> <span class="word">get</span> <span class="single">'/'</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">&::index</span> <span class="word">if</span> <span class="core">defined</span> <span class="symbol">&::index</span><span class="structure">;</span><br /> <span class="word">dance</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>And voilà, make room for your new MC:</p>
<pre><code> $ perl -MC -MMP3::Info -e'sub index{@s=<*.mp3>;$s[rand@s];}'
>> Dancer 1.311 server 6046 listening on http://0.0.0.0:3000
== Entering the development dance floor ...
# meanwhile, on the DJ side
$ curl http://localhost:3000/
01 - 01 A Tap Dancer's Dilemma.mp3</code></pre>
<h2 id="Even-shorter">Even shorter!</h2>
<p>Can we make this even shorter? Maybe slurp on simple scripts present in sub-directories and convert them into web service routes? My, but of course:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">C</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="version">5.10.0</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Dancer</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Class</span> <span class="words">qw/ dir /</span><span class="structure">;</span><br /><br /><span class="structure">{</span> <span class="keyword">package</span> <span class="word">::main</span><span class="structure">;</span> <span class="keyword">use</span> <span class="word">Dancer</span> <span class="single">':syntax'</span><span class="structure">;</span> <span class="structure">}</span><br /><br /><span class="word">dir</span><span class="structure">(</span><span class="single">'.'</span><span class="structure">)</span><span class="operator">-></span><span class="word">traverse</span><span class="structure">(</span> <span class="keyword">sub</span><span class="structure">{</span><br /> <span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$child</span><span class="operator">,</span> <span class="symbol">$cont</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="symbol">$cont</span><span class="operator">-></span><span class="structure">()</span> <span class="word">if</span> <span class="operator">-d</span> <span class="symbol">$child</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$route</span><span class="operator">,</span> <span class="symbol">$method</span> <span class="structure">)</span> <span class="operator">=</span> <span class="symbol">$child</span> <span class="operator">=~</span> <span class="match">/^(.*)\.(get|post|put)$/</span> <span class="operator">or</span> <span class="keyword">return</span><span class="structure">;</span><br /><br /> <span class="symbol">$route</span> <span class="operator">=~</span> <span class="substitute">s/^\.//</span> <span class="operator">or</span> <span class="symbol">$route</span> <span class="operator">=~</span> <span class="substitute">s#^#/#</span><span class="structure">;</span><br /> <span class="symbol">$route</span> <span class="operator">=~</span> <span class="substitute">s/SPLAT/*/g</span><span class="structure">;</span><br /><br /> <span class="word">say</span> <span class="double">"adding route '$route'"</span><span class="structure">;</span><br /><br /> <span class="word">eval</span> <span class="heredoc"><<"END_ROUTE"</span><span class="structure">;</span><br /><span class="heredoc_content">$method '$route' => sub {<br /> \@_ = \@ARGV = splat;<br /> local \*STDOUT;<br /> open STDOUT, '>', \\my \$output;<br /><br /> { @{[ $child->slurp ]} };<br /><br /> return \$output;<br />};<br /></span><span class="heredoc_terminator">END_ROUTE<br /></span><br /> <span class="word">die</span> <span class="double">"couldn't compile route '$child': $@"</span> <span class="word">if</span> <span class="magic">$@</span><span class="structure">;</span><br /><span class="structure">});</span><br /><br /><span class="keyword">END</span> <span class="structure">{</span> <span class="word">dance</span><span class="structure">;</span> <span class="structure">}</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>And with that MC on steroid, we can now have auto-web-serviceable perl scripts:</p>
<pre><code> $ cat song.get
use List::Util qw/ shuffle /;
use MP3::Info;
opendir my $dir, '.';
my ( $file ) = shuffle grep { /\.mp3$/ } readdir $dir;
my $song = MP3::Info->new($file);
printf "%s (%s)", $song->title, $song->artist;
$ cat request/SPLAT.put
use 5.10.0;
open my $request_fh, '>>', 'requests';
my $song = shift;
say {$request_fh} $song;
say "song '$song' added to the list";</code></pre>
<p>which can be used from the command-line:</p>
<pre><code> $ perl song.get
01 A Tap Dancer's Dilemma (DIABLO SWING ORCHESTRA)
$ perl request/SPLAT.put "Rudoplh The Red-Nosed Reindeer"
song 'Rudoplh The Red-Nosed Reindeer' added to the list</code></pre>
<p>and, once the MC is roused,</p>
<pre><code> $ perl -MC -e1
adding route '/request/*'
adding route '/song'
>> Dancer 1.311 server 6586 listening on http://0.0.0.0:3000
== Entering the development dance floor ...</code></pre>
<p>the Holidays are suddenly all Web 2.0-ified:</p>
<pre><code> $ curl http://localhost:3000/song
01 A Tap Dancer's Dilemma (DIABLO SWING ORCHESTRA)
$ curl -X PUT http://localhost:3000/request/Rudolf_the_red_nosed_reindeer
song 'Rudolf_the_red_nosed_reindeer' added to the list</code></pre>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Dancer">Dancer</a></p>
</li>
<li><p><a href="http://advent.perldancer.org/2012">the 2012 Perl Dancer Advent Calendar</a></p>
</li>
</ul>
</div>2012-12-05T00:00:00ZYanick ChampouxWhich Library Broke?http://perladvent.org/2012/2012-12-04.html<div class='pod'><p>The CPAN is built on a few key principles that make it such a success. One of them is that you don't have to write every part of the library you want to write. You can declare that it depends on some other preexisting library, and that library will be found and installed. Still, there's sometimes a cultural pressure to require as few prerequisites as to require as old a version as possible. In other words, it's often preferable to avoid making anybody install or upgrade anything. On the other hand, it's also frowned upon to put an upper limit on versions. (Actually, it's technically difficult to specify a bounded range, so those frowns are redundant and maybe I just made them up.)</p>
<p>Keeping track of what versions you <i>actually need</i>, then, often works like this:</p>
<ol>
<li><p>declare that you need version 0</p>
</li>
<li><p>wait for somebody to tell you things aren't working</p>
</li>
<li><p>figure out what prerequisite library versions are unusual</p>
</li>
<li><p>ask the user to upgrade or downgrade libraries until it works</p>
</li>
<li><p>adjust the listed prequisites</p>
</li>
</ol>
<p>The problem here is #3. It's a pain for the reporting user to go compile his installed versions, and it's a pain to do it yourself for comparison. On the bright side, the CPAN Testers, who can never be sufficiently thanked for their contributions to the CPAN, usually submit reports that include all the data needed here. You can look at <a href="http://cpantesters.org/cpan/report/05bc2cdc-4481-11e1-9d6f-f6dbfa7543f5">almost any random report</a> and find the prerequisites listed, both as they were requested and as they were found. That's great, if you're getting reports from CPAN smoke bots. It doesn't cover everybody else.</p>
<p>For everybody else, the trick is to write a little program that prints out a table like the one in the tester's report: for each prereq, it shows the requested and found version of the module. <a href="http://cpansearch.perl.org/src/DOLMEN/Dist-Zilla-Plugin-ReportVersions-Tiny-1.08/t/000-report-versions-tiny.t">A program to do that</a> is simple, but sort of a tedious pain to write. As with almost anything useful but boring, there's a <a href="https://metacpan.org/module/Dist::Zilla">Dist::Zilla</a> plugin to do it for you.</p>
<p>Actually, there are several.</p>
<p><a href="https://metacpan.org/module/Dist::Zilla::Plugin::ReportVersions::Tiny">Dist::Zilla::Plugin::ReportVersions::Tiny</a> spits out a <i>000-report-versions-tiny.t</i> file like the one linked to above. One of the best things about that plugin is that it generates a test program with no extra prerequisites. It produces a simple, useful program that you can bundle along with your distribution, and whose output will be included, by default, with any test run, and there's no "cost" in more prereqs for the installing user.</p>
<p><a href="https://metacpan.org/module/Dist::Zilla::Plugin::Test::ReportPrereqs">Dist::Zilla::Plugin::Test::ReportPrereqs</a> does much the same job, but lets you tweak the list a bit to add other libraries you know you care about that aren't otherwise in your module list — but it doesn't include the requested version in its output, and only runs if the <code>AUTOMATED_TESTING</code> environment variable is set.</p>
<p>Even if the reporting user isn't sending a "real" CPAN Testers report, it's easy to get the table you need. Just ask the user to run:</p>
<pre><code> $ perl -Mblib t/000-report-versions-tiny.t | nopaste</code></pre>
<p>(Everybody has <a href="http://perladvent.org/2011/2011-12-14.html">nopaste</a> installed, right?)</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Dist::Zilla::Plugin::ReportVersions::Tiny">Dist::Zilla::Plugin::ReportVersions::Tiny</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Dist::Zilla::Plugin::Test::ReportPrereqs">Dist::Zilla::Plugin::Test::ReportPrereqs</a></p>
</li>
</ul>
</div>2012-12-04T00:00:00ZRicardo SignesSleigh Upgradehttp://perladvent.org/2012/2012-12-03.html<div class='pod'><p>Santa's little helpers had just completed an upgrade to his fleet of sleighs. Ruldoph was getting tired of lighting the way each night, and wanted a year off, so they'd <i>finally</i> fitted some headlights. They'd also updated their code to turn them on and off again automatically (so the batteries didn't wear out) whenever Santa took off:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">fly_to_next_house</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">1</span><span class="structure">);</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span><span class="operator">-></span><span class="word">set_destination</span><span class="structure">(</span> <span class="core">shift</span><span class="structure">(</span><span class="cast">@</span><span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">nice_list</span> <span class="structure">})</span><span class="operator">-></span><span class="word">address</span> <span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">fly_to_destination</span><span class="structure">(</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span> <span class="structure">);</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">0</span><span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>"I like it," said Santa, "but what happens though if the GPS doesn't know where the address is?"</p>
<p>"Hmmm", said the wise old elf, "well, it is running Apple Maps so I guess there <i>might</i> be a problem". "But", he continued, "not to worry. The set_destination method throws an exception and there's some <i>terribly</i> complicated code that catches it and deals with it in the routine that calls <code>fly_to_next_house</code>."</p>
<p>"Ha! The elves just look it up on Google Maps you mean.", Santa laughed, "Though that's not what I'm on about. Look: If the GPS throws an exception, can't you see the <b>lights never get turned off</b> because the code to do so won't be executed?"</p>
<p>"Oh crumbs", the elf conceded, "well, I guess we could use a localized variable to set the lights. Those are automatically unset at the end of the current scope no matter what - even if you do exit by an exception!"</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">fly_to_next_house</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">local</span> <span class="symbol">$Sliegh::Lights</span> <span class="operator">=</span> <span class="number">1</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span><span class="operator">-></span><span class="word">set_destination</span><span class="structure">(</span> <span class="core">shift</span><span class="structure">(</span><span class="cast">@</span><span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">nice_list</span> <span class="structure">})</span><span class="operator">-></span><span class="word">address</span> <span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">fly_to_destination</span><span class="structure">(</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Santa stroked his beard for a few minutes. Then he shook his head. "No, that's not going to work. For a starters you've mistyped 'Sleigh,' and since there's no error with misspelled fully qualified variables, the sleigh will end up flying me in the dark! Even if you fix that, this isn't going to work with one single variable controlling all the lights on every one of my sleighs."</p>
<p>"Oh, good point, "how about this then?"</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">fly_to_next_house</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">turn_lights_on_till_end_of_scope</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span><span class="operator">-></span><span class="word">set_destination</span><span class="structure">(</span> <span class="core">shift</span><span class="structure">(</span><span class="cast">@</span><span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">nice_list</span> <span class="structure">})</span><span class="operator">-></span><span class="word">address</span> <span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">fly_to_destination</span><span class="structure">(</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>"That's great! How did you do that?"</p>
<p>"Well, that's why they call me the <i>Wise</i> Old Elf"</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Sleigh</span><span class="structure">;</span><br /><span class="operator">...</span><br /><br /><span class="word">use</span> <span class="word">Scope::Upper</span> <span class="words">qw(reap UP)</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">turn_lights_on_till_end_of_scope</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /><span class="comment"> # turn on the lights<br /></span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">1</span><span class="structure">);</span><br /><br /><span class="comment"> # and turn them off again we exit our caller's scope<br /></span> <span class="word">reap</span> <span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">0</span><span class="structure">)</span> <span class="structure">}</span> <span class="word">UP</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Scope::Upper">Scope::Upper</a></p>
</li>
</ul>
</div>2012-12-03T00:00:00ZMark FowlerMy Favorite Pieshttp://perladvent.org/2012/2012-12-02.html<div class='pod'><p>I like pie.</p>
<p>I prefer pie to cake, and within the realm of pies, I have a few favorites. Almost certainly, my favorite pie is <a href="http://en.wikipedia.org/wiki/Pumpkin_pie">pumpkin pie</a>. When I learned that it's primarily an American dessert, and had a few Brits tell me that making something sweet from pumpkin sounded awful… well, I was pretty broken up about those poor lost souls.</p>
<p>Pumpkin pie isn't much of a Christmas treat, though. At Christmas, I might be more likely to get a slice of <a href="http://en.wikipedia.org/wiki/Chess_pie">chess pie</a>. Chess pie is even more American, and mostly found in the South. It's pretty much eggs, sugar, more sugar, and vinegar. Some people call it "vinegar pie." Trust me, it's better than it sounds.</p>
<p>Chess pie is good stuff, but I'm sort of expected to write something about <i>Perl</i> today, so I'm going to write about <i>Perl pie</i>. Perl pies are a great treat. They're good for you, they're easy to make, and they require very little Perl expertise to make.</p>
<h3 id="I-dont-want-to-put-Perl-in-my-mouth">I don't want to put Perl in my mouth.</h3>
<p>I don't either! Also, no baking is going to be required, and we're certainly not going to make anything in a microwave.</p>
<h3 id="Okay-then-carry-on">Okay, then, carry on.</h3>
<p><a href="https://metacpan.org/module/perlrun">Perl's command line switches</a> are pretty darn cool. Last year, I wrote about <a href="http://perladvent.org/2011/2011-12-05.html">the -M switch</a> and some tricks you could pull with it. There are lots of poorly-known switches that can be put to great use, in there. I'd love to cover them all, but for now I'm going to start with <code>-n</code>.</p>
<p>Let's imagine we've got some input file, <i>file.txt</i>:</p>
<pre><code class="code-listing">Alfa<br />Bravo<br />Charlie<br />Delta<br />Echo</code></pre>
<p>The <code>-n</code> switch implicitly wraps our program in a loop like this:</p>
<pre><code class="code-listing"><span class="label">LINE:</span> <span class="keyword">while</span> <span class="structure">(</span><span class="readline"><></span><span class="structure">)</span> <span class="structure">{</span><br /><span class="comment"> # your program goes here<br /></span><span class="structure">}</span></code></pre>
<p>This is great for doing things you might otherwise do with <code>awk</code> or <code>sed</code>. I haven't used either of those in years, because of <code>perl</code>. For example, we could write this:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl -n<br /></span><span class="word">die</span> <span class="double">"bogus first character"</span> <span class="word">unless</span> <span class="match">/\A[A-Z]/</span><span class="structure">;</span><br /><span class="substitute">s/\A(.)\K/ is the abbreviation for $1/</span><span class="structure">;</span><br /><span class="word">print</span><span class="structure">;</span></code></pre>
<p>...to get...</p>
<pre><code class="code-listing">A is the abbreviation for Alfa<br />B is the abbreviation for Bravo<br />C is the abbreviation for Charlie<br />D is the abbreviation for Delta<br />E is the abbreviation for Echo</code></pre>
<p>In fact, in my experience almost all programs I'd write with <code>-n</code> end with <code>print</code>, so I never use <code>-n</code>. Instead, I use <code>-p</code>, which is exactly the same but adds:</p>
<pre><code class="code-listing"><span class="word">continue</span> <span class="structure">{</span><br /> <span class="word">print</span> <span class="operator">or</span> <span class="word">die</span> <span class="double">"-p destination: $!\n"</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>The general idea is that now your program is a set of transformations on repeated input, and that you're just editing the stream as it goes by, line by line. It's quite sed-y.</p>
<p>The <code>-n</code> and <code>-p</code> switches are both usable on the shebang line, but they're rarely seen there — it's pretty easy to type the loop out when you're making a program that you're going to keep around a while. They're much more commonly seen in one-liners with the famous and beloved <code>-e</code> (or its younger brother <code>-E</code>). Does your system lack <code>nl</code> for numbering lines? No problem:</p>
<pre><code class="code-listing">~$ perl -pe 'printf "%6u: ", $.' file.txt<br /> 1: Alfa<br /> 2: Bravo<br /> 3: Charlie<br /> 4: Delta<br /> 5: Echo</code></pre>
<p>(Remember <code>$.</code>? It's (mostly) the current line number of the file you're reading.)</p>
<p>Somebody deleted <code>grep</code>? And <a href="https://metacpan.org/module/ack">ack</a>? Will, it sounds like you've got some personnel problems to deal with, but in the meantime, okay:</p>
<pre><code class="code-listing">~$ perl -ne 'print "$.: $_" if /l/' file.txt<br />1: Alfa<br />3: Charlie<br />4: Delta</code></pre>
<p>Note that while we <i>could</i> have used <code>-n</code> in writing the first example, replacing <code>sprintf</code> with <code>printf</code>, but we <i>had to</i> use <code>-n</code> in the second example! Because the <code>print</code> is in a <code>continue</code>, you can't avoid printing by using <code>next</code>. For that, we must stick to <code>-n</code>.</p>
<h3 id="I-was-told-there-would-be-pie">I was told there would be pie.</h3>
<p>Yes, well… from <code>-p</code> and <code>-n</code> and <code>-e</code>, we can make a Perl <i>pen</i>, but not a pie. For pie, we're obviously going to need some <code>-i</code>.</p>
<p>The <code>-i</code> switch will be familiar to <code>sed</code>-loving grognards. It lets us edit files on disk, using any value given to the switch as a backup file extension. So:</p>
<pre><code class="code-listing">~$ cat file.txt<br />Alfa<br />Bravo<br />Charlie<br />Delta<br />Echo<br />~$ perl -p -i.bak -e 's/[a-z]/-/g' file.txt<br />~$ cat file.txt<br />A---<br />B----<br />C------<br />D----<br />E---<br />~$ cat file.txt.bak<br />Alfa<br />Bravo<br />Charlie<br />Delta<br />Echo</code></pre>
<p>Now, using an argument to <code>-i</code> is a <i>very</i> good idea. Perl's handling of I/O errors when dealing with files with <code>-i</code> isn't the best, and you can lose data if you (or your operating system) screws up. That said… I don't think I ever actually use <i>.bak</i> or anything like that. That's what <code>git</code> is for, right? In my use, the most important reasons to know about that <i>.bak</i> option are (1) to inform other users so that I have plausible deniability when they ruin their unrecoverable data and (2) to remember that <b>you cannot write <code>perl -pie</code></b>. That's why Perl pies look like this:</p>
<pre><code class="code-listing">$ perl -pi -e 's/../.../' input.txt</code></pre>
<h2 id="Now-bake-me-a-pie">Now bake me a pie!</h2>
<p>I use Perl pies quite often, especially for doing mechanical refactoring of code. For example, let's say that I've done a bunch of work on making a library called Pumpkin::Walnut, and it's got a number of associated subclasses, and there's Pumpkin::WalnutX, etc. It turns out that for legal reasons, we can't call it Walnut and have to rebrand the whole thing as Pumpkin::Filbert. First we do a bit of renaming of the files in <i>lib</i>, possibly using <a href="http://perladvent.org/2011/2011-12-18.html">rename</a>, and then muck about in the files themselves:</p>
<p>This is a piece of cake (so to speak):</p>
<pre><code> $ perl -pi -e 's/Pumpkin::Walnut/Pumpkin::Filbert/g' $(find lib -type f)</code></pre>
<p>...then review for absurdity by consulting <code>git diff</code>.</p>
<p>Adding editor hints to your files is trivial:</p>
<pre><code> $ perl -pi -e 'print "%# vim: ft=mason:\n" unless $did{$ARGV}++' $(find mason -type f)</code></pre>
<p>You can fix wonky newlines:</p>
<pre><code> $ perl -pi -e 's/\x0A?\x0D/\n/g' file.txt</code></pre>
<p>...and of course you can do all sorts of things <i>other</i> than <code>s///</code>. Here's a longer-form of a one-liner I keep lying around:</p>
<pre><code class="code-listing">~$ cat numbers.csv<br />5,7,7,9,14,13,9,3,0,6<br />18,6,17,15,5,19,2,0,16,12<br />5,3,5,5,9,13,19,13,4,17<br />16,16,14,1,10,2,10,2,11,9<br />15,1,14,14,18,12,4,10,16,16<br /><br />~$ perl -MList::Util=sum -ani -F, -E 'say sum @F' numbers.csv<br />~$ cat numbers.txt<br />73<br />110<br />93<br />91<br />120</code></pre>
<p>It's a lot of fun to write big applications in Perl, using all the other libraries we talk about every other day on the Perl Advent Calendar, but sticking to plain old core Perl is still a pretty sweet way to solve tons of everyday problems.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/perlrun">perlrun</a></p>
</li>
</ul>
</div>2012-12-02T00:00:00ZRicardo SignesSweet Path::Class is Coming to Townhttp://perladvent.org/2012/2012-12-01.html<div class='pod'><p>File and directory paths. They start off so simple, but then depending on which system the script runs on, they might use slashes or backslashes. And then there are spaces that come to mess everything up. And then there are those systems that use drive letters and volume names. And so on, and so forth.</p>
<p>You know what? Give yourself the gift of simplicity these holidays, and begin to use <a href="https://metacpan.org/module/Path::Class">Path::Class</a>.</p>
<p>Path::Class wraps all those file and directory operations in object-oriented goodness that will warm your DWIM-hungry little heart.</p>
<p>To begin with, creating the objects is pretty straight-forward:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Path::Class</span> <span class="words">qw/ file dir /</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$dir</span> <span class="operator">=</span> <span class="word">dir</span><span class="structure">(</span><span class="words">qw/ home santa children naughty /</span> <span class="structure">);</span><br /><br /><span class="comment"># could also have done<br /># my $dir = dir( '/home/santa/children/naughty' );<br /># and Path::Class would have understood<br /></span><br /><span class="keyword">my</span> <span class="symbol">$entry</span> <span class="operator">=</span> <span class="word">file</span><span class="structure">(</span><span class="words">qw/ home santa children naughty yanick /</span><span class="structure">);</span><br /><br /><span class="comment"># or simply<br />#my $entry = $dir->file('yanick');</span></code></pre>
<p>And because the <code>dir</code> and <code>file</code> objects auto-stringify to their representing strings, it means that you can use them just like any regular path strings:</p>
<pre><code class="code-listing"><span class="word">say</span> <span class="double">"Uh oh"</span> <span class="word">if</span> <span class="operator">-f</span> <span class="symbol">$entry</span><span class="structure">;</span><br /><br /><span class="word">opendir</span> <span class="word">my</span> <span class="symbol">$dh</span><span class="operator">,</span> <span class="symbol">$dir</span><span class="structure">;</span><br /><span class="word">printf</span> <span class="double">"there are %d naughty children in this directory\n"</span><span class="operator">,</span><br /> <span class="word">scalar</span> <span class="word">grep</span> <span class="structure">{</span> <span class="match">/^\.\.$/</span> <span class="structure">}</span> <span class="word">readdir</span> <span class="symbol">$dh</span><span class="structure">;</span></code></pre>
<p>But as soon you discover the methods those objects have, you'll <i>soooo</i> not want to do that. Traveling up and down directory structures will now be a joy:</p>
<pre><code class="code-listing"><span class="comment"># down<br /></span><span class="keyword">my</span> <span class="symbol">$subdir</span> <span class="operator">=</span> <span class="symbol">$dir</span><span class="operator">-></span><span class="word">subdir</span><span class="structure">(</span><span class="single">'really_naughty'</span><span class="structure">);</span><br /><br /><span class="comment"># up and down<br /></span><span class="keyword">my</span> <span class="symbol">$good_ones</span> <span class="operator">=</span> <span class="symbol">$dir</span><span class="operator">-></span><span class="word">parent</span><span class="operator">-></span><span class="word">subdir</span><span class="structure">(</span><span class="single">'nice'</span><span class="structure">);</span><br /><br /><span class="word">say</span> <span class="double">"by the by, it's a relative path"</span> <span class="word">if</span> <span class="symbol">$dir</span><span class="operator">-></span><span class="word">is_relative</span><span class="structure">;</span></code></pre>
<p>Cleaning up complicated paths? A wonder:</p>
<pre><code class="code-listing"><span class="word">say</span> <span class="word">dir</span><span class="structure">(</span> <span class="single">'/home/santa/../santa////children/.//nice'</span> <span class="structure">)</span><span class="operator">-></span><span class="word">resolve</span><span class="structure">;</span><br /><span class="comment"># yes, prints '/home/santa/children/nice'</span></code></pre>
<p>Utilities and shortcuts to create tempfiles, iterate through the directory entries or traverse the directory structure? All there:</p>
<pre><code class="code-listing"><span class="comment"># create a temporary file<br /></span><span class="keyword">my</span> <span class="structure">(</span> <span class="symbol">$wishlist_fh</span><span class="operator">,</span> <span class="symbol">$wishlist_filename</span> <span class="structure">)</span> <span class="operator">=</span> <span class="symbol">$dir</span><span class="operator">-></span><span class="word">tempfile</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="structure">{</span> <span class="symbol">$wishlist_fh</span> <span class="structure">}</span> <span class="double">"I want a $_"</span> <span class="word">for</span> <span class="symbol">@gift_ideas</span><span class="structure">;</span><br /><br /><span class="comment"># read the directory<br /></span><span class="keyword">while</span> <span class="structure">(</span> <span class="keyword">my</span> <span class="symbol">$naughty_child</span> <span class="operator">=</span> <span class="symbol">$naughty_dir</span><span class="operator">-></span><span class="word">next</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="symbol">$naughty_child</span><span class="operator">-></span><span class="word">remove</span> <span class="word">if</span> <span class="symbol">$naughty_child</span> <span class="operator">=~</span> <span class="match">/yanick|rjbs/</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="comment"># go gift hunting<br /></span><span class="keyword">my</span> <span class="symbol">@hidden</span> <span class="operator">=</span> <span class="word">dir</span><span class="structure">(</span><span class="words">qw/ dev rooms /</span><span class="structure">)</span><span class="operator">-></span><span class="word">traverse</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$entry</span><span class="operator">,</span> <span class="symbol">$cont</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><span class="comment"> # grab any gift file<br /></span> <span class="keyword">return</span> <span class="symbol">$cont</span><span class="operator">-></span><span class="structure">()</span><span class="operator">,</span> <span class="structure">(</span><span class="symbol">$entry</span><span class="structure">)</span> <span class="operator">x</span> <span class="structure">(</span> <span class="operator">-f</span> <span class="symbol">$entry</span> <span class="operator">and</span> <span class="symbol">$entry</span> <span class="operator">=~</span> <span class="match">/\.gift$/</span><span class="structure">;</span> <span class="structure">);</span><br /><span class="structure">});</span></code></pre>
<p>Regular file operations are likewise simplified via nifty methods:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$list</span> <span class="operator">=</span> <span class="word">file</span><span class="structure">(</span><span class="words">qw/ home yanick xmas list /</span><span class="structure">);</span><br /><br /><span class="comment"># read the whole file, split it in lines<br /></span><span class="keyword">my</span> <span class="symbol">@wishlist</span> <span class="operator">=</span> <span class="symbol">$list</span><span class="operator">-></span><span class="word">slurp</span><span class="structure">;</span><br /><br /><span class="substitute">s/$/ pretty please/</span> <span class="word">for</span> <span class="symbol">@wishlist</span><span class="structure">;</span> <span class="comment"># doesn't hurt to be polite</span><br /><br /><span class="comment"># and write back to the file<br /></span><span class="symbol">$list</span><span class="operator">-></span><span class="word">spew</span><span class="structure">(</span><span class="symbol">@wishlist</span><span class="structure">);</span><br /><br /><span class="comment"># if one wants a filehandle...<br /></span><span class="keyword">my</span> <span class="symbol">$fh</span> <span class="operator">=</span> <span class="symbol">$list</span><span class="operator">-></span><span class="word">openr</span><span class="structure">;</span> <span class="comment"># open for reading</span><br /><span class="keyword">while</span><span class="structure">(</span><span class="keyword">my</span> <span class="symbol">$wish</span> <span class="operator">=</span> <span class="readline"><$fh></span><span class="structure">){</span><br /> <span class="word">say</span> <span class="double">"I want a $wish"</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="comment"># want to touch a file?<br /></span><span class="word">file</span><span class="structure">(</span><span class="single">'/home/santa/helpers/glug'</span><span class="structure">)</span><span class="operator">-></span><span class="word">touch</span><span class="structure">;</span><br /><br /><span class="comment"># or remove one?<br /></span><span class="word">file</span><span class="structure">(</span><span class="single">'/home/santa/helpers/Belsnickel'</span><span class="structure">)</span><span class="operator">-></span><span class="word">remove</span><span class="structure">;</span></code></pre>
<p>Trust me, once you begin using them, there'll be no going back. In fact, you'll probably wish they were also available as <a href="https://metacpan.org/module/Moose">Moose</a> types to use them everywhere natively.</p>
<p>And then you'll discover <a href="https://metacpan.org/module/MooseX::Types::Path::Class">MooseX::Types::Path::Class</a>, and the Christmas bells will be forevermore ringing.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Path::Class">Path::Class</a></p>
</li>
<li><p><a href="https://metacpan.org/module/MooseX::Types::Path::Class">MooseX::Types::Path::Class</a></p>
</li>
<li><p><a href="https://metacpan.org/module/File::Spec">File::Spec</a></p>
</li>
<li><p><a href="https://metacpan.org/module/File::Path">File::Path</a></p>
</li>
</ul>
</div>2012-12-01T00:00:00ZYanick Champoux