Perl Advent Calendar 2014http://perladvent.org/2014/2024-03-13T21:03:07ZMark FowlerXML::Atom::SimpleFeedSo here it is Merry Christmashttp://perladvent.org/2014/2014-12-25.html<div class='pod'><p>Another year of Perl Advent had drawn to a close, and what a year it's been. I hope you've enjoyed reading all the articles as much as I have.</p>
<h3 id="Everybodys-having-fun">Everybody's having fun</h3>
<p>Of course, just because Advent is over for another year, doesn't mean the gift of Perl modules has to end. As I write this there are one hundred and forty one thousand seven hundred and forty nine modules on the CPAN and each year we only get to publish twenty-four advent articles. So where can you read about the rest of these modules and other exciting things happening in Perl?</p>
<ul>
<li>You can search for Perl modules at <a href="https://metacpan.org/">metacpan</a>
where you can also see a list of <a href="https://metacpan.org/recent">recently
published modules</li><li><a href="http://cpanratings.perl.org/">CPAN Ratings</a> offers a ratings
and reviews of Perl modules. It's like a democatic advent calendar each day
of the year!</li>
<li>The <a href="http://perlweekly.com/">Perl Weekly</a> provides one small
succinct email a week with a summary of the interesting things happing in Perl
that week, including new modules, interesting articles and upcoming events.</li>
<li><a href="http://blogs.perl.org/">blogs.perl.org</a> hosts a vast number of
Perl blogs if you're looking for more articles to read throughout the year. The <a href="http://ironman.enlightenedperl.org/">
Perl Ironman Challenge</a> links to a lot more blogs as part of the <em>updating
your Perl blog weekly</em> challenge</li>
<li>You're reading the original programming article for advent advent calendar,
but if you like the format there's a whole collection of them available dedicated
to other aspects of Perl (e.g. <a href="http://www.catalystframework.org/calendar/2014">Catalyst</a>,
<a href="http://advent.perldancer.org/2014">Dancer</a>, <a href="http://perl6advent.wordpress.com/2014/">Perl 6</a>,
<a href="http://advent.perl.kr/2014/">Seoul.pm</a>, <a href="http://shadow.cat/blog/matt-s-trout/">MSTPAN</a>, and
<a href="http://blogs.perl.org/users/perlancar/2014/12/perlancars-2014-advent-calendar.html">perlancar</a>.) Other
languages have also adopted the format and <a href="http://www.lenjaffe.com/AdventPlanet/2014/">Advent Planet</a>
has a meta calendar that links to each entry for that day for over twenty
calendars</li>
<li>Of course, if you want more Perl Advent articles, there's always the
previous <a href="http://perladvent.org/archives.html">fourteen years of advent
calendar</a> to go through. Happy reading!</li>
</ul>
<p>The Perl Advent Calendar wouldn't be possible without the hard work of all the article authors. This year we owe thanks to Alex Balhatchet, Augustina Ragwitz, Dave Cross, Graham Ollis, John SJ Anderson, Legolas Greenleaf, Marcus Ramberg, Mark Allen, Mark Fowler, Neil Bowers, Nova Patch, Olaf Alders, Paul "LeoNerd" Evans and Ricardo Signes. These people not only devoted untold time writing and formatting their articles, but put up with me repeatedly hassling them with my self imposed deadlines and bugging them with copy corrections. Thank you for putting up with me.</p>
<p>Thanks also to everyone who submitted corrections, helped organize, setup hosting, debugged software issues, and otherwise did the unglamorous things that made the advent calendar happen.</p>
<h3 id="Look-to-the-future-now">Look to the future now</h3>
<p>As a Perl programmer reading the calendar chances are you have an article in you for publishing next year even if you don't know what it is yet. I encourage you to <s>subscribe to the <a href="http://mail.pm.org/mailman/listinfo/perladvent">mailing list</a></s> check the <a href="https://github.com/perladvent/Perl-Advent/">perladvent/Perl-Advent GitHub repo</a> where we organize all of this and simply drop us an email saying you'd be interested in writing (you'll get a follow up email from me in about eight months when we start working out scheduling for 2015.)</p>
<h3 id="Its-only-just-begun">It's only just begun</h3>
<p>Perl does a lot for you. It keeps you entertained, it makes your life easier, and chances are it keeps you employed. In this season of giving you might consider making a small donation to <a href="https://donate.perlfoundation.org/donate.html">The Perl Foundation</a> who do important work, including sponsoring developers to work full time on improving the core of Perl.</p>
<h3 id="Its-Christmas">It's Christmas!</h3>
<p>Merry Christmas, one and all.</p>
</div>2014-12-25T00:00:00ZMark FowlerOut of Order Perlhttp://perladvent.org/2014/2014-12-24.html<div class='pod'><p>This article will cover asynchronous programming with the AnyEvent library and will show use cases for managing multiple asynchronous requests in a single application. In addition, I hope to introduce good techniques for using metrics to drive technology decisions!</p>
<h3 id="Is-an-Asynchronous-Solution-right-for-me">Is an Asynchronous Solution right for me?</h3>
<p>New software techniques and practices are always rearing their heads in the industry. While asynchronous functionality is not new to Perl, it is not widely used where it could be, and maybe over-used where it shouldn't be. When considering whether or not to adopt some new methodology on existing software, it's important to make sure you have clearly identified what problem you are trying to solve. It's fine if you want to play around with something new, but remember that every solution has a cost. The cost of asynchronous functionality is that it can be difficult to read and debug (callback soup anyone?) and you have to consider compatibility of your current web framework as well as your current code base.</p>
<h4 id="Step-1:-Identify-the-Problem">Step 1: Identify the Problem</h4>
<blockquote>“70% of users are unable to download the TPS Report from the website because the
website times out.”</blockquote>
<blockquote>“Web site latency is reported for 75% of users.”</blockquote>
<h4 id="Step-2:-Identify-the-cause-to-clarify-the-problem-with-numbers">Step 2: Identify the cause to clarify the problem (with numbers!)</h4>
<p>To identify the cause, you can check logs, collect metrics (a lot of folks use statsd), or attempt to reproduce the problem in a staging environment.</p>
<blockquote>“The TPS report database query takes 30 seconds to run”</blockquote>
<blockquote>“Requests to HTTP services are averaging 1 second because each request is made individually and is only made once the previous request is complete.”</blockquote>
<h4 id="Step-3:-Propose-a-solution-based-on-data-and-facts">Step 3: Propose a solution (based on data and facts)</h4>
<p>Now that you've collected data and clarified your problem in terms of metrics, you can say "Asynchronous HTTP requests would reduce overall report loading time to only the amount of time it takes the longest request to return."</p>
<p>Implement a Solution based on your results... and use metrics to determine success There is a fully functioning sample application! The sample application from which the code snippets in this article come is located on <a href="http://github.com/missaugustina/perl-out-of-order">github</a>.</p>
<p>The sample application is a simple Mojolicious::Lite application the generates a “TPS” report. This report makes calls to 2 external services to collect data and then uses that data to make a complex call to the database. I'm just using simple timing metrics to show the results for each of the reports. You can run it yourself to see the results as it records them in the database. First Improvement: Make it Async!</p>
<p>As we ascertained from our problem statement exercise just now, kicking off HTTP requests at the same time would drastically improve our report's performance.</p>
<p>Here's how you currently use LWP to make HTTP requests:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$ua</span> <span class="operator">=</span> <span class="word">LWP::UserAgent</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="keyword">my</span> <span class="symbol">$req</span> <span class="operator">=</span> <span class="word">HTTP::Request</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">GET</span> <span class="operator">=></span> <span class="symbol">$url</span> <span class="structure">);</span><br /><br /><span class="comment"># make the request, and wait until we get the results back<br /></span><span class="keyword">my</span> <span class="symbol">$res</span> <span class="operator">=</span> <span class="symbol">$ua</span><span class="operator">-></span><span class="word">request</span><span class="structure">(</span><span class="symbol">$req</span><span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$content</span> <span class="operator">=</span> <span class="symbol">$res</span><span class="operator">-></span><span class="word">content</span><span class="structure">;</span><br /><span class="keyword">return</span> <span class="symbol">$content</span><span class="structure">;</span></code></pre>
<p>Here's how it looks in our sample application:</p>
<pre><code class="code-listing"><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$service_name</span><span class="operator">,</span> <span class="symbol">$url</span><span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span><span class="word">each</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">urls</span><span class="structure">}))</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$req</span> <span class="operator">=</span> <span class="word">HTTP::Request</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">GET</span> <span class="operator">=></span> <span class="symbol">$url</span> <span class="structure">);</span><br /> <span class="keyword">my</span> <span class="symbol">$res</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">_user_agent</span><span class="operator">-></span><span class="word">request</span><span class="structure">(</span><span class="symbol">$req</span><span class="structure">);</span><br /> <span class="keyword">my</span> <span class="symbol">$content</span> <span class="operator">=</span> <span class="symbol">$res</span><span class="operator">-></span><span class="word">content</span><span class="structure">;</span><br /> <span class="symbol">$http_data</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$service_name</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$content</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="keyword">return</span> <span class="symbol">$http_data</span><span class="structure">;</span></code></pre>
<p>Notice that these requests happen for EACH URL in our list for EACH row in the database results one after the other, waiting for the previous request to return before starting the next. If we have 10 URLs and each one takes 3 milliseconds, our total request takes 10 x 3 milliseconds or 30 milliseconds total. If one of them takes any more time than that, it will hold up processing of the others and makes our request take even longer.</p>
<p>There are a lot of asynchronous libraries in the CPAN for you to consider. I'm using AnyEvent because we're going to be talking to RabbitMQ later and AnyEvent::RabbitMQ is one of the better libraries for doing that. When considering what asynchronous library to use, you always need to think about your requirements and to determine if it's likely you'll be adding other asynchronous functionality. Swapping one out for another, however, isn't impossible as they all pretty much follow the same rules (they just call things by different names). What you'll learn here about how to use AnyEvent will also apply in concept to any other library you might want to use instead.</p>
<p>Here's what the asynchronous solution looks like in our sample application using AnyEvent::HTTP.</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 /><br /><span class="keyword">my</span> <span class="symbol">$result</span><span class="structure">;</span><br /><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span><br /><br /><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$service_name</span><span class="operator">,</span> <span class="symbol">$url</span><span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span><span class="word">each</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">urls</span><span class="structure">}))</span> <span class="structure">{</span><br /> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$request</span><span class="structure">;</span><br /><br /> <span class="symbol">$request</span> <span class="operator">=</span> <span class="word">http_request</span><span class="structure">(</span><br /> <span class="word">GET</span> <span class="operator">=></span> <span class="symbol">$url</span><span class="operator">,</span><br /> <span class="word">timeout</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># seconds</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$content</span><span class="operator">,</span> <span class="symbol">$headers</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="symbol">$result</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$service_name</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$content</span><span class="structure">;</span><br /><br /> <span class="core">undef</span> <span class="symbol">$request</span><span class="structure">;</span><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><br /><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 /><br /><span class="keyword">return</span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>Let's add a few more comments to try and make it a little clearer what's going on:</p>
<pre><code class="code-listing"><span class="comment"># A condition variable. Basically a mechanism to tell if we're done<br /># processing all the requests or not.<br /></span><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 /><br /><span class="keyword">my</span> <span class="symbol">$result</span><span class="structure">;</span><br /><br /><span class="comment"># tell the condition variable that it's not "ready" until it sees the "end"<br /># call at the end of the code signifying we're done setting up all the<br /># requests. This is good practice to avoid accidentally completing<br /># while we're still setting up all the requests.<br />#<br /># Also pass the code block that will be executed at this point when the<br /># condition variable is "ready".<br /></span><span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span><br /><br /><span class="comment"># for each of our urls, start a request in parallel<br /></span><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$service_name</span><span class="operator">,</span> <span class="symbol">$url</span><span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span><span class="word">each</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">urls</span><span class="structure">}))</span> <span class="structure">{</span><br /><br /><span class="comment"> # add another thing to the list of things that must be completed<br /> # before the condition variable is "ready". i.e. let the condition variable<br /> # know that we must wait until the HTTP request returns and the callback<br /> # calls a corresponding "end" on the condition variable before we're done.<br /></span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">;</span><br /><br /><span class="comment"> # schedule a HTTP request to made asynchronously. Once it's done<br /> # and we've got the content, call the callback.<br /></span> <span class="keyword">my</span> <span class="symbol">$request</span><span class="structure">;</span><br /> <span class="symbol">$request</span> <span class="operator">=</span> <span class="word">http_request</span><span class="structure">(</span><br /> <span class="word">GET</span> <span class="operator">=></span> <span class="symbol">$url</span><span class="operator">,</span><br /> <span class="word">timeout</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># seconds</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$content</span><span class="operator">,</span> <span class="symbol">$headers</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /><span class="comment"> # save the content for this request (i.e. what we downloaded) in our<br /> # result<br /></span> <span class="symbol">$result</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$service_name</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$content</span><span class="structure">;</span><br /><br /><span class="comment"> # clean ourselves up<br /></span> <span class="core">undef</span> <span class="symbol">$request</span><span class="structure">;</span><br /><br /><span class="comment"> # and let the condition variable know that this scheduled thing<br /> # is done and once the last one is done it can fire.<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><br /> <span class="structure">);</span><br /><span class="structure">}</span><br /><br /><span class="comment"># signify that we're done with stage of setting up all the requests. The<br /># condition variable become "ready" until all the requests that called "begin"<br /># above have also completed and called a corresponding number of "end" calls<br /></span><span class="symbol">$cv</span><span class="operator">-></span><span class="word">end</span><span class="structure">;</span><br /><br /><span class="comment"># wait (i.e. block) until the condition variable is ready, i.e. until a<br /># corresponding number of "end" calls have been called for each "begin" call<br /></span><span class="keyword">return</span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>We'll get back to this code, explaining in more depth each section of code bit by bit once we've learned a little more about AnyEvent.</p>
<p>First, let's look at the advantage of using this significantly more complicated code. With an asynchronous solution, if each request takes 3 milliseconds, then we get our results back in 3 milliseconds. If one of those requests takes 1 second, then we get all of our results back in 1 second. The time it takes to get our results back takes only as long as the longest request!</p>
<h3 id="What-does-it-mean-to-be-Asynchronous">What does it mean to be Asynchronous?</h3>
<h4 id="Asynchronous-code-is-event-driven">Asynchronous code is event-driven</h4>
<p>An event queue manages code execution. If you've ever had to do any work with user interfaces, you should be familiar with the notion of an event-listener. An event in a user interface would be a button click. You would register a function to execute when the the button is pushed. In our example, the function (callback) we've registered with the event we're interested in is pushed to an event queue that fires after all the other code executes. The event loop is a queue of callback functions. When an asynchronous function executes, the callback function is pushed into the event queue.</p>
<h4 id="Results-are-returned-in-the-background-while-your-application-does-other-things">Results are returned in the background while your application does other things</h4>
<p>The rest of your application proceeds ahead using a placeholder for the result until it reaches a point where it can't go any further without the actual result (for example writing that result out to a data store).</p>
<p>The basic formula for Async: <b>Event Loop + Listener + Callbacks</b></p>
<p>A listener registers your interest in a particular event. A callback is a function that runs when your request is in a <i>ready</i> state. No matter what Async library you use, all of them follow these rules.</p>
<p>Now we'll talk about more specifically what this looks like in the AnyEvent libraries.</p>
<h3 id="AnyEvent-101">AnyEvent 101</h3>
<h4 id="condvar"><code>condvar</code></h4>
<p>AnyEvent is just an abstraction layer on top of event loops. The <code>condvar()</code> method initializes the condition variable which represents a value that may or may not be available. The condition variable doesn't have a value until it is “ready”, meaning the request has completed. You use the <code>condvar()</code> method to interface with the event loop.</p>
<h4 id="send"><code>send</code></h4>
<p>The <code>send()</code> method sets the conditional variable to <i>ready</i>. This will indicate that one event is complete. In the case of multiple requests, you can bind a callback to <code>send()</code> so that you can store the values retrieved each time the condvar is in a ready state.</p>
<h4 id="recv"><code>recv</code></h4>
<p>This returns a value when the <code>condvar</code> is in a ready state. Note that this is blocking because this is called at the point where your program cannot continue until it has the value it needs. I'll show why this is important later when we introduce RabbitMQ and have to manage multiple asynchronous requests.</p>
<h4 id="begin-and-end"><code>begin</code> and <code>end</code></h4>
<p>These methods are syntactic sugar for using a counter within an event loop. Begin increments the counter and end decrements it. The event loops runs until the counter is at 0. You can use these methods when you're managing multiple requests within an event loop and you want to make sure the event loop doesn't terminate until all of the requests you want have finished.</p>
<p>If you were to implement this yourself, you could create a loop where you create a <code>condvar</code> for each individual request. This syntactic sugar lets you declare just one <code>condvar</code> and then specify when you want to set its ready state so <code>recv</code> can return the result.</p>
<h3 id="AnyEvent::HTTP-Code-Walkthrough">AnyEvent::HTTP Code Walkthrough</h3>
<p>Remember that code sample from earlier? Well now that we have a little better vocabulary, we can walk through it and understand what's happening in a little more detail, and hopefully understand how we came to write the code like that.</p>
<p>The first step is to initialize the <code>condvar</code>. Remember at this point, it has no actual value!</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></code></pre>
<p>Next, you need to determine what you want to return at the <i>ready</i> state and assign it. This is where async programming can get a little tricky (hence the title of this article)! You need to think backwards when you start thinking async. Think from the result and work your way back. Decide at what point your application absolutely needs this data and put your <code>recv</code> call there.</p>
<pre><code class="code-listing"><span class="operator">...</span><span class="word">all</span> <span class="word">the</span> <span class="word">other</span> <span class="word">code</span><span class="operator">...</span><br /><span class="keyword">return</span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>Now all we need to work out what code goes between these two statements. We need to figure out when to call the send event so we can capture our result. We're going to call it within a callback bound to a begin call. Each time we want to fetch data from a URL, we'll increment our event loop counter so that we don't exit out of the event loop before we've gotten a response for each of our URL requests. So, this means, in English: Once all the URLs are fetched, set the <code>condvar</code> to ready and return the result.</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">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span> <span class="comment"># <------------- we add this</span><br /><span class="operator">...</span><br /><span class="keyword">return</span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>Because we've declared a begin, we need to declare an end outside of the loop to ensure that send gets called. If our loop has no data (in the while block) we would loop forever without this call to end here. This ensures the send we registered with our begin up above gets called.</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">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span><br /><span class="operator">...</span><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">end</span><span class="structure">;</span> <span class="comment"># <------------- we add this</span><br /><span class="keyword">return</span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>Now that we've defined our start and end points, we can focus on the actual logic around retrieving the URLs. We're going to use the AnyEvent::HTTP library, in particular the <code>http_request</code> method. Calling <code>http_request</code> means that you want the request to be made whenever it's possible (versus a procedural call which would mean stop everything and do it right now). This registers an IO watcher and tells the event loop that we are interested in this IO event.</p>
<p>When the request finishes, we want to invoke the callback that we've bound to the function call.</p>
<p>This method doesn't actually do the request, it returns right away and tells the event loop to do the request whenever it can. When this chunk of code runs, the event loop is not running because this chunk of code has control.</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">$result</span><span class="structure">;</span><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span><br /><br /><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$service_name</span><span class="operator">,</span> <span class="symbol">$url</span><span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span><span class="word">each</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">urls</span><span class="structure">}))</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="word">my</span> <span class="symbol">$request</span><span class="structure">;</span> <span class="readline"><----<br /> $request = http_request( <----<br /> GET => $url, <---- we add<br /> timeout => 2, # seconds <---- all of<br /> sub { <---- this<br /> my ($content, $headers) = @_; <---- code<br /> $result->{$service_name} = $content; <----<br /> ...<br /> } <----<br /> ); <----<br />}<br /><br />$cv->end;<br />return $cv->recv;</span></code></pre>
<p>We need to unregister our interest in this event once we're done with it.</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">$result</span><span class="structure">;</span><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span><br /><br /><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$service_name</span><span class="operator">,</span> <span class="symbol">$url</span><span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span><span class="word">each</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">urls</span><span class="structure">}))</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="word">my</span> <span class="symbol">$request</span><span class="structure">;</span><br /> <span class="symbol">$request</span> <span class="operator">=</span> <span class="word">http_request</span><span class="structure">(</span><br /> <span class="word">GET</span> <span class="operator">=></span> <span class="symbol">$url</span><span class="operator">,</span><br /> <span class="word">timeout</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># seconds</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$content</span><span class="operator">,</span> <span class="symbol">$headers</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="symbol">$result</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$service_name</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$content</span><span class="structure">;</span><br /><br /> <span class="core">undef</span> <span class="symbol">$request</span><span class="structure">;</span> <span class="comment"># <------------- we add this</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="structure">);</span><br /> <span class="operator">...</span><br /><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="keyword">return</span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>The inner begin and end calls define the individual requests that we want to track in the event loop. For each begin, the AnyEvent event loop will increment a counter. For each end the AnyEvent event loop decrements the counter. Once the counter reaches 0, AnyEvent can set the <code>condvar</code> to <i>ready</i>.</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 /><br /><span class="keyword">my</span> <span class="symbol">$result</span><span class="structure">;</span><br /><br /><span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span><br /><br /><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$service_name</span><span class="operator">,</span> <span class="symbol">$url</span><span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span><span class="word">each</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">urls</span><span class="structure">}))</span> <span class="structure">{</span><br /> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">;</span> <span class="comment"># <------------- we add this</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$request</span><span class="structure">;</span><br /><br /> <span class="symbol">$request</span> <span class="operator">=</span> <span class="word">http_request</span><span class="structure">(</span><br /> <span class="word">GET</span> <span class="operator">=></span> <span class="symbol">$url</span><span class="operator">,</span><br /> <span class="word">timeout</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># seconds</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$content</span><span class="operator">,</span> <span class="symbol">$headers</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="symbol">$result</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$service_name</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$content</span><span class="structure">;</span><br /><br /> <span class="core">undef</span> <span class="symbol">$request</span><span class="structure">;</span><br /> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">end</span><span class="structure">;</span> <span class="comment"># <------------- and we add this</span><br /> <span class="structure">}</span><br /> <span class="structure">);</span><br /><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 /><br /><span class="keyword">return</span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">recv</span><span class="structure">;</span></code></pre>
<p>And that's it, we've got a working example!</p>
<h3 id="When-should-I-use-Asynchronous-Programming">When should I use Asynchronous Programming?</h3>
<p>An asynchronous solution works best for problems that meet all of the following criteria:</p>
<ul>
<li><p>You need to do many things that could take awhile</p>
</li>
<li><p>You don't care about the order you do those things in</p>
</li>
</ul>
<p>Given that an asynchronous solution can be hard to read and potentially hard to maintain, you should use metrics to determine if this added complexity really buys you anything.</p>
<h3 id="Next-Improvement:-Lets-create-a-work-queue">Next Improvement: Let's create a work queue!</h3>
<p>Work queues are good for throttling the work your application has to do, for scheduling when this work needs to happen, and is a good solution for anything that could potentially take a long time thus causing a timeout experience for the end user. To create a work queue, you need a message queue where one part of your application can post messages to (work to be done) and where another part of your application or a separate <i>worker</i> process can access the messages and perform the work.</p>
<p>You can throttle the database load by determining how many messages your worker handles at one time. This could be as simple as a while loop that pauses in between processing. You could also spin up more workers if your message queue gets too long. If you need to do massive updates to lots of records such that you don't want to do them at a peak time when the database indexes are constantly being updated due to a large number of writes, you can schedule your worker processes to run at an off-peak time. This can be as simple as a perl script you write and then use a cron job to schedule.</p>
<p>In our example, let's say our users all hit the database the same time every week for these reports. These reports hit the database pretty hard which causes timeouts for other users and reports to fail to complete. Again, before we jump into adding yet more complexity to our technology stack, we need to consider if this solution is the best one for our problem.</p>
<p>Other solutions could be to move our single database instance into a cluster, or to pre-compute the data into predictable date chunks. If we have a table that has a lengthy history we could look at windowing or partitioning of the table to limit the total results the query has to run against. Let's say in this situation, we don't have the resources to make changes to the database. Apparently that's another department and there's a lengthy red tape process we need to follow in order to get anything done in that regard. While that points to greater systemic problems at our example company, this does often reflect reality and we still need to come up with a solution.</p>
<p>Enter RabbitMQ. RabbitMQ runs as a separate process which the various Perl processes communicate with via AMQP (Advanced Message Queuing Protocol) and is implemented in Erlang. RabbitMQ essentially receives and forwards messages. You could also use Redis and the Redis::Requeue library for the same thing, but RMQ offers us an asynchronous option.</p>
<h3 id="What-does-Asynchronous-Programming-have-to-do-with-RabbitMQ">What does Asynchronous Programming have to do with RabbitMQ?</h3>
<p>Sockets are traditionally a blocking connection. The actual connection attempt blocks until the connection is available. So to connect to RabbitMQ, we would need to wait for the HTTP connection and we would need to be able to respond to error messages. AnyEvent is an asynchronous library and AnyEvent::RabbitMQ is the canonical Perl library for interacting with RabbitMQ.</p>
<p>The reason using an asynchronous connection with RabbitMQ is important is because RabbitMQ sends a heartbeat to determine if the connection is still active. Most web framework applications by their nature are blocking, code is only triggered when a specific request (usually via a URL route) is made.</p>
<p>Once the publisher has established a connection, RabbitMQ can create an exchange. This exchange handles all incoming updates and redistributes them to the available queues. Once the exchange is created, RabbitMQ can send messages.</p>
<p>If the web application does not respond to the RMQ heartbeat, RMQ will hang up on you thereby closing the connection. So unless you want to hang up and reconnect every time you want to send a message to RabbitMQ, you'll need to double check that your web framework has a way to respond to this heartbeat.</p>
<p>In the example code, I've chosen to use Mojolicious because Mojo::IO Loop handles multiple reactor backends.</p>
<h4 id="Step-1:-Replace-the-original-work-section-with-publishing-a-message-to-RabbitMQ">Step 1: Replace the original “work” section with publishing a message to RabbitMQ</h4>
<p>Some things to think about:</p>
<ul>
<li><p>do you need to keep a record of the queue data?</p>
</li>
<li><p>do you need to recreate the queue if the messages are lost?</p>
</li>
</ul>
<p>First we need to set up our RabbitMQ connection. This is in the <a href="https://github.com/missaugustina/perl-out-of-order/blob/master/worker-queue/bin/main.pl">main.pl</a> file of the worker queue version of the sample code.</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 /><br /><span class="keyword">my</span> <span class="symbol">$ar</span> <span class="operator">=</span> <span class="word">AnyEvent::RabbitMQ</span><span class="operator">-></span><span class="word">new</span><span class="operator">-></span><span class="word">load_xml_spec</span><span class="structure">()</span><span class="operator">-></span><span class="word">connect</span><span class="structure">(</span><br /> <span class="word">host</span> <span class="operator">=></span> <span class="single">'localhost'</span><span class="operator">,</span><br /> <span class="word">port</span> <span class="operator">=></span> <span class="number">5672</span><span class="operator">,</span><br /> <span class="word">user</span> <span class="operator">=></span> <span class="single">'guest'</span><span class="operator">,</span><br /> <span class="word">pass</span> <span class="operator">=></span> <span class="single">'guest'</span><span class="operator">,</span><br /> <span class="word">vhost</span> <span class="operator">=></span> <span class="single">'/'</span><span class="operator">,</span><br /> <span class="word">on_success</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="operator">...</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="operator">...</span><br /><span class="structure">);</span></code></pre>
<p>This essentially connects to the message queue and then calls the <code>on_success</code> callback. Inside this <code>on_success</code> callback we then open the channel:</p>
<pre><code class="code-listing"><span class="word">on_success</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$ar</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="symbol">$ar</span><span class="operator">-></span><span class="word">open_channel</span><span class="structure">(</span><br /> <span class="word">on_success</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="operator">...</span><br /> <span class="structure">);</span><br /><span class="structure">}</span><span class="operator">,</span></code></pre>
<p>And inside the <code>on_success</code> callback of the <code>open_channel</code> we have the bit of code that actually puts stuff on the message queue:</p>
<pre><code class="code-listing"><span class="word">on_success</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$channel</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /><span class="comment"> # use a named queue "reports"<br /></span> <span class="symbol">$channel</span><span class="operator">-></span><span class="word">declare_queue</span><span class="structure">(</span><br /> <span class="word">queue</span> <span class="operator">=></span> <span class="single">'reports'</span><span class="operator">,</span><br /> <span class="word">auto_delete</span> <span class="operator">=></span> <span class="number">0</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><br /><span class="comment"> # publish (send) to the message queue<br /></span> <span class="keyword">my</span> <span class="symbol">%publish_args</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="word">header</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">content_type</span> <span class="operator">=></span> <span class="single">'application/json'</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">body</span> <span class="operator">=></span> <span class="word">encode_json</span><span class="structure">(</span><span class="symbol">$params</span><span class="structure">)</span><span class="operator">,</span><br /> <span class="word">routing_key</span> <span class="operator">=></span> <span class="single">'reports'</span><span class="operator">,</span><br /> <span class="structure">);</span><br /> <span class="symbol">$channel</span><span class="operator">-></span><span class="word">publish</span><span class="structure">(</span><span class="symbol">%publish_args</span><span class="structure">);</span><br /><br /><span class="comment"> # and update the condition variable to say we're done with the<br /> # queue sending part<br /></span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="double">"Added report request to queue"</span><span class="structure">);</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="operator">...</span></code></pre>
<h4 id="Step-2:-Move-the-work-to-a-worker-process">Step 2: Move the <i>work</i> to a worker process</h4>
<p>Now we've got something requesting work, we need a worker on the other end of the message queue actually doing the work.</p>
<p>You can schedule your worker as a cron job which works with RabbitMQ because there isn't any overstepping if the previous job hasn't finished yet. You can also use AnyEvent::timer on a loop if you aren't a fan of cron jobs. There a quite a few options for running your worker process on a schedule, the sample application just uses a simple Perl script with the idea that it would be a cron job.</p>
<p>The worker will need to take a message, process it, then grab the next one. You can have as many of these running as you want depending on your work load. To determine your work load, log metrics and keep an eye on them. Don't make assumptions that aren't based on actual data!</p>
<p>We'll use the <code>consume()</code> method to get the next message in the message queue. Once we get the message, we get the delivery tag for communication with the queue later. The payload is the queue item content. In our example we have this encoded in JSON so we need to decode it to do anything with it. This code can be found in the <a href="https://github.com/missaugustina/perl-out-of-order/blob/master/worker-queue/bin/report_worker.pl">report_worker.pl</a> file.</p>
<pre><code class="code-listing"><span class="comment"># connect to the message queue as in the previous example<br /></span><span class="symbol">$ar</span><span class="operator">-></span><span class="word">open_channel</span><span class="structure">(</span><br /> <span class="word">on_success</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$channel</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="operator">...</span><br /><br /><span class="comment"> # consume (read) messages when they arrive<br /></span> <span class="symbol">$channel</span><span class="operator">-></span><span class="word">consume</span><span class="structure">(</span><br /> <span class="word">on_consume</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">$message</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$frame</span> <span class="operator">=</span> <span class="symbol">$message</span><span class="operator">-></span><span class="structure">{</span><span class="word">deliver</span><span class="structure">}</span><span class="operator">-></span><span class="word">method_frame</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$delivery_tag</span> <span class="operator">=</span> <span class="symbol">$frame</span><span class="operator">-></span><span class="word">delivery_tag</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$params</span> <span class="operator">=</span> <span class="word">decode_json</span><span class="structure">(</span><span class="symbol">$message</span><span class="operator">-></span><span class="structure">{</span><span class="word">body</span><span class="structure">}</span><span class="operator">-></span><span class="word">payload</span><span class="structure">);</span><br /><br /><span class="comment"> # do work specified in %params...<br /></span><br /><span class="comment"> # confirm that we've done the work and the message<br /> # queue can drop the message<br /></span> <span class="symbol">$channel</span><span class="operator">-></span><span class="word">ack</span><span class="structure">(</span><span class="word">delivery_tag</span> <span class="operator">=></span> <span class="symbol">$delivery_tag</span><span class="structure">);</span><br /><br /> <span class="structure">}</span><br /> <span class="structure">);</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<h3 id="The-Gotcha">The Gotcha</h3>
<p>Here's what the work looks like in the <i>do work</i> section mentioned above. We create a ReportBuilder instance and tell it to build the report.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$report_builder</span> <span class="operator">=</span> <span class="word">Poo::ReportBuilder</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="keyword">my</span> <span class="symbol">$report</span> <span class="operator">=</span> <span class="symbol">$report_builder</span><span class="operator">-></span><span class="word">build_report</span><span class="structure">(</span><span class="symbol">$params</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$report_json</span> <span class="operator">=</span> <span class="word">encode_json</span><span class="structure">(</span><span class="symbol">$report_data</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$report</span> <span class="operator">=</span> <span class="word">Poo::Report</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="cast">\</span><span class="symbol">%params</span><span class="structure">)</span><span class="operator">-></span><span class="word">save</span><span class="structure">;</span></code></pre>
<p>Now here's the gotcha, and this is an easy mistake to make when you're first dealing with asynchronous programming: Remember that our <code>build_report</code> function itself uses AnyEvent::HTTP to build the reports - to run more than one web request at a time - and we didn't write it in a way that plays well with the AnyEvent code we just wrote to deal with the message queue.</p>
<p>If you were to run this code as is, you would get the following error:</p>
<pre><code> AnyEvent::CondVar: recursive blocking wait attempted at ../lib/Poo/ReportBuilder.pm line 238</code></pre>
<p>For reference, I've implemented this in the <a href="https://github.com/missaugustina/perl-out-of-order/tree/master/async">async</a> version of the application in Github with a comment explaining to not do that. Use that code to play around with adding another asynchronous call (say by adding the RabbitMQ code) and seeing what happens.</p>
<p>Remember, we have to call <code>recv</code> at the point in our code when we absolutely need the result to continue: Because our program cannot continue until this method returns something, <code>recv()</code> is considered a blocking function, but we don't want to block in the middle of generating a report - we need to be going back to the event loop in order to respond to those heartbeats!</p>
<p><code>recv</code> always needs to be at the top level. We need to use callbacks at the highest level, not the <code>condvar</code>. Anything that depends on any return value shouldn't depend on a variable, it should bind to a callback.</p>
<p>This is also why asynchronous programming can be very confusing and also very hard to maintain and debug. There are some techniques to improve this workflow, including Promises or Futures, but that's outside of the scope of this article. I do encourage you to research them though as they are reasonable solutions for dealing with callback soup.</p>
<p>Our original build_report method had this code:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">build_report</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="word">my</span> <span class="symbol">$http_data</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">_get_data_from_urls</span><span class="structure">(</span> <span class="cast">\</span><span class="symbol">%urls_list</span> <span class="structure">);</span><br /><br /><span class="comment"> # do stuff with $http_data...<br /></span><span class="structure">}</span></code></pre>
<p>We need to change this to bind to a callback so a caller can manage their own <code>condvar</code> and their own <code>recv</code> call.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">build_report</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">_get_data_from_urls</span><span class="structure">(</span><br /> <span class="cast">\</span><span class="symbol">%urls_list</span><span class="operator">,</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /><span class="comment"> # do stuff with $http_data...<br /></span> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>We'll alter the <code>_get_data_from_urls()</code> method by removing the <code>recv</code> method and by using the <code>cb</code> method instead. Whenever it completes and something is sent to the <code>condvar</code>, the <code>cb</code> method of the <code>condvar</code> calls the specified function as soon as it completes. The caller is responsible for providing a callback.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">_get_data_from_urls</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$urls</span> <span class="operator">=</span> <span class="core">shift</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 /><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 /><br /> <span class="keyword">my</span> <span class="symbol">$result</span><span class="structure">;</span><br /><br /> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="core">shift</span><span class="operator">-></span><span class="word">send</span><span class="structure">(</span><span class="symbol">$result</span><span class="structure">)</span> <span class="structure">});</span><br /><br /> <span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$customerid</span><span class="operator">,</span> <span class="symbol">$urls</span><span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span><span class="word">each</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$urls</span><span class="structure">}))</span> <span class="structure">{</span><br /> <span class="keyword">for</span> <span class="keyword">my</span> <span class="symbol">$service_name</span> <span class="structure">(</span><span class="word">keys</span> <span class="cast">%</span><span class="structure">{</span><span class="symbol">$urls</span><span class="structure">})</span> <span class="structure">{</span><br /> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">begin</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$request</span><span class="structure">;</span><br /><br /> <span class="symbol">$request</span> <span class="operator">=</span> <span class="word">http_request</span><span class="structure">(</span><br /> <span class="word">GET</span> <span class="operator">=></span> <span class="symbol">$urls</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$service_name</span><span class="structure">}</span><span class="operator">,</span><br /> <span class="word">timeout</span> <span class="operator">=></span> <span class="number">2</span><span class="operator">,</span> <span class="comment"># seconds</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$body</span><span class="operator">,</span> <span class="symbol">$hdr</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="symbol">$result</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$customerid</span><span class="structure">}</span><span class="operator">-></span><span class="structure">{</span><span class="symbol">$service_name</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$body</span><span class="structure">;</span><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><br /> <span class="structure">}</span><br /> <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 /><br /><span class="comment"> # this replaces "my $http_result = $cv->recv;" # <--<br /> # now the condition variable calls the callback when it # <-- new<br /> # reaches the ready state # <-- code<br /></span> <span class="symbol">$cv</span><span class="operator">-></span><span class="word">cb</span><span class="structure">(</span><span class="symbol">$callback</span><span class="structure">);</span> <span class="comment"># <--</span><br /><span class="structure">}</span></code></pre>
<h3 id="Sample-Code-Available">Sample Code Available</h3>
<p>Again, I want to reiterate, I have <a href="https://github.com/missaugustina/perl-out-of-order/">sample code</a> available for you to download and play with. Please experiment with this, try setting different values and using your debugger to step through the code to see when things get called and what values they produce. Asynchronous programming isn't something you really understand until you have to use it, and it's worth understanding.</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="http://github.com/missaugustina/perl-out-of-order">Sample code</a></p>
</li>
<li><p><a href="https://www.youtube.com/watch?v=VYBLCvMu_pA">YAPC::NA talk video</a></p>
</li>
<li><p><a href="https://metacpan.org/module/AnyEvent::HTTP">AnyEvent::HTTP</a></p>
</li>
<li><p><a href="https://metacpan.org/module/AnyEvent::RabbitMQ">AnyEvent::RabbitMQ</a></p>
</li>
<li><p><a href="http://www.rabbitmq.com/">http://www.rabbitmq.com/</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Promises">Promises</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Future">Future</a></p>
</li>
</ul>
</div>2014-12-24T00:00:00ZAugustina RagwitzCLDR TL;DRhttp://perladvent.org/2014/2014-12-23.html<div class='pod'><p>2014 has been an exciting year for CLDR development on the CPAN. But first, what is the CLDR? The <a href="http://cldr.unicode.org/">Unicode Common Locale Data Repository</a> is a standardized repository of locale data along with a specification for its use and implementation. The simplest use case is easy access to translations for use in user interfaces, including month and day names, country and language names, and units of measure such as hours, bytes, meters, and even furlongs. More complex uses include localized ranges of dates using the local calendaring and numbering systems.</p>
<p>The <a href="http://www.unicode.org/reports/tr35/">CLDR specification</a>, however, is increasingly complex and the amount of data is increasingly large. This makes sense because natural languages are complex and each release supports additional minority locales. Fortunately, the CPAN has had more CLDR-based development this year than ever before. This means you don’t have to worry about reading complex specifications or manually parsing large XML data structures.</p>
<h3 id="What-are-locales">What are locales?</h3>
<p>There are two parts to a locale: an identifier and data. The identifier is used to specify user preferences, generally based on languages and regions. The simplest locale is a language code alone, such as <b>es</b> for Spanish and <b>zh</b> for Chinese. Including the user’s country in the locale can provide additional valuable information. For example there are many differences in displaying dates and even numbers between European Spanish (<b>es-ES</b>) and Mexican Spanish (<b>es-MX</b>). Much additional information can be explicitly included in the locale, but most of the time it’s implicitly derived from the language and region. For example, many locales default to the Gregorian calendar while some to the Buddhist calendar or others; <b>zh-CN</b> defaults to Simplified Han script while <b>zh-TW</b> defaults to Traditional Han. However, if you want to get really explicit, you could say <b>tlh-Hira-AQ-u-ca-julian-nu-roman</b> for Klingon in the Hiragana script as used in Antarctica with the Julian calendar and Roman numerals.</p>
<p>Whenever possible, include the user’s language and country when constructing a locale identifier in order to provide the most localized experience.</p>
<p>Now let’s take a tour of some simple solutions to common localization problems using CPAN modules.</p>
<h3 id="CLDR::Number">CLDR::Number</h3>
<p><a href="https://metacpan.org/module/CLDR::Number">CLDR::Number</a> is a new module that become stable early this year and provides localized formatting of numbers, prices, and even percents and ranges of numbers. Full disclosure: I wrote this module and it powers Shutterstock in 20 languages, 150+ countries, and many currencies.</p>
<p>Here’s an example of formatting numbers:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">CLDR::Number</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$cldr</span> <span class="operator">=</span> <span class="word">CLDR::Number</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="word">locale</span> <span class="operator">=></span> <span class="symbol">$locale</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$decf</span> <span class="operator">=</span> <span class="symbol">$cldr</span><span class="operator">-></span><span class="word">decimal_formatter</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="double">"$locale: "</span><span class="operator">,</span> <span class="symbol">$decf</span><span class="operator">-></span><span class="word">format</span><span class="structure">(</span><span class="float">123456.7</span><span class="structure">);</span></code></pre>
<p>Now let’s see the results in European Spanish, Mexican Spanish, and Bengali:</p>
<ul>
<li><p>es-ES: 123 456,7</p>
</li>
<li><p>es-MX: 123,456.7</p>
</li>
<li><p>bn-IN: ১,২৩,৪৫৬.৭</p>
</li>
</ul>
<p>This demonstrates that both the language and the country can significantly change the results of basic number formatting. Now let’s see this applied to prices in different currencies.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$curf</span> <span class="operator">=</span> <span class="symbol">$cldr</span><span class="operator">-></span><span class="word">currency_formatter</span><span class="structure">(</span><span class="word">currency_code</span> <span class="operator">=></span> <span class="symbol">$currency</span><span class="structure">);</span><br /><br /><span class="word">say</span> <span class="double">"$locale / $currency: "</span><span class="operator">,</span> <span class="symbol">$curf</span><span class="operator">-></span><span class="word">format</span><span class="structure">(</span><span class="float">9.99</span><span class="structure">);</span></code></pre>
<p>Here are the results in American English and Canadian English for both US Dollars and Canadian Dollars.</p>
<ul>
<li><p>en-US / USD: $9.99</p>
</li>
<li><p>en-CA / USD: US$9.99</p>
</li>
<li><p>en-CA / CAD: $9.99</p>
</li>
<li><p>en-US / CAD: CA$9.99</p>
</li>
</ul>
<p>This demonstrates that localized formatting is important even when your only supported language is English. When it comes to currency formatting, the language, country, and currency each can significantly change the results.</p>
<h3 id="Locale::CLDR">Locale::CLDR</h3>
<p><a href="https://metacpan.org/module/Locale::CLDR">Locale::CLDR</a> is another new module released earlier this year by John Imrie, with the goal of providing access to all of the CLDR via locale objects—an impressive task!</p>
<p>Different locales use different punctuation and this is commonly ignored even in applications with translations in many languages. Fortunately, Locale::CLDR makes this aspect of localization easy.</p>
<p>Here is a simple solution to formatting a list of strings for the user:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Locale::CLDR</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$cldr</span> <span class="operator">=</span> <span class="word">Locale::CLDR</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="symbol">$locale</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">@gifts</span> <span class="operator">=</span> <span class="words">qw( foo bar baz )</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="double">"$locale: "</span><span class="operator">,</span> <span class="symbol">$cldr</span><span class="operator">-></span><span class="word">list</span><span class="structure">(</span><span class="word">map</span> <span class="structure">{</span> <span class="symbol">$cldr</span><span class="operator">-></span><span class="word">quote</span><span class="structure">(</span><span class="magic">$_</span><span class="structure">)</span> <span class="structure">}</span> <span class="symbol">@gifts</span><span class="structure">);</span></code></pre>
<p>The <code>quote</code> method is used to quote each element and the <code>list</code> method is used to format the entire list. Let’s take a look at the results in Portuguese, French, and Urdu.</p>
<ul>
<li><p>pt: “foo”, “bar” e “baz”</p>
</li>
<li><p>fr: «foo», «bar» et «baz»</p>
</li>
<li><p>ur: ”foo“، ”bar“، اور ”baz“</p>
</li>
</ul>
<p>Note that for support of all locales, you currently have to use the Locale::CLDR v0.25.x release on CPAN instead of v0.26.x because the latter is in the process of being broken into locale bundles and that work is ongoing.</p>
<h3 id="New-year-new-development">New year, new development</h3>
<p>We’ve had a great year for Perl localization and I hope 2015 will be even better. Once the most important <a href="https://metacpan.org/module/CLDR::Number::TODO">CLDR::Number::TODO</a> tasks are completed, <a href="https://metacpan.org/module/DateTime::Locale">DateTime::Locale</a> will receive some much needed love. The top gift on my wishlist is a Perl wrapper for <a href="http://site.icu-project.org/">ICU4C</a> (International Components for Unicode), which is a mature project providing full CLDR support. I’m confident that if I continue to fill my uncle’s boots with coleslaw on Yaksmas Eve, the Gilded Yak may finally deliver.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Locales">Locales</a> provides much of the basic CLDR data, such as names of countries and languages.</p>
</li>
<li><p><a href="https://metacpan.org/module/DateTime">DateTime</a> provides CLDR-based formatting using <a href="https://metacpan.org/module/DateTime::Locale">DateTime::Locale</a>.</p>
</li>
<li><p><a href="https://metacpan.org/module/Geo::Region">Geo::Region</a> provides UN M.49 and CLDR geographical region and grouping data.</p>
</li>
</ul>
</div>2014-12-23T00:00:00ZNova PatchA Holiday PAPR-ationhttp://perladvent.org/2014/2014-12-22.html<div class='pod'><p>Jesse, Junior IT Elf Second Class grumbled to himself, "Who even thought this was a good idea anyway." He had grabbed a ticket out of the North Pole's ticketing system, thinking that adding a simple new endpoint to an existing RESTful API would be a fairly trivial task. He had hoped to get out of the office early today, and instead he was staring at a creeping horror and the possibility of working all weekend.</p>
<p>Clearly, the code had originally started out as a very simple API of only a few endpoints. The original coder, either being in a hurry or just not knowing any better, had decided to implement it as a series of <code> if </code>-<code> elsif </code>-<code> else </code> blocks based on the first element in the URL string.</p>
<p>Now, 10 years later, there were dozens of <code> elsif </code> blocks, each with its own specialized handling of the subsequent parts of the URL. There was no overall organization to the code -- it seemed as if every time a new endpoint was required, the elf doing the work had just slapped in an <code> elsif </code> block whereever they felt like. The end result now had a structure something like this (only much worse -- the example is sanitized for a family audience):</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">CGI</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$cgi</span> <span class="operator">=</span> <span class="word">CGI</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><br /><span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$first</span> <span class="operator">,</span> <span class="symbol">@rest</span> <span class="structure">)</span> <span class="operator">=</span> <span class="symbol">$cgi</span><span class="operator">-></span><span class="word">path_info</span><span class="structure">();</span><br /><br /><span class="comment"># /present/present_id/action<br /></span><span class="keyword">if</span><span class="structure">(</span> <span class="symbol">$first</span> <span class="operator">eq</span> <span class="single">'present'</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$action</span> <span class="structure">)</span> <span class="operator">=</span> <span class="symbol">@rest</span><span class="structure">;</span><br /> <span class="word">validate_present_id</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="structure">)</span> <span class="operator">or</span> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad id"</span><span class="structure">);</span><br /> <span class="keyword">if</span><span class="structure">(</span> <span class="symbol">$action</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$ENV</span><span class="structure">{</span><span class="word">REQUEST_METHOD</span><span class="structure">}</span> <span class="operator">eq</span> <span class="single">'POST'</span><span class="structure">;</span><br /> <span class="symbol">$action</span> <span class="operator">=~</span> <span class="match">/^(add|update|delete)$/</span> <span class="operator">or</span> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad action"</span><span class="structure">);</span><br /> <span class="word">_handle_present_update</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$action</span> <span class="structure">);</span><br /> <span class="structure">}</span><br /> <span class="keyword">else</span> <span class="structure">{</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$ENV</span><span class="structure">{</span><span class="word">REQUEST_METHOD</span><span class="structure">}</span> <span class="operator">eq</span> <span class="single">'GET'</span><span class="structure">;</span><br /> <span class="word">_handle_present_get</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="structure">)</span><br /> <span class="structure">}</span><br /><span class="structure">}</span><br /><span class="comment"># /good_child/child_id/reason<br /></span><span class="keyword">elsif</span><span class="structure">(</span> <span class="symbol">$first</span> <span class="operator">eq</span> <span class="single">'good_child'</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$reason</span> <span class="structure">)</span> <span class="operator">=</span> <span class="symbol">@rest</span><span class="structure">;</span><br /> <span class="word">validate_child_id</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="structure">)</span> <span class="operator">or</span> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad id"</span><span class="structure">);</span><br /> <span class="word">validate_reason</span><span class="structure">(</span> <span class="symbol">$reason</span><span class="structure">)</span> <span class="operator">or</span> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad reason"</span><span class="structure">);</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$ENV</span><span class="structure">{</span><span class="word">REQUEST_METHOD</span><span class="structure">}</span> <span class="operator">eq</span> <span class="single">'POST'</span><span class="structure">;</span><br /> <span class="word">_handle_child_update</span><span class="structure">(</span> <span class="single">'good_child'</span> <span class="operator">,</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$reason</span> <span class="structure">);</span><br /><span class="structure">}</span><br /><span class="comment"># /bad_child/child_id/reason<br /></span><span class="keyword">elsif</span><span class="structure">(</span> <span class="symbol">$first</span> <span class="operator">eq</span> <span class="single">'bad_child'</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$reason</span> <span class="structure">)</span> <span class="operator">=</span> <span class="symbol">@rest</span><span class="structure">;</span><br /> <span class="word">validate_child_id</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="structure">)</span> <span class="operator">or</span> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad id"</span><span class="structure">);</span><br /> <span class="word">validate_reason</span><span class="structure">(</span> <span class="symbol">$reason</span><span class="structure">)</span> <span class="operator">or</span> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad reason"</span><span class="structure">);</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$ENV</span><span class="structure">{</span><span class="word">REQUEST_METHOD</span><span class="structure">}</span> <span class="operator">eq</span> <span class="single">'POST'</span><span class="structure">;</span><br /> <span class="word">_handle_child_update</span><span class="structure">(</span> <span class="single">'bad_child'</span> <span class="operator">,</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$reason</span> <span class="structure">);</span><br /><span class="structure">}</span><br /><span class="keyword">else</span> <span class="structure">{</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"no match!"</span><span class="structure">)</span><br /><span class="structure">}</span></code></pre>
<p>As Jesse sat and stared at screen after screen of cascading conditionals, grumbling and muttering to himself, his boss Margaret walked by and asked, "What's going on, Jesse?"</p>
<p>Jesse started to rant about the API code, but Margaret cut him off quickly. "Listen, didn't you see the last memo that came out from the Big Guy? We're supposed to be replacing all those old CGIs with PSGIs when ever we have to make any changes to them. This is your lucky day, Junior! You get to clean up this mess. But we've got apps deployed in the field that rely on this API, so make sure you don't change any of the endpoints while you're porting it over, or there will be heck to pay."</p>
<p>"Fine", Jesse sighed. "I guess I can go on <a href="https://metacpan.org/">MetaCPAN</a> and research the best way to..."</p>
<p>Margaret cut him off again. "No need, kid. Just use PAPR -- <a href="https://metacpan.org/module/Plack::App::Path::Router">Plack::App::Path::Router</a>!"</p>
<p>Jesse sighed again as he pulled up the documentation on MetaCPAN. He learned that <a href="https://metacpan.org/module/Plack::App::Path::Router">Plack::App::Path::Router</a> provides a convenient way to take a <a href="https://metacpan.org/module/Path::Router">Path::Router</a> specification and wrap it up as a PSGI. Jesse was quickly able to turn the existing conditional cascade into a much more declarative set of <code> add_route </code> statements. He also quickly realized that he could replace all the custom validation routines in the old code with <code>Path::Router</code>'s parameter extraction and <a href="https://metacpan.org/module/Moose">Moose</a>-style validations.</p>
<p>Within a few hours, Jesse had converted all the old style code to a form that looked like this:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Plack::App::Path::Router</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Router</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$router</span> <span class="operator">=</span> <span class="word">Path::Router</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="comment"># note - formerly handled by a single conditional stanza; now split into two<br /></span><span class="symbol">$router</span><span class="operator">-></span><span class="word">add_route</span><span class="structure">(</span> <span class="single">'/present/:present_id'</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">validations</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">present_id</span> <span class="operator">=></span> <span class="single">'Int'</span> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="word">target</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /><span class="comment"> # $request is a L<Plack::Request> object<br /></span> <span class="keyword">my</span><span class="structure">(</span> <span class="symbol">$request</span> <span class="operator">,</span> <span class="symbol">$id</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">method</span><span class="structure">()</span> <span class="operator">eq</span> <span class="single">'GET'</span><span class="structure">;</span><br /> <span class="word">_handle_present_get</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="structure">)</span><br /> <span class="structure">}</span><br /><span class="structure">));</span><br /><br /><span class="symbol">$router</span><span class="operator">-></span><span class="word">add_route</span><span class="structure">(</span> <span class="single">'/present/:present_id/:action'</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">validations</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">present_id</span> <span class="operator">=></span> <span class="single">'Int'</span> <span class="operator">,</span><br /> <span class="word">action</span> <span class="operator">=></span> <span class="regexp">qr/^(add|update|delete)$/</span> <span class="operator">,</span> <span class="comment"># validations can also be plain regexps</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">target</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">$request</span> <span class="operator">,</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$action</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">method</span><span class="structure">()</span> <span class="operator">eq</span> <span class="single">'POST'</span><span class="structure">;</span><br /> <span class="word">_handle_present_update</span><span class="structure">(</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$action</span> <span class="structure">);</span><br /> <span class="structure">}</span><br /><span class="structure">));</span><br /><br /><span class="comment"># covers both /good_child/ and /bad_child/ endpoints<br /></span><span class="symbol">$router</span><span class="operator">-></span><span class="word">add_route</span><span class="structure">(</span> <span class="single">'/:child_type/:child_id/:reason'</span> <span class="structure">)</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">validations</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">child_type</span> <span class="operator">=></span> <span class="regexp">qr/^(good|bad)_child/</span> <span class="operator">,</span><br /> <span class="word">child_id</span> <span class="operator">=></span> <span class="single">'Int'</span> <span class="operator">,</span><br /> <span class="word">reason</span> <span class="operator">=></span> <span class="single">'Str'</span> <span class="operator">,</span><br /> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="word">target</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">$request</span> <span class="operator">,</span> <span class="symbol">$type</span> <span class="operator">,</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$reason</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">method</span><span class="structure">()</span> <span class="operator">eq</span> <span class="single">'POST'</span><span class="structure">;</span><br /> <span class="word">_handle_child_update</span><span class="structure">(</span> <span class="symbol">$type</span> <span class="operator">,</span> <span class="symbol">$id</span> <span class="operator">,</span> <span class="symbol">$reason</span> <span class="structure">);</span><br /> <span class="structure">}</span><br /><span class="structure">));</span><br /><br /><span class="comment"># now create the Plack app<br /></span><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="word">Plack::App::Path::Router</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">router</span> <span class="operator">=></span> <span class="symbol">$router</span> <span class="structure">);</span></code></pre>
<p>He commited his changes, and then added in one more change that added the new endpoint that had originally started him down this path. Work all done, he pushed his branch, and moved the ticket into the code review stage. While it had taken him a little longer than he expected, it still looked like he'd be done early.</p>
<p>As he made one last scan over his email, Jesse realized that Margaret had already responded to his code review request ... and worse, she'd rejected his changes! She was asking for something that was more data-driven and didn't have so much boilerplate code. Her suggestion was to look at <a href="https://metacpan.org/module/Plack::App::Path::Router::Custom">Plack::App::Path::Router::Custom</a> -- which Jesse dutifully pulled up on MetaCPAN. After a few minutes of reading, he saw exactly what she was talking about. He rapidly converted the previous version into this completely data-driven form:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Path::Router</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Plack::App::Path::Router</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Plack::Request</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">SantasWorkshop::API</span><span class="structure">;</span> <span class="comment"># all the '_handle' methods were migrated to here</span><br /><br /><span class="comment"># each entry is 'route definition' => 'method' => 'hashref of options'<br /></span><span class="keyword">my</span> <span class="symbol">@routes</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="structure">[</span> <span class="single">'/present/:present_id'</span> <span class="operator">=></span> <span class="single">'handle_present_get'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">methods</span> <span class="operator">=></span> <span class="structure">{</span> <span class="single">'GET'</span> <span class="operator">=></span> <span class="number">1</span> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="word">validations</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">present_id</span> <span class="operator">=></span> <span class="single">'Int'</span> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="structure">}]</span> <span class="operator">,</span><br /><br /> <span class="structure">[</span> <span class="single">'/present/:present_id/:action'</span> <span class="operator">=></span> <span class="single">'handle_present_update'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">methods</span> <span class="operator">=></span> <span class="structure">{</span> <span class="single">'POST'</span> <span class="operator">=></span> <span class="number">1</span> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="word">validations</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">present_id</span> <span class="operator">=></span> <span class="single">'Int'</span> <span class="operator">,</span><br /> <span class="word">action</span> <span class="operator">=></span> <span class="regexp">qr/^(add|update|delete)$/</span> <span class="operator">,</span> <span class="comment"># validations can also be plain regexpsld</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">}]</span> <span class="operator">,</span><br /><br /><span class="comment"> # covers both /good_child/ and /bad_child/ endpoints<br /></span> <span class="structure">[</span> <span class="single">'/:child_type/:child_id/:reason'</span> <span class="operator">=></span> <span class="single">'handle_child_update'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">methods</span> <span class="operator">=></span> <span class="structure">{</span> <span class="single">'POST'</span> <span class="operator">=></span> <span class="number">1</span> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="word">validations</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">child_type</span> <span class="operator">=></span> <span class="regexp">qr/^(good|bad)_child/</span> <span class="operator">,</span><br /> <span class="word">child_id</span> <span class="operator">=></span> <span class="single">'Int'</span> <span class="operator">,</span><br /> <span class="word">reason</span> <span class="operator">=></span> <span class="single">'Str'</span> <span class="operator">,</span><br /> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="structure">}]</span> <span class="operator">,</span><br /><span class="structure">)</span><br /><br /><span class="comment"># dynamically build the routing table based on the @routes data structure<br /></span><span class="keyword">my</span> <span class="symbol">$router</span> <span class="operator">=</span> <span class="word">Path::Router</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="keyword">foreach</span> <span class="structure">(</span><span class="symbol">@routes</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span> <span class="symbol">$endpoint</span><span class="operator">,</span> <span class="symbol">$action</span><span class="operator">,</span> <span class="symbol">$options</span> <span class="structure">)</span> <span class="operator">=</span> <span class="cast">@</span><span class="magic">$_</span><span class="structure">;</span><br /><br /> <span class="symbol">$router</span><span class="operator">-></span><span class="word">add_route</span><span class="structure">(</span> <span class="symbol">$endpoint</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">target</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">$request</span><span class="operator">,</span> <span class="symbol">@rest</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="word">exists</span> <span class="symbol">$options</span><span class="operator">-></span><span class="structure">{</span><span class="word">methods</span><span class="structure">}</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$request_method</span> <span class="operator">=</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">method</span><span class="structure">();</span><br /> <span class="word">return_error</span><span class="structure">(</span><span class="double">"bad method"</span><span class="structure">)</span> <span class="word">unless</span> <span class="symbol">$options</span><span class="operator">-></span><span class="structure">{</span><span class="word">methods</span><span class="structure">}{</span><span class="symbol">$request_method</span><span class="structure">};</span><br /> <span class="structure">}</span><br /><br /> <span class="keyword">return</span> <span class="word">SantasWorkshop::API</span><span class="operator">-></span><span class="word">new</span><span class="structure">()</span><span class="operator">-></span><span class="symbol">$action</span><span class="structure">(</span><span class="symbol">@rest</span><span class="structure">);</span><br /> <span class="structure">}</span> <span class="operator">,</span><br /> <span class="word">validations</span> <span class="operator">=></span> <span class="symbol">$options</span><span class="operator">-></span><span class="structure">{</span><span class="word">validations</span><span class="structure">}</span> <span class="operator">,</span><br /> <span class="structure">));</span><br /><span class="structure">}</span><br /><br /><span class="comment"># once the routing table is all build, make the app using that router.<br /></span><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="word">Plack::App::Path::Router::Custom</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">router</span> <span class="operator">=></span> <span class="symbol">$router</span><span class="operator">,</span><br /> <span class="word">new_request</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="word">Plack::Request</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="core">shift</span><span class="structure">)</span> <span class="structure">}</span> <span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>Jesse pushed the final revision up for code review and got notification of Margaret's merging of the code into the release branch only a few minutes later -- along with an IM saying, "Nice work, kid -- how about you take off early today."</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Plack::App::Path::Router">Plack::App::Path::Router</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Path::Router">Path::Router</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Plack::App::Path::Router::Custom">Plack::App::Path::Router::Custom</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Plack">Plack</a></p>
</li>
<li><p><a href="http://perladvent.org/2014/2014-12-04.html">The Perl Advent Article on PSGI and Plack</a></p>
</li>
</ul>
</div>2014-12-22T00:00:00ZJohn SJ AndersonBeyond Grephttp://perladvent.org/2014/2014-12-21.html<div class='pod'><p>Ack is a Perl based command line utility designed to replace "99% uses of grep" which is a fancy way of saying it's a much smarter version of grep designed to be used at the command line interactively rather than in scripts.</p>
<h3 id="The-Advantages-of-Ack">The Advantages of Ack</h3>
<p>Whenever I get started on a big new project I need to familiarize myself with the codebase. Typical questions I tend to ask are:</p>
<ul>
<li>Where are the Perl source files? The JavaScript? The HTML, etc?</li>
<li>What files are using this subroutine? Where is this method defined?</li>
</ul>
<p>I used to use <code>grep -r</code> to help me with this. But I always found it was searching in the wrong places (Inside my version control files...in big log files and images rather than inside the Perl modules...) And even when it did find the thing I was looking for in files I'd end up staring at the output trying to work out exactly where the bit of the string that matched was.</p>
<p>Then I discovered <code>ack</code>. And my life became a lot easier.</p>
<center><img src="ack1.png"></center>
<p>At its most basic <code>ack</code> can be thought of a version of grep that does the right things by default. These include:</p>
<ul>
<li>Highlighting the matched text</li>
<li>Automatically ignoring common version control, scratch, and temporary files.</li>
<li>Searching recusively in the current directory by default when a filename isn't passed and it's not being used in a pipe.</li>
<li>Showling clearly both filenames and line numbers of each match (and optionally column numbers)</li>
<li>Easily allowing restrictions to seaching particlar types of files</li>
<li>Using Perl's powerful regular expression engine</li>
</ul>
<p>Or to put it another way, this <code>grep</code>:</p>
<pre><code class="code-listing"><span class="synStatement">grep</span> <span class="synSpecial">--exclude-dir</span> .git <span class="synStatement">\</span><br /> <span class="synSpecial">--include</span> *.pl <span class="synStatement">\</span><br /> <span class="synSpecial">--include</span> *.pm <span class="synStatement">\</span><br /> <span class="synSpecial">--include</span> *.pod <span class="synStatement">\</span><br /> <span class="synSpecial">--include</span> *.t <span class="synStatement">\</span><br /> <span class="synSpecial">--include</span> *.psgi <span class="synStatement">\</span><br /> <span class="synSpecial">-r</span> <span class="synSpecial">-n</span> <span class="synSpecial">-E</span> <span class="synStatement">'</span><span class="synConstant">(foo|bar)</span><span class="synStatement">'</span> .</code></pre>
<p>Could be better written as this <code>ack</code>:</p>
<pre><code class="code-listing">ack <span class="synSpecial">--perl</span> <span class="synStatement">'</span><span class="synConstant">(foo|bar)</span><span class="synStatement">'</span></code></pre>
<p>(And <code>ack</code> will also do highlighting of match and group matches within a file together in a readable form!)</p>
<h3 id="Ack-file-types">Ack file types</h3>
<p>One of the great advantages in using ack is that ability to only search files that of a particular type. In addition to the large range of built in types you can easily add a specification for your own types to <code>ack</code> or modify existing files by using extra command line arguments.</p>
<p>For example, several places I have worked have had their own template system that can contain embedded Perl code, but because these files don't use the standard Perl extensions of <code>.pl</code>,<code>.pm</code>,<code>.pod</code>, <code>.t</code>, or <code>.psgi</code>, nor start with a perl shebang line, ack invoked with <code>--perl</code> won't search them. I'd like ack to search within the <code>.perlt</code> files also. This can be done by adding another option to <code>ack</code>:</p>
<pre><code class="code-listing">ack <span class="synSpecial">--type-add=perl:ext:perlt</span> <span class="synSpecial">--perl</span> foo</code></pre>
<p>Of course typing this every time I ran <code>ack</code> would be extremely tiresome. For this reason I copy this arguments into my <code>.ackrc</code> where <code>ack</code> reads them in each time ack is invoked so I always have my perlt search available.</p>
<pre><code class="code-listing"><span class="synStatement">echo</span><span class="synConstant"> </span><span class="synStatement">'</span><span class="synConstant">--type-add=perl:ext:perlt</span><span class="synStatement">'</span><span class="synConstant"> </span><span class="synStatement">>></span> ~/.ackrc<br />ack <span class="synSpecial">--perl</span> foo</code></pre>
<p>We're not limited to file extensions here; For example, I can tell ack that any file that starts with <code>{</code> on the first line should be considered JSON:</p>
<pre><code class="code-listing">ack <span class="synStatement">'</span><span class="synConstant">--type-add=json:firstlinematch:/^\s*\{/</span><span class="synStatement">'</span> <span class="synSpecial">--json</span> foo</code></pre>
<h3 id="Ack-power-use">Ack power use</h3>
<p>The above should probably be enough to convince you to switch to using ack on a day to day basis for interactive file grepping. But what about some of the really crazy powerful things you can do with ack?</p>
<h4 id="Find-all-files-of-a-particular-type">Find all files of a particular type</h4>
<p><code>ack</code> is pretty smart about working out what files it should ignore, including things like version control files, editor backup files, and even things like minified versions of JavaScript.</p>
<p>This makes it a good choice for simply getting a list of particular files of a given type in a project:</p>
<pre><code class="code-listing"><span class="synComment"># find all un-minified JavaScript files in your file tree</span><br />ack <span class="synSpecial">-f</span> <span class="synSpecial">--js</span><br />bootstrap/js/bootstrap.js<br />js/main.js<br />js/jquery.js</code></pre>
<p>(This uses <code>-f</code> to just print the filename that would be searched rather than actually searching the file and <code>--js</code> to specify that we want JavaScript extensions)</p>
<p>Once you've got a list of files like this you can start doing interesting things with them by using utilities like <code>xargs</code>:</p>
<pre><code class="code-listing"><span class="synComment"># delete all php code!</span><br />ack <span class="synSpecial">-f</span> <span class="synSpecial">--php</span> <span class="synSpecial">--print0</span> | xargs <span class="synConstant">-0</span> <span class="synStatement">rm</span> <span class="synSpecial">-f</span></code></pre>
<p>This works the same as the previous example but uses the <code>--print0</code> argument to <code>ack</code> and <code>-0</code> argument to <code>xargs</code> (so that the two communicate the filenames across the pipe delimited by a null character rather than whitespace preventing problems with filenames with whitespace in their names.)</p>
<p>Replacing <code>-f</code> with <code>-l</code> means we will also search the files with our passed regex, and only list those files that match (but not show how we match like in traditional output.) Combining this with <code>xargs</code> again we can do even more powerful things:</p>
<pre><code class="code-listing"><span class="synComment"># commit all the code that have "use strict"</span><br />bash$ ack <span class="synSpecial">-l</span> <span class="synSpecial">--perl</span> <span class="synSpecial">--print0</span> <span class="synStatement">'</span><span class="synConstant">use strict</span><span class="synStatement">'</span> | xargs <span class="synConstant">-0</span> git add<br />bash$ git commit <span class="synSpecial">-m</span> <span class="synStatement">'</span><span class="synConstant">add strictures</span><span class="synStatement">'</span></code></pre>
<h4 id="Using-ack-to-highlight-things-in-a-file">Using ack to highlight things in a file</h4>
<p><code>ack</code> can be used just to highlight a string in a file. For example, everywhere that <code>$jolly</code> is used:</p>
<pre><code class="code-listing">ack <span class="synSpecial">--passthru</span> <span class="synSpecial">-Q</span> <span class="synStatement">'</span><span class="synConstant">$jolly</span><span class="synStatement">'</span> lib/Santa.pm </code></pre>
<p>The <code>--passthru</code> option tells <code>ack</code> to display all lines, matching or not. The <code>-Q</code> tells ack to treat the string we're highlighting as a literal pattern rather than a regexp.</p>
<p>We can even use this technique in a tail. For example to highlight the string "Error" in our logfile:</p>
<pre><code class="code-listing"><span class="synStatement">tail</span> <span class="synSpecial">-n</span>0 <span class="synSpecial">-f</span> /tmp/log | ack <span class="synSpecial">--passthru</span> Error</code></pre>
<center><img src="tail.gif"></center>
<h4 id="Custom-Output">Custom Output</h4>
<p>Ack allows you to modify the output from the default <i>matching line with match highlighted</i> output to something custom. If we want to get a list of all the subroutines in our file tree we can easily do that: We search for all the <code>sub <i>something</i></code> but only display the <code><i>something</i></code> not the leading <code>sub</code>. By using <code>--output</code> we can pass a Perl string that ack will <code>eval</code> after each match and use the result for the output:</p>
<center><img src="ackcustom.png"></center>
<p>With a little imagination this can be used to very powerful things. For example, the size of the URLs mentioned in a file:</p>
<pre><code class="code-listing">ack <span class="synSpecial">--output=</span><span class="synStatement">'</span><span class="synConstant">$&: @{[ eval "use LWP::Simple; 1" && length LWP::Simple::get($&) ]} bytes</span><span class="synStatement">'</span> <span class="synStatement">\</span><br /> <span class="synStatement">'</span><span class="synConstant">https?://\S+</span><span class="synStatement">'</span> list.txt<br />http://google.com/: <span class="synConstant">19529</span> bytes<br />http://metacpan.org/: <span class="synConstant">7560</span> bytes<br />http://www.perladvent.org/: <span class="synConstant">5562</span> bytes</code></pre>
<p>However the smartest thing I've ever used the custom output for is to generate lines that look just like Perl error messages:</p>
<pre><code> ack --no-filename --no-group \
--output 'at $filename line $line_no$/$line$/' \
'sub new'</code></pre>
<p>Why is this so helpful? Because I use the <a href="https://github.com/2shortplanks/PerlErrorSublime.popclipext">PerlErrorSublime.popclipext</a> PopClip extension to allow me to highlight any perl-error like string in my terminal and open that line in Sublime Text:</p>
<center><img src="sublime.gif"></center>
<h3 id="Conclusion">Conclusion</h3>
<p>Hopefully I've convinced you now not only that ack can be used as a basic replacement for grep, but also there's some very formidable things you can do with it if you take a little time to learn some of the more powerful options.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/App::ack">App::ack</a></p>
</li>
<li><p><a href="http://beyondgrep.com/">http://beyondgrep.com/</a></p>
</li>
</ul>
</div>2014-12-21T00:00:00ZMark FowlerDumb In-struct-ionshttp://perladvent.org/2014/2014-12-20.html<div class='pod'><p>Do you ever find yourself using plain hash references to store little collections of data, always with the same fields, internally in your code? Or maybe you return them to callers to represent little collections of information?</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">get_reindeers</span> <span class="structure">{</span><br /> <span class="keyword">return</span> <span class="structure">(</span><br /> <span class="structure">{</span> <span class="word">name</span> <span class="operator">=></span> <span class="double">"Rudolph"</span><span class="operator">,</span> <span class="word">nose</span> <span class="operator">=></span> <span class="double">"red"</span><span class="operator">,</span> <span class="word">height</span> <span class="operator">=></span> <span class="float">1.25</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">name</span> <span class="operator">=></span> <span class="double">"Comet"</span><span class="operator">,</span> <span class="word">nose</span> <span class="operator">=></span> <span class="double">"green"</span><span class="operator">,</span> <span class="word">height</span> <span class="operator">=></span> <span class="float">1.27</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="operator">...</span><br /> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Convenient as these are, they always run the risk that just spelling a key name wrong (or inventing new key names by mistake) doesn't cause an immediate error - either you'll end up reading undef, or worse, you'll create a new field in the structure.</p>
<p>Of course you could create an entire object class for these, but an entire class in its own file just for a few pieces of structural data with no "exciting behaviour" methods seems somewhat overkill.</p>
<h3 id="Enter-Struct::Dumb">Enter Struct::Dumb</h3>
<p>In this sort of situation when you just have dumb structural data with no other methods you can use Struct::Dumb to represent them.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Struct::Dumb</span> <span class="single">'struct'</span><span class="structure">;</span><br /><br /><span class="word">struct</span> <span class="word">Reindeer</span> <span class="operator">=></span> <span class="structure">[</span><span class="words">qw( name nose height )</span><span class="structure">];</span></code></pre>
<p>This helpful little one line of code creates a constructor function which returns objects having all those fields:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">get_reindeers</span> <span class="structure">{</span><br /> <span class="keyword">return</span> <span class="structure">(</span><br /> <span class="word">Reindeer</span><span class="structure">(</span><span class="double">"Rudolph"</span><span class="operator">,</span> <span class="double">"red"</span><span class="operator">,</span> <span class="float">1.25</span><span class="structure">)</span><span class="operator">,</span><br /> <span class="word">Reindeer</span><span class="structure">(</span><span class="double">"Comet"</span><span class="operator">,</span> <span class="double">"green"</span><span class="operator">,</span> <span class="float">1.27</span><span class="structure">)</span><span class="operator">,</span><br /> <span class="operator">...</span><br /> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Your caller can now read the fields of the struct as if they were methods on an object:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@reindeer</span> <span class="operator">=</span> <span class="word">get_reindeers</span><span class="structure">();</span><br /><span class="word">say</span> <span class="double">"A reindeer called "</span> <span class="operator">.</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">name</span> <span class="word">foreach</span> <span class="symbol">@reindeer</span><span class="structure">;</span></code></pre>
<p>Though just like hash references these fields are updatable. They act as lvalue methods:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$rudolph</span> <span class="operator">=</span> <span class="symbol">$reindeer</span><span class="structure">[</span><span class="number">0</span><span class="structure">];</span><br /><span class="symbol">$rudolph</span><span class="operator">-></span><span class="word">height</span> <span class="operator">*=</span> <span class="number">2</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="symbol">$rudolph</span><span class="operator">-></span><span class="word">name</span><span class="operator">,</span> <span class="double">" is now twice as tall"</span><span class="structure">;</span></code></pre>
<p>However, unlike hash references instances give a helpful error if you try to access a field that doesn't exist:</p>
<pre><code class="code-listing"><span class="word">say</span> <span class="symbol">$reindeer</span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span><span class="operator">-></span><span class="word">weight</span><span class="structure">;</span><br /><br /><span class="word">main::Reindeer</span> <span class="word">does</span> <span class="operator">not</span> <span class="word">have</span> <span class="word">a</span> <span class="single">'weight'</span> <span class="word">field</span> <span class="word">at</span> <span class="word">foo</span><span class="operator">.</span><span class="word">pl</span> <span class="word">line</span> <span class="float">123.</span></code></pre>
<p>This makes them just as convenient as plain hash references for internal data inside your modules or classes.</p>
<h3 id="Read-Only-Structs">Read-Only Structs</h3>
<p>If you want to create structures that cannot be mutated after construction, you can instead use <code>readonly_struct</code> to declare them:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Struct::Dumb</span> <span class="single">'readonly_struct'</span><span class="structure">;</span><br /><span class="word">readonly_struct</span> <span class="word">Reindeer</span> <span class="operator">=></span> <span class="structure">[</span><span class="words">qw( name nose height )</span><span class="structure">];</span><br /><br /><span class="keyword">my</span> <span class="symbol">$vixen</span> <span class="operator">=</span> <span class="word">Reindeer</span><span class="structure">(</span><span class="double">"Vixen"</span><span class="operator">,</span> <span class="double">"silver"</span><span class="operator">,</span> <span class="float">1.19</span><span class="structure">);</span><br /><br /><span class="comment"># try to change it<br /></span><span class="symbol">$vixen</span><span class="operator">-></span><span class="word">name</span> <span class="operator">=</span> <span class="double">"VIXEN"</span><span class="structure">;</span><br /><br /><span class="word">Can't</span> <span class="word">modify</span> <span class="word">non-lvalue</span> <span class="word">subroutine</span> <span class="word">call</span> <span class="word">at</span> <span class="word">foo</span><span class="operator">.</span><span class="word">pl</span> <span class="word">line</span> <span class="float">123.</span></code></pre>
<h3 id="Constructor-Cleverness">Constructor Cleverness</h3>
<p>The constructor function helpfully reminds you of missing fields if you invoked it incorrectly:</p>
<pre><code class="code-listing"><span class="keyword">return</span> <span class="word">Reindeer</span><span class="structure">(</span><span class="double">"Dancer"</span><span class="operator">,</span><span class="double">"grey"</span><span class="structure">)</span><br /><br /><span class="label">usage:</span> <span class="word">main::Reindeer</span><span class="structure">(</span><span class="symbol">$name</span><span class="operator">,</span> <span class="symbol">$nose</span><span class="operator">,</span> <span class="symbol">$height</span><span class="structure">)</span> <span class="word">at</span> <span class="word">foo</span><span class="operator">.</span><span class="word">pl</span> <span class="word">line</span> <span class="float">123.</span></code></pre>
<p>Of course, this doesn't help you if you pass the right number of arguments but mix up the order of them:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$rudy</span> <span class="operator">=</span> <span class="word">Reindeer</span><span class="structure">(</span><span class="double">"Rudolph"</span><span class="operator">,</span> <span class="float">1.25</span><span class="operator">,</span> <span class="double">"red"</span><span class="structure">);</span><br /><span class="word">say</span> <span class="symbol">$rudy</span><span class="operator">-></span><span class="word">height</span><span class="structure">;</span> <span class="comment"># prints "red", ooops</span></code></pre>
<p>One thing that can help here is to instead have Struct::Dumb create a constructor that uses named parameters rather than positional arguments - in other words instead of passing in an ordered list of parameters you pass in key/value pairs much more like traditional hash creation. This looks something like this:</p>
<pre><code class="code-listing"><span class="word">struct</span> <span class="word">Reindeer</span> <span class="operator">=></span> <span class="structure">[</span><span class="words">qw( name nose height )</span><span class="structure">]</span><span class="operator">,</span> <span class="word">named_constructor</span> <span class="operator">=></span> <span class="number">1</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$rudy</span> <span class="operator">=</span> <span class="word">Reindeer</span><span class="structure">(</span><br /> <span class="word">name</span> <span class="operator">=></span> <span class="double">"Rudolph"</span><span class="operator">,</span><br /> <span class="word">height</span> <span class="operator">=></span> <span class="float">1.25</span><span class="operator">,</span><br /> <span class="word">nose</span> <span class="operator">=></span> <span class="double">"red"</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>It's even possible to enable defaulting to named parameters on a per-package basis:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Struct::Dumb</span> <span class="word">-named_constructors</span><span class="operator">,</span> <span class="single">'struct'</span><span class="structure">;</span><br /><br /><span class="word">struct</span> <span class="word">Reindeer</span> <span class="operator">=></span> <span class="structure">[</span><span class="words">qw( name nose height )</span><span class="structure">];</span><br /><br /><span class="keyword">my</span> <span class="symbol">$rudy</span> <span class="operator">=</span> <span class="word">Reindeer</span><span class="structure">(</span><br /> <span class="word">name</span> <span class="operator">=></span> <span class="double">"Rudolph"</span><span class="operator">,</span><br /> <span class="word">height</span> <span class="operator">=></span> <span class="float">1.25</span><span class="operator">,</span><br /> <span class="word">nose</span> <span class="operator">=></span> <span class="double">"red"</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<h3 id="Space-Efficiency">Space Efficiency</h3>
<p>Under the hood Struct::Dumb uses arrays to store the data. This means that these data structures can be much smaller:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Struct::Dumb</span> <span class="word">-named_constructors</span><span class="operator">,</span> <span class="single">'struct'</span><span class="structure">;</span><br /><span class="word">struct</span> <span class="word">Reindeer</span> <span class="operator">=></span> <span class="structure">[</span><span class="words">qw( name nose height )</span><span class="structure">];</span><br /><br /><span class="keyword">my</span> <span class="symbol">@args</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="word">name</span> <span class="operator">=></span> <span class="double">"Rudolph"</span><span class="operator">,</span><br /> <span class="word">height</span> <span class="operator">=></span> <span class="float">1.25</span><span class="operator">,</span><br /> <span class="word">nose</span> <span class="operator">=></span> <span class="double">"red"</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">use</span> <span class="word">Devel::Size</span> <span class="words">qw(total_size)</span><span class="structure">;</span><br /><span class="word">say</span> <span class="word">total_size</span><span class="structure">({</span><span class="symbol">@args</span><span class="structure">});</span><br /><span class="word">say</span> <span class="word">total_size</span><span class="structure">(</span><span class="word">Reindeer</span><span class="structure">(</span><span class="symbol">@args</span><span class="structure">));</span></code></pre>
<center><img src="space.png"></center>
<p>If you're using a vast number of identically keyed hashes then Struct::Dumb can save a significant amount of memory.</p>
<h3 id="In-Conclusion">In Conclusion</h3>
<p>In certain situations Struct::Dumb can provide a more strict and smaller alternative to simple hash usage with minimal code overhead. With a pure Perl implementation requiring no dependencies, there's very little reason you shouldn't start using it in your code today.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Struct::Dumb">Struct::Dumb</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Devel::Size">Devel::Size</a></p>
</li>
</ul>
</div>2014-12-20T00:00:00ZPaul "LeoNerd" EvansWrapping output http://perladvent.org/2014/2014-12-19.html<div class='pod'><p>Normally this is the time of year when people think about <i>unwrapping</i> things. Today, we're going to talk about wrapping output into some buffers.</p>
<p>Capturing output from other tools is something that Perl is pretty good at - and there are about eleventy billion modules on CPAN to help you do it. Which one should you pick? Which one will solve 95% of your problems and not tie you down with tons of external dependencies? Which ones work on all supported Perl platforms including Windows?</p>
<p>For this advent entry, we are going to take a look at <a href="https://metacpan.org/module/Capture::Tiny">Capture::Tiny</a>, a module which offers two simple functions <a href="https://metacpan.org/module/capture">capture</a> and <a href="https://metacpan.org/module/tee">tee</a> and which delivers on the "Tiny" premise of not requiring <b>any</b> dependencies outside of core perl. Yes, it works on Windows, too. As far as compatibility across Perl releases, Capture::Tiny works as far back as Perl 5.6.1 but, seriously, try not to use such an ancient Perl if you can help it. (Especially not if you need Unicode support; Unicode before 5.8.1 is super dodgy.)</p>
<h2 id="External-commands">External commands</h2>
<p>Most people think about capturing the output from external commands - and Capture::Tiny is great at that task. It's a simple as something like this:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Capture::Tiny</span> <span class="words">qw(capture)</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$out</span><span class="operator">,</span> <span class="symbol">$err</span><span class="operator">,</span> <span class="symbol">$exit</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">capture</span> <span class="structure">{</span><br /> <span class="word">system</span><span class="structure">(</span><span class="double">"/bin/ls"</span><span class="operator">,</span> <span class="structure">(</span><span class="double">"-l"</span><span class="operator">,</span> <span class="double">"/tmp"</span><span class="structure">));</span><br /><span class="structure">};</span></code></pre>
<p>It's important to note that none of the functions in Capture::Tiny are exported by default - you need to use <code>:all</code> or directly import the functions from the module.</p>
<h2 id="Arbitrary-code">Arbitrary code</h2>
<p>The interesting thing is we don't need to use <code>system</code> above. We can put arbitrary Perl code in that code block and Capture::Tiny will just do the right thing. Check it out:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Capture::Tiny</span> <span class="words">qw(capture)</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$out</span><span class="operator">,</span> <span class="symbol">$err</span><span class="operator">,</span> <span class="symbol">@results</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">capture</span> <span class="structure">{</span><br /> <span class="word">say</span> <span class="word">for</span> <span class="single">'a'</span> <span class="operator">..</span> <span class="single">'z'</span><span class="structure">;</span><br /><span class="structure">};</span><br /><br /><span class="word">say</span> <span class="symbol">$out</span><span class="structure">;</span><br /><span class="comment"># prints<br /># a<br /># b<br /># c<br /># d<br /># ...</span></code></pre>
<h2 id="Passing-through">Passing through</h2>
<p>OK, there's a Unix command called <code>tee</code> that's been around for a long time. It saves standard out and standard error to a file, but also passes those sources through. In that spirit, Capture::Tiny has a function named <code>tee</code> which does the same thing. Functionally, it's almost the same as capture but instead of swallowing the output streams, it stuffs them into two scalars you specify.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Capture::Tiny</span> <span class="words">qw(tee)</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$out</span><span class="operator">,</span> <span class="symbol">$err</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">tee</span> <span class="structure">{</span><br /> <span class="word">say</span> <span class="word">for</span> <span class="number">1</span> <span class="operator">..</span> <span class="number">10</span><span class="structure">;</span><br /><span class="structure">};</span><br /><br /><span class="word">say</span> <span class="word">length</span><span class="structure">(</span><span class="symbol">$out</span><span class="structure">);</span><br /><span class="comment"># prints<br /># 1<br /># 2<br /># ...<br /># 21 - 10 integers followed by \n</span></code></pre>
<h2 id="In-summary">In summary</h2>
<p><a href="https://metacpan.org/module/Capture::Tiny">Capture::Tiny</a> does everything you're likely to need in terms of grabbing standard output and/or standard error. It's easy to use, easy to install, has no non-core dependencies and works on every supported Perl platform. Instead of one of the many other CPAN modules, start using Capture::Tiny. It'll be a present to yourself you won't regret unwrapping.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Capture::Tiny">Capture::Tiny</a></p>
</li>
</ul>
</div>2014-12-19T00:00:00ZMark AllenChristmas Timekeepinghttp://perladvent.org/2014/2014-12-18.html<div class='pod'><p>The key to doing Christmas right is proper planning of the day. None of this wishy washy behavior that ends up with your pregnant wife giving birth in a manger. No, no, we need <b>organization</b>! We need a <b>schedule</b>! We need a <b>calendar</b>!</p>
<p>In my normal working day I use a Perl script to create events on my calendar from templates, calculating backwards with DateTime from when known point where operations need to end to work out when the things need to happen. I juggle time zones. I have recurrences of the same event over and over.</p>
<p>It's just these technical skills I need to apply to my Christmas Day calendar if I'm going to make it through in one piece.</p>
<h3 id="The-iCal-file">The iCal file</h3>
<p>The simplest way to put something into my calendar is to use Perl to create a ICal calendar file first, then open it in my calendar application. Luckily there's a Perl module for that.</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="pragma">autodie</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">File::Temp</span> <span class="words">qw(tempfile)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Data::ICal::DateTime</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Data::ICal::Entry::Event</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$cal</span> <span class="operator">=</span> <span class="word">Data::ICal</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><br /><span class="operator">...</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$fh</span><span class="operator">,</span> <span class="symbol">$filename</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">tempfile</span><span class="structure">(</span><span class="core">undef</span><span class="operator">,</span> <span class="word">SUFFIX</span> <span class="operator">=></span> <span class="double">".ics"</span><span class="structure">);</span><br /><span class="word">print</span> <span class="symbol">$fh</span> <span class="symbol">$cal</span><span class="operator">-></span><span class="word">as_string</span><span class="structure">;</span><br /><span class="word">close</span> <span class="symbol">$fh</span><span class="structure">;</span><br /><br /><span class="comment"># since my computer is a Mac I can open the calendar file<br /># in Calendar.app by just using the "open" command on it<br /></span><span class="word">system</span><span class="structure">(</span><span class="double">"open"</span><span class="operator">,</span> <span class="symbol">$filename</span><span class="structure">);</span></code></pre>
<p>Now all we need do is replace the <code>...</code> with some actual code to add some events to our calendar. We've loaded Data::ICal::DateTime which allows us to use the all powerful DateTime module to construct DateTime object from which we can create events.</p>
<h3 id="Turkey-Dinner">Turkey Dinner</h3>
<p>Even thought I now live in New York, since I was raised in England each year it's tradition to make sure that we cook a turkey dinner. Let's add a entry for eating that to our calendar straight away:</p>
<pre><code class="code-listing"><span class="comment"># Let's eat at 3PM<br /></span><span class="keyword">my</span> <span class="symbol">$dinnertime</span> <span class="operator">=</span> <span class="word">DateTime</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">year</span> <span class="operator">=></span> <span class="number">2014</span><span class="operator">,</span><br /> <span class="word">month</span> <span class="operator">=></span> <span class="number">12</span><span class="operator">,</span><br /> <span class="word">day</span> <span class="operator">=></span> <span class="number">25</span><span class="operator">,</span><br /> <span class="word">hour</span> <span class="operator">=></span> <span class="number">15</span><span class="operator">,</span><br /> <span class="word">minute</span> <span class="operator">=></span> <span class="octal">00</span><span class="operator">,</span><br /> <span class="word">second</span> <span class="operator">=></span> <span class="octal">00</span><span class="operator">,</span><br /> <span class="word">time_zone</span> <span class="operator">=></span> <span class="single">'America/New_York'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="comment"># And let's take two hours to eat<br /></span><span class="keyword">my</span> <span class="symbol">$dinner_duration</span> <span class="operator">=</span> <span class="word">DateTime::Duration</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">hours</span> <span class="operator">=></span> <span class="number">2</span> <span class="structure">);</span><br /><br /><span class="comment"># create the event<br /></span><span class="keyword">my</span> <span class="symbol">$dinner</span> <span class="operator">=</span> <span class="word">Data::ICal::Entry::Event</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="symbol">$dinner</span><span class="operator">-></span><span class="word">summary</span><span class="structure">(</span><span class="double">"Christmas Dinner"</span><span class="structure">);</span><br /><span class="symbol">$dinner</span><span class="operator">-></span><span class="word">description</span><span class="structure">(</span><span class="double">"Turkey with all the trimmings"</span><span class="structure">);</span><br /><span class="symbol">$dinner</span><span class="operator">-></span><span class="word">start</span><span class="structure">(</span> <span class="symbol">$dinnertime</span> <span class="structure">);</span><br /><span class="symbol">$dinner</span><span class="operator">-></span><span class="word">duration</span><span class="structure">(</span> <span class="symbol">$dinner_duration</span> <span class="structure">);</span><br /><span class="symbol">$cal</span><span class="operator">-></span><span class="word">add_entry</span><span class="structure">(</span> <span class="symbol">$dinner</span> <span class="structure">);</span></code></pre>
<p>Of course, we'll need to cook the Turkey. Let's work out when this should go in by working backwards from the time the dinner was meant to start. Note how the overloaded operators for DateTime and DateTime::Duration allow us to simply use subtraction to create a new DateTime.</p>
<pre><code class="code-listing"><span class="comment"># butterball says it'll take 4h for a 20lb Turkey<br /></span><span class="keyword">my</span> <span class="symbol">$cooking_time</span> <span class="operator">=</span> <span class="word">DateTime::Duration</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">hours</span> <span class="operator">=></span> <span class="number">4</span> <span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$in_the_oven</span> <span class="operator">=</span> <span class="symbol">$dinnertime</span> <span class="operator">-</span> <span class="symbol">$cooking_time</span><span class="structure">;</span><br /><br /><span class="comment"># and it'll probably take me 45 minutes to prep the turkey<br /></span><span class="keyword">my</span> <span class="symbol">$prep_time</span> <span class="operator">=</span> <span class="word">DateTime::Duration</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">minutes</span> <span class="operator">=></span> <span class="number">45</span> <span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$prep_start</span> <span class="operator">=</span> <span class="symbol">$in_the_oven</span> <span class="operator">-</span> <span class="symbol">$prep_time</span><span class="structure">;</span><br /><br /><span class="comment"># create the events<br /></span><span class="keyword">my</span> <span class="symbol">$cooking</span> <span class="operator">=</span> <span class="word">Data::ICal::Entry::Event</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="symbol">$cooking</span><span class="operator">-></span><span class="word">summary</span><span class="structure">(</span><span class="double">"Cooking Turkey"</span><span class="structure">);</span><br /><span class="symbol">$cooking</span><span class="operator">-></span><span class="word">description</span><span class="structure">(</span><span class="double">"Cook at 325F using open pan method"</span><span class="structure">);</span><br /><span class="symbol">$cooking</span><span class="operator">-></span><span class="word">start</span><span class="structure">(</span> <span class="symbol">$in_the_oven</span> <span class="structure">);</span><br /><span class="symbol">$cooking</span><span class="operator">-></span><span class="word">end</span><span class="structure">(</span> <span class="symbol">$dinnertime</span> <span class="structure">);</span><br /><span class="symbol">$cal</span><span class="operator">-></span><span class="word">add_entry</span><span class="structure">(</span> <span class="symbol">$cooking</span> <span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$prep</span> <span class="operator">=</span> <span class="word">Data::ICal::Entry::Event</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="symbol">$prep</span><span class="operator">-></span><span class="word">summary</span><span class="structure">(</span><span class="double">"Prep Turkey"</span><span class="structure">);</span><br /><span class="symbol">$prep</span><span class="operator">-></span><span class="word">description</span><span class="structure">(</span><span class="double">"Wash, apply rub, stuff turkey, place in pan"</span><span class="structure">);</span><br /><span class="symbol">$prep</span><span class="operator">-></span><span class="word">start</span><span class="structure">(</span> <span class="symbol">$prep_start</span> <span class="structure">);</span><br /><span class="symbol">$prep</span><span class="operator">-></span><span class="word">end</span><span class="structure">(</span> <span class="symbol">$in_the_oven</span> <span class="structure">);</span><br /><span class="symbol">$cal</span><span class="operator">-></span><span class="word">add_entry</span><span class="structure">(</span> <span class="symbol">$prep</span> <span class="structure">);</span></code></pre>
<p>We also need to put in the roast veg. We can use multiplication to work out how long the prep time will be.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$people</span> <span class="operator">=</span> <span class="number">10</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$time_per_person</span> <span class="operator">=</span> <span class="word">DateTime::Duration</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">minutes</span> <span class="operator">=></span> <span class="number">5</span> <span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$veg_prep_time</span> <span class="operator">=</span> <span class="symbol">$people</span> <span class="operator">*</span> <span class="symbol">$time_per_person</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$veg_cook_time</span> <span class="operator">=</span> <span class="word">DateTime::Duration</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">minutes</span> <span class="operator">=></span> <span class="number">45</span> <span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$veg_prep</span> <span class="operator">=</span> <span class="word">Data::ICal::Entry::Event</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="symbol">$veg_prep</span><span class="operator">-></span><span class="word">summary</span><span class="structure">(</span><span class="double">"Prep veg"</span><span class="structure">);</span><br /><span class="symbol">$veg_prep</span><span class="operator">-></span><span class="word">description</span><span class="structure">(</span><span class="double">"Prep veg and then stick in oven"</span><span class="structure">);</span><br /><span class="symbol">$veg_prep</span><span class="operator">-></span><span class="word">start</span><span class="structure">(</span> <span class="symbol">$dinnertime</span> <span class="operator">-</span> <span class="structure">(</span> <span class="symbol">$veg_cook_time</span> <span class="operator">+</span> <span class="symbol">$veg_prep_time</span> <span class="structure">)</span> <span class="structure">);</span><br /><span class="symbol">$veg_prep</span><span class="operator">-></span><span class="word">duration</span><span class="structure">(</span> <span class="symbol">$veg_prep_time</span> <span class="structure">);</span><br /><span class="symbol">$cal</span><span class="operator">-></span><span class="word">add_entry</span><span class="structure">(</span> <span class="symbol">$veg_prep</span> <span class="structure">);</span></code></pre>
<h3 id="Fun-with-Time-Zones">Fun with Time Zones</h3>
<p>Like any loyal British Citizen I have to watch the Queen's speech (which these days can be found on YouTube for expats like myself.)</p>
<p>There's nothing stopping us adding an event to our calendar that's in another time zone:</p>
<pre><code class="code-listing"><span class="comment"># The Queen's speech is broadcast at 3PM in the UK. When I add<br /># this to my EST calendar, it shows up as happening at 10am.<br /></span><span class="keyword">my</span> <span class="symbol">$speech_time</span> <span class="operator">=</span> <span class="word">DateTime</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">year</span> <span class="operator">=></span> <span class="number">2014</span><span class="operator">,</span><br /> <span class="word">month</span> <span class="operator">=></span> <span class="number">12</span><span class="operator">,</span><br /> <span class="word">day</span> <span class="operator">=></span> <span class="number">25</span><span class="operator">,</span><br /> <span class="word">hour</span> <span class="operator">=></span> <span class="number">15</span><span class="operator">,</span><br /> <span class="word">minute</span> <span class="operator">=></span> <span class="octal">00</span><span class="operator">,</span><br /> <span class="word">second</span> <span class="operator">=></span> <span class="octal">00</span><span class="operator">,</span><br /> <span class="word">time_zone</span> <span class="operator">=></span> <span class="single">'Europe/London'</span><span class="operator">,</span> <span class="comment"># note, different to where I live!</span><br /><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$speech_duration</span> <span class="operator">=</span> <span class="word">DateTime::Duration</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">minutes</span> <span class="operator">=></span> <span class="number">15</span> <span class="structure">);</span><br /><br /><span class="comment"># create the event<br /></span><span class="keyword">my</span> <span class="symbol">$speech</span> <span class="operator">=</span> <span class="word">Data::ICal::Entry::Event</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="symbol">$speech</span><span class="operator">-></span><span class="word">summary</span><span class="structure">(</span><span class="double">"The Queen's Speech"</span><span class="structure">);</span><br /><span class="symbol">$speech</span><span class="operator">-></span><span class="word">start</span><span class="structure">(</span> <span class="symbol">$speech_time</span> <span class="structure">);</span><br /><span class="symbol">$speech</span><span class="operator">-></span><span class="word">duration</span><span class="structure">(</span> <span class="symbol">$speech_duration</span> <span class="structure">);</span><br /><span class="symbol">$cal</span><span class="operator">-></span><span class="word">add_entry</span><span class="structure">(</span> <span class="symbol">$speech</span> <span class="structure">);</span></code></pre>
<h3 id="Repeating-Events">Repeating Events</h3>
<p>At the end of a long day of celebrating we need each night to remember to turn off the Christmas lights before we go to bed. We'll need to do this each night until twelfth night.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$ninepm</span> <span class="operator">=</span> <span class="word">DateTime</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">year</span> <span class="operator">=></span> <span class="number">2014</span><span class="operator">,</span><br /> <span class="word">month</span> <span class="operator">=></span> <span class="number">12</span><span class="operator">,</span><br /> <span class="word">day</span> <span class="operator">=></span> <span class="number">25</span><span class="operator">,</span><br /> <span class="word">hour</span> <span class="operator">=></span> <span class="number">21</span><span class="operator">,</span><br /> <span class="word">minute</span> <span class="operator">=></span> <span class="octal">00</span><span class="operator">,</span><br /> <span class="word">second</span> <span class="operator">=></span> <span class="octal">00</span><span class="operator">,</span><br /> <span class="word">time_zone</span> <span class="operator">=></span> <span class="single">'America/New_York'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$turn_off_lights</span> <span class="operator">=</span> <span class="word">Data::ICal::Entry::Event</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="symbol">$turn_off_lights</span><span class="operator">-></span><span class="word">summary</span><span class="structure">(</span><span class="double">"Turn off lights"</span><span class="structure">);</span><br /><span class="symbol">$turn_off_lights</span><span class="operator">-></span><span class="word">duration</span><span class="structure">(</span> <span class="word">DateTime::Duration</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">minutes</span> <span class="operator">=></span> <span class="number">15</span> <span class="structure">)</span> <span class="structure">);</span><br /><span class="symbol">$turn_off_lights</span><span class="operator">-></span><span class="word">start</span><span class="structure">(</span> <span class="symbol">$ninepm</span> <span class="structure">);</span><br /><span class="symbol">$turn_off_lights</span><span class="operator">-></span><span class="word">add_properties</span><span class="structure">(</span><br /> <span class="word">rrule</span> <span class="operator">=></span> <span class="double">"FREQ=DAILY;COUNT=12"</span> <span class="comment"># every day for 12 days</span><br /><span class="structure">);</span><br /><span class="symbol">$cal</span><span class="operator">-></span><span class="word">add_entry</span><span class="structure">(</span> <span class="symbol">$turn_off_lights</span> <span class="structure">);</span></code></pre>
<h3 id="Ready-to-Go">Ready to Go</h3>
<p>The final result looks awesome:</p>
<center><img src="cal.png"></center>
<p>Now I'm organized. If only I'd had time with all this preparation to go out and buy presents...</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Data::ICal::DateTime">Data::ICal::DateTime</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Data::ICal">Data::ICal</a></p>
</li>
<li><p><a href="https://metacpan.org/module/DateTime">DateTime</a></p>
</li>
<li><p><a href="https://metacpan.org/module/DateTime::Format::ICal">DateTime::Format::ICal</a></p>
</li>
<li><p><a href="https://www.ietf.org/rfc/rfc2445.txt">https://www.ietf.org/rfc/rfc2445.txt</a></p>
</li>
<li><p><a href="http://www.butterball.com/calculators-and-conversions">http://www.butterball.com/calculators-and-conversions</a></p>
</li>
<li><p><a href="https://www.youtube.com/user/TheRoyalChannel">https://www.youtube.com/user/TheRoyalChannel</a></p>
</li>
</ul>
</div>2014-12-18T00:00:00ZMark FowlerOptional tests for optional requirementshttp://perladvent.org/2014/2014-12-17.html<div class='pod'><p>There are some modules on CPAN that provide optional features, where the availability of the feature is dependent on one or more other modules. One common example is optional support for export of data as an SQLite database, which is only supported if <a href="https://metacpan.org/module/DBD::SQLite">DBD::SQLite</a> is installed.</p>
<p>Of course you want tests for all features of your module, and that means you need an optional test for your optional feature. And that's where <a href="https://metacpan.org/module/Test::Requires">Test::Requires</a> comes in.</p>
<p>Let's say you've got some module that builds up information from the net, then can export it in a number of formats. There might be some core formats, like JSON and XML, but there might be some optional ones, such as SQLite. So in your test directory, you might have a file `export-as-sqlite.t`, which would start with:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="words">qw/ DBD::SQLite /</span><span class="structure">;</span><br /><span class="comment"># write test that can safely assume that DBD::SQLite is available</span></code></pre>
<p>If <a href="https://metacpan.org/module/DBD::SQLite">DBD::SQLite</a> isn't available, then the entire test-suite will be skipped. Unless you're running release tests (for example when running `dzil release`), in which case the test-suite will bail out.</p>
<p>You can also use <a href="https://metacpan.org/module/Test::Requires">Test::Requires</a> to require a particular version of Perl for a specific test-suite:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="single">'5.010'</span><span class="structure">;</span></code></pre>
<h2 id="How-do-people-use-it-in-real-life">How do people use it in real life?</h2>
<p>Sometimes you discover a new module that seems pretty groovy, but you can't imagine a use case where <i>you</i> might actually use it. A handy tip for such situations: use <a href="http://grep.cpan.me">grep.cpan.me</a> to find out how other people use the module. In the search box just enter:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::Requires</span></code></pre>
<p>And you'll get a paged list of <a href="http://grep.cpan.me/?q=use+Test%3A%3ARequires">how existing modules use Test::Requires</a>. Let's look at some real-life examples for <a href="https://metacpan.org/module/Test::Requires">Test::Requires</a>!</p>
<h3 id="BPM::Engine">BPM::Engine</h3>
<p><a href="https://metacpan.org/module/BPM::Engine">BPM::Engine</a> is a "Business Process Execution Engine", which can use various database back-ends. It has a class <code>t::TestUtils</code> used by all of the tests, and in there you'll see the line:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="single">'DBD::SQLite'</span><span class="structure">;</span></code></pre>
<p>There's an additional small point illustrated here. To run this test you also need <a href="https://metacpan.org/module/DBI">DBI</a> installed, but given that <a href="https://metacpan.org/module/DBD::SQLite">DBD::SQLite</a> depends on <a href="https://metacpan.org/module/DBI">DBI</a>, you are essentially covering both with the above statement. In general, if there's a chain of dependencies, you only need to specify the last module in the chain.</p>
<h3 id="namespace::autoclean">namespace::autoclean</h3>
<p><a href="https://metacpan.org/module/namespace::autoclean">namespace::autoclean</a> is used to ensure that symbols imported into your module don't pollute your namespace. It has a test file <a href="https://metacpan.org/source/ETHER/namespace-autoclean-0.22/t/moo.t">moo.t</a>, which tests usage of <a href="https://metacpan.org/module/namespace::autoclean">namespace::autoclean</a> with <a href="https://metacpan.org/module/Moo">Moo</a>. At the start of this file you'll see the following, which means that <a href="https://metacpan.org/module/Moo">Moo</a> isn't required to install <a href="https://metacpan.org/module/namespace::autoclean">namespace::autoclean</a></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 /><span class="keyword">use</span> <span class="word">Test::More</span> <span class="float">0.88</span><span class="structure">;</span><br /><span class="structure">{</span><br /> <span class="keyword">package</span> <span class="word">Temp1</span><span class="structure">;</span><br /> <span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="structure">{</span><br /> <span class="single">'Moo'</span> <span class="operator">=></span> <span class="number">0</span><span class="operator">,</span><br /> <span class="structure">};</span><br /><span class="structure">}</span></code></pre>
<p>Why this funny-looking construct? Unfortunately <code>use Test::Requires 'Foo::Bar'</code> ends up running <code>eval "use Foo::Bar"</code>, which means that if <code>Foo::Bar</code> exports any symbols by default, then they'll end up in your namespace. Putting this in a sacrificial namespace avoids that problem.</p>
<h3 id="Kavorka">Kavorka</h3>
<p><a href="https://metacpan.org/author/TOBYINK">Toby Inkster</a>'s <a href="https://metacpan.org/module/Kavorka">Kavorka</a> provides function and method declaration keywords that support signatures. Typically for Toby, he's made sure it plays nicely with <a href="https://metacpan.org/module/Moose">Moose</a>, <a href="https://metacpan.org/module/Mouse">Mouse</a>, and <a href="https://metacpan.org/module/Moo">Moo</a>. So in the test-suite <a href="https://metacpan.org/source/TOBYINK/Kavorka-0.036/t/21modifiers-moose.t#L1">21modifiers-moose.t</a> you'll see:</p>
<pre><code class="code-listing"> <span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="structure">{</span> <span class="single">'Moose'</span> <span class="operator">=></span> <span class="single">'2.0000'</span> <span class="structure">};</span></code></pre>
<p>This shows the syntax for specifying a minimum required version of the module.</p>
<h3 id="ZeroMQ">ZeroMQ</h3>
<p>Above I said that you only need to use <code>Test::Requires</code> on the last module in a dependency chain. But sometimes a test might require two independent modules. For example, <a href="https://metacpan.org/module/ZeroMQ">ZeroMQ</a>'s <a href="https://metacpan.org/source/DMAKI/ZeroMQ-0.23/t/006_anyevent.t">006_anyevent.t</a> has the line:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="words">qw( Test::TCP AnyEvent )</span><span class="structure">;</span></code></pre>
<p>Which means the test will be skipped unless both modules are installed.</p>
<h3 id="Tiffany">Tiffany</h3>
<p><a href="https://metacpan.org/author/TOKUHIROM">TOKUHIROM</a>'s <a href="https://metacpan.org/module/Tiffany">Tiffany</a> provides a generic interface to multiple templating engines. So by now you shouldn't be surprised to see the following line in a test:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="single">'Text::Xslate'</span><span class="structure">;</span></code></pre>
<h3 id="Text::Xslate">Text::Xslate</h3>
<p>You really don't want memory leaks in your templating system, but not everyone will have modules like <a href="https://metacpan.org/module/Test::LeakTrace">Test::LeakTrace</a> installed. So <a href="https://metacpan.org/module/Text::Xslate">Text::Xslate</a>'s test file <a href="https://metacpan.org/source/SYOHEX/Text-Xslate-3.3.3/t/010_internals/200_leaktrace.t">200_leaktrace.t</a> has:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::Requires</span> <span class="structure">{</span> <span class="single">'Test::LeakTrace'</span> <span class="operator">=></span> <span class="float">0.13</span> <span class="structure">};</span></code></pre>
<p>Similarly other modules have optional tests using <a href="https://metacpan.org/module/Devel::Monitor">Devel::Monitor</a>.</p>
<h2 id="Summary">Summary</h2>
<p><a href="https://metacpan.org/module/Test::Requires">Test::Requires</a> is handy when writing tests for a distribution that provides optional features based on modules in other CPAN distributions. Some common examples are:</p>
<ul>
<li><p>Supporting multiple database engines.</p>
</li>
<li><p>Supporting multiple template engines.</p>
</li>
<li><p>Where some things are only accessible via https, so you need <a href="https://metacpan.org/module/IO::Socket::SSL">IO::Socket::SSL</a>.</p>
</li>
<li><p>Supporting multiple serialisation modules, such as <a href="https://metacpan.org/module/Storable">Storable</a>, <a href="https://metacpan.org/module/Sereal">Sereal</a>, or even <a href="https://metacpan.org/module/DBD::SQLite">SQLite</a>.</p>
</li>
<li><p>Supporting multiple formats like YAML, JSON, XML.</p>
</li>
<li><p>Supporting multiple HTTP request user agents, such as <a href="https://metacpan.org/module/HTTP::Tiny">HTTP::Tiny</a>, <a href="https://metacpan.org/module/LWP">LWP</a>, <a href="https://metacpan.org/module/WWW::Mechanize">WWW::Mechanize</a>.</p>
</li>
<li><p>Running some tests only if certain <code>Devel::</code> modules are installed.</p>
</li>
</ul>
<p>One thing to be aware of: <code>Test::Requires</code> ends up <code>use</code>'ing the target modules.</p>
<h3 id="See-Also">See Also</h3>
<ul>
<li><p><a href="https://metacpan.org/module/Test::RequiresInternet">Test::RequiresInternet</a> - skip test if we can't access the interwebs</p>
</li>
<li><p><a href="https://metacpan.org/module/Test::Requires::Env">Test::Requires::Env</a> - skip tests if certain environment variables aren't set (optionally requiring specific values).</p>
</li>
</ul>
</div>2014-12-17T00:00:00ZNeil BowersHow Santa's Elves Keep their Workshop Tidyhttp://perladvent.org/2014/2014-12-16.html<div class='pod'><p><a href="https://metacpan.org/module/Code::TidyAll">Code::TidyAll</a> bills itself as <code>Your all-in-one code tidier and validator</code>. Many people do not know this, but <code>tidyall</code> has become an indispensable part of the toolkit in Santa's workshop. It makes it trivial for the elves to keep their code formatting consistent and clean.</p>
<h3 id="Perl::Tidy">Perl::Tidy</h3>
<p>Many of us are familiar with <a href="https://metacpan.org/module/Perl::Tidy">Perl::Tidy</a> (the Perl module for reformatting your source code in a consistent manner according to a set of rules,) so we'll start with it as an example. Since the elves work as a team, it's easiest for them to add their common <code>.perltidyrc</code> to their Git repository. Next they create an rc file for the <code>tidyall</code> command line utility. They add this to the top level of their repository and call it <code>.tidyallrc</code>:</p>
<pre><code class="code-listing"><span class="synSpecial">[PerlTidy]</span><br /><span class="synType">select</span> =<span class="synConstant"> {bin,lib,t}/**/*.{pl,pm,t,psgi}</span><br /><span class="synType">select</span> =<span class="synConstant"> santas-workshop.psgi</span><br /><span class="synType">ignore</span> =<span class="synConstant"> lib/Acme/Claus/Roles/JellyBelly.pm</span><br /><span class="synType">argv</span> =<span class="synConstant"> --profile=$ROOT/.perltidyrc</span></code></pre>
<p>Each section of a <code>.tidyallrc</code> file begins by specifying the tidier/formatter which is being configured. In this case it's the <a href="https://metacpan.org/module/Code::TidyAll::Plugin::PerlTidy">Code::TidyAll::Plugin::PerlTidy</a> plugin which plugs <a href="https://metacpan.org/module/Perl::Tidy">Perl::Tidy</a> into <code>tidyall</code>. The <code>select</code> args accept <a href="https://metacpan.org/module/File::Zglob">File::Zglob</a> patterns (i.e. shell glob pattern). This allows the elves to configure which files the plugin should be applied to. Similarly, they can also add <code>ignore</code> patterns to exclude arbitrary files and patterns.</p>
<p>The <code>argv</code> param lets the elves specify a set of arguments to pass to <a href="https://metacpan.org/module/Perl::Tidy">Perl::Tidy</a>. In this case the elves use the <code>profile</code> arg, which tells <code>perltidy</code> where to find a valid <code>.perltidyrc file</code>. <code>$ROOT</code> is a special variable provided by <code>tidyall</code> which means the top level of the repository it has been added to.</p>
<p>Now, they're all set. <code>tidyall -a</code> will tidy everything which matches the <code>select</code> statements in the configuration. <code>tidyall -g</code> is much like <code>tidyall -a</code> but it is restricted to all files which have been changed but not yet committed to the git repository they're currently working in.</p>
<p>Let's have a look at an example. This is the repository the elves are working on:</p>
<pre><code> $ tree
.
|-- Changes
|-- MANIFEST.SKIP
|-- dist.ini
|-- lib
| `-- Acme
| `-- Claus
| | `-- Roles
| | | `-- JellyBelly.pm
| | `-- Sleigh.pm
| `-- Claus.pm
`-- santas-workshop.psgi</code></pre>
<p>Let's ask <code>tidyall</code> to check everything, using the <code>-a</code> flag.</p>
<pre><code> $ tidyall -a
[tidied] lib/Acme/Claus.pm
[checked] lib/Acme/Claus/Sleigh.pm
[checked] santas-workshop.psgi</code></pre>
<p>You can see from the above that tidyall only checked the files that we configured it to look at. Now, what if we only want to check the files which have uncommitted changes in Git.</p>
<pre><code> $ git status
On branch master
Changes not staged for commit:
(use "git add <file>..." to update what will be committed)
(use "git checkout -- <file>..." to discard changes in working directory)
modified: lib/Acme/Claus.pm</code></pre>
<p>We have one modified file, <code>lib/Acme/Claus.pm</code>. So, let's constrain this further and use the <code>-g</code> flag. This should mean that only one file gets checked and possibly tidied.</p>
<pre><code> tidyall -g
[tidied] lib/Acme/Claus.pm</code></pre>
<p>It worked! At this point the elves essentially have a wrapper around <code>perltidy</code>, which lets them restrict which files the transformations are applied to. Helpful, right? Let's take it a step further. Two of the elves on the gifting geolocation team, Holly and Max, are pretty good about tidying their files before they commit them to the workshop's main repo. However, the other half of the team, Buddy and Peppermint aren't quite so disciplined. How can Holly and Max ensure that Buddy and Peppermint work together with the rest of the team? Well, since they're using Git, there are a few things they can do. (This would be a good time to note that <code>tidyall</code> has Subversion support too.)</p>
<h3 id="No-Untidy-Code-Makes-it-Past-this-Hook">No Untidy Code Makes it Past this Hook</h3>
<p>The first thing Holly and Max can try is using a pre-commit hook. Setting it up is easy.</p>
<pre><code> mkdir -p git/hooks</code></pre>
<p>Now create git/hooks/pre-commit with the following content:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/env perl<br /></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="word">Code::TidyAll::Git::Precommit</span><span class="structure">;</span><br /><span class="word">Code::TidyAll::Git::Precommit</span><span class="operator">-></span><span class="word">check</span><span class="structure">();</span></code></pre>
<p>Then create git/setup.sh</p>
<pre><code class="code-listing"><span class="synComment">#!/bin/bash</span><br /><span class="synStatement">chmod</span> <span class="synSpecial">+x</span> git/hooks/pre-commit<br /><span class="synStatement">cd</span> .git/hooks<br />ln <span class="synSpecial">-s</span> ../../git/hooks/pre-commit</code></pre>
<p>Now, all Holly and Max need to do is tell Buddy and Peppermint to check out the latest commits from master and run the following command:</p>
<pre><code> sh git/setup.sh</code></pre>
<p>This will set up a hook which runs before any git commit in the local repo is finalized. Note that the hook will not tidy your files. It will merely warn you about untidy code and prevent the commit. (You can get the same behaviour at the command line by supplying the <code>--check-only</code> arg). At this point you can check what the problems are and then run <code>tidyall -g</code> as appropriate. Then be sure to perform your tidying before you commit. If you don't, <code>tidyall</code> will be fooled into thinking that your commits are clean, even if you haven't staged the tidied bits.</p>
<p>For example, what happens if someone tries to commit untidy code?</p>
<pre><code> $ git commit
[checked] lib/Acme/Claus.pm
*** needs tidying
1 file did not pass tidyall check</code></pre>
<p>In a traditional git setup it's also possible to install similar pre-receive hooks that run on the main repository whenever someone pushes code to it. However, since Santa's workshop runs Github Enterprise - where pre-receive hooks aren't possible without some wrangling - pre-commit hooks and a strong lecture on always installing them clientside will have to do.</p>
<h3 id="Testing-to-Keep-Buddy-and-Peppermint-in-Line">Testing to Keep Buddy and Peppermint in Line</h3>
<p>Now, it's entirely possible that someone will forget to enable the hook or even intentionally bypass it. (You can do this with <code>git commit --no-verify</code>). Let's put another safeguard in place to catch the naughty elves.</p>
<p>Let's create a file called t/tidyall.t and add the following lines:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><span class="keyword">use</span> <span class="word">Test::Code::TidyAll</span><span class="structure">;</span><br /><span class="word">tidyall_ok</span><span class="structure">();</span></code></pre>
<p>Now we'll have a failing test whenever something untidy makes it into the master branch. Holly and Max are now safe in the knowledge that whenever untidy code is tested via their CS (continuous santagration) that the test suite will curse loudly and the perpetrator(s) will be exposed. In fact, it should look a little bit like this:</p>
<pre><code> $ prove t/tidyall.t
t/tidyall.t ..
1..4
[checked] lib/Acme/Claus.pm
*** needs tidying
# *** needs tidying
not ok 1 - lib/Acme/Claus.pm
# Failed test 'lib/Acme/Claus.pm'
# at t/tidyall.t line 3.
ok 2 - lib/Acme/Claus/Sleigh.pm
ok 3 - santas-workshop.psgi
[checked] t/tidyall.t
ok 4 - t/tidyall.t
# Looks like you failed 1 test of 4.
Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/4 subtests
Test Summary Report
-------------------
t/tidyall.t (Wstat: 256 Tests: 4 Failed: 1)
Failed test: 1
Non-zero exit status: 1
Files=1, Tests=4, 1 wallclock secs ( 0.03 usr 0.01 sys + 0.24 cusr 0.02 csys = 0.30 CPU)
Result: FAIL</code></pre>
<h3 id="Can-the-Elves-add-a-vim-Key-Binding">Can the Elves add a vim Key Binding?</h3>
<p>Of course. They can add the following to their .vimrc file:</p>
<pre><code> " Run tidyall on the current buffer. If an error occurs, show it and leave it
" in tidyall.ERR, and undo any changes.
command! TidyAll :call TidyAll()
function! TidyAll()
let cur_pos = getpos( '.' )
let cmdline = ':1,$!tidyall --mode editor --pipe %:p 2> tidyall.ERR'
execute( cmdline )
if v:shell_error
echo "\nContents of tidyall.ERR:\n\n" . system( 'cat tidyall.ERR' )
silent undo
else
call system( 'rm tidyall.ERR' )
endif
call setpos( '.', cur_pos )
endfunction
" Uncomment to set leader to ,
" let mapleader = ','
" Bind to ,t (or leader+t)
map <leader>t :TidyAll<cr></code></pre>
<p>There may also be the odd elf who swears by emacs. The emacs code can be found in the repository <a href="https://github.com/autarch-code/perl-code-tidyall/blob/master/etc/editors/tidyall.el">https://github.com/autarch-code/perl-code-tidyall/blob/master/etc/editors/tidyall.el</a></p>
<h3 id="What-next">What next?</h3>
<p>So far we have perltidy set up, we have a Git hook to enforce it and a test to make sure the hook is being enforced. What's next?</p>
<p>The great thing about this module is that it has many plugins, so it's not just about tidying Perl code. You can add any of the following plugins to your projects:</p>
<ul>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::CSSUnminifier">Code::TidyAll::Plugin::CSSUnminifier</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::Go">Code::TidyAll::Plugin::Go</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::JSBeautify">Code::TidyAll::Plugin::JSBeautify</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::JSHint">Code::TidyAll::Plugin::JSHint</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::JSLint">Code::TidyAll::Plugin::JSLint</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::JSON">Code::TidyAll::Plugin::JSON</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::MasonTidy">Code::TidyAll::Plugin::MasonTidy</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::PHPCodeSniffer">Code::TidyAll::Plugin::PHPCodeSniffer</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::PerlCritic">Code::TidyAll::Plugin::PerlCritic</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::PodChecker">Code::TidyAll::Plugin::PodChecker</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::PodSpell">Code::TidyAll::Plugin::PodSpell</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::SVG">Code::TidyAll::Plugin::SVG</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::SortLines">Code::TidyAll::Plugin::SortLines</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::SortLines::Naturally">Code::TidyAll::Plugin::SortLines::Naturally</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Code::TidyAll::Plugin::UniqueLines">Code::TidyAll::Plugin::UniqueLines</a></p>
</li>
</ul>
<p>With this much plugin support <code>tidyall</code> can be used for front end as well as back end development. As mentioned above, it works with Subversion as well as Git. It helps Santa's elves keep their workshop clean and tidy. Maybe it can help your workshop as well.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Code::TidyAll">Code::TidyAll</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Perl::Tidy">Perl::Tidy</a></p>
</li>
</ul>
</div>2014-12-16T00:00:00ZOlaf AldersFinding CPAN distributions with github repositorieshttp://perladvent.org/2014/2014-12-15.html<div class='pod'><p>Blink the elf wasn't happy, because Father C wasn't happy. Blink had been told to send presents to every CPAN author who released a new distribution (aka <i>neocpanism</i>) to CPAN this year, regardless of who had done the most recent release of the distribution. But the distribution had to still be on CPAN.</p>
<p>"Does SHARYANTO get one for <i>every</i> dist?!", Blink had asked, but got a cuff round the ear for that.</p>
<p>He thought he'd done a good job, but the Senior Elf had just been to tell him that some authors had missed out.</p>
<p>Father C doesn't like it when people don't get the presents they should.</p>
<h3 id="What-went-wrong">What went wrong?</h3>
<p>Blink had remembered that they have their own CPAN mirror at the North Pole, so he just used <a href="https://metacpan.org/module/Path::Iterator::Rule">Path::Iterator::Rule</a> to iterate over it, looking for the <code>META.yml</code> files which hold the metadata for each distribution. From those he pulled out the <a href="https://metacpan.org/pod/CPAN::Meta::Spec#name">name</a> key, which holds the distribution's name.</p>
<p>He'd remembered that they have a database of CPAN authors and their <a href="http://neilb.org/neocpanisms/">neocpanisms</a>, so he'd used that get the other information he needed.</p>
<p>But on closer inspection, he discovered that not all distribution names from metadata files matched those in the database. "Sort it out, and send some pull requests!", the Senior Elf had chastised him.</p>
<h3 id="Distribution-names">Distribution names</h3>
<p>When you create a module <code>Foo::Bar</code>, you would normally release it to CPAN as part of a distribution called <code>Foo-Bar</code>. You can specify the distribution name yourself, but distribution builders like <a href="https://metacpan.org/module/ExtUtils::MakeMaker">ExtUtils::MakeMaker</a> will produce the dist name for you, based on the module name. The distribution name ends up in the metadata file.</p>
<p>When you release a version of your distribution, the <i>tarball</i> usually has a name built up from the distribution name, the version, and whatever extension is used for the archiving method you used. So Foo::Bar 0.01 would probably be released in <b>Foo-Bar-0.01.tar.gz</b>. If Blink had released this, the location of this release on CPAN would be:</p>
<pre><code> B/BL/BLINK/Foo-Bar-0.01.tar.gz</code></pre>
<p>These paths turn up everywhere in the CPAN ecosystem, so there's a module <a href="https://metacpan.org/module/CPAN::DistnameInfo">CPAN::DistnameInfo</a> which takes a path and picks it apart. As a result, most parts of the ecosystem assume that the dist name inferred by <a href="https://metacpan.org/module/CPAN::DistnameInfo">CPAN::DistnameInfo</a> is the right distribution name.</p>
<p>The problem can arise where the release name isn't based on the distribution name, which might be for a variety of reasons. Sometimes the filename has the right dist name, and it's the metadata that doesn't.</p>
<h3 id="Finding-the-problem-distributions">Finding the problem distributions</h3>
<p>"Talk to Olaf", Senior Elf had told Blink. But after a frustrating ten minutes, Blink went back to SE, complaining that Olaf just sang about summer. "No, not <a href="http://en.wikipedia.org/wiki/Olaf_(Disney)">Olaf the Snowman</a>, I meant <a href="https://metacpan.org/author/OALDERS">Olaf Alders</a>!".</p>
<p>With Olaf's help, Blink wrote the following, to iterate over all CPAN distributions, using the MetaCPAN API:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">MetaCPAN::Client</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$client</span> <span class="operator">=</span> <span class="word">MetaCPAN::Client</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="keyword">my</span> <span class="symbol">$query</span> <span class="operator">=</span> <span class="structure">{</span> <span class="word">all</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="structure">{</span> <span class="word">status</span> <span class="operator">=></span> <span class="single">'latest'</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">maturity</span> <span class="operator">=></span> <span class="single">'released'</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">]};</span><br /><span class="keyword">my</span> <span class="symbol">$params</span> <span class="operator">=</span> <span class="structure">{</span> <span class="word">fields</span> <span class="operator">=></span> <span class="structure">[</span><span class="words">qw/ metadata download_url /</span><span class="structure">]</span> <span class="structure">};</span><br /><span class="keyword">my</span> <span class="symbol">$result_set</span> <span class="operator">=</span> <span class="symbol">$client</span><span class="operator">-></span><span class="word">release</span><span class="structure">(</span><span class="symbol">$query</span><span class="operator">,</span> <span class="symbol">$params</span><span class="structure">);</span><br /><br /><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="symbol">$release</span> <span class="operator">=</span> <span class="symbol">$result_set</span><span class="operator">-></span><span class="word">next</span><span class="structure">)</span> <span class="structure">{</span><br /><span class="structure">}</span></code></pre>
<p>The <code>maturity => 'released'</code> says that you don't want developer releases, and <code>status => 'latest'</code> says that you only want the latest release for each distribution.</p>
<p>You can look at the release data for a distribution using the API in a browser, for example <a href="https://api.metacpan.org/release/URI-Title">https://api.metacpan.org/release/URI-Title</a>. You'll see there's a lot of information. If you're only interested in some of it, you can just request specific fields (the <code>$params</code> hashref above, passed to the <code>release</code> method. The <code>$release</code> above is a hashref, which contains slices of the data you saw from the API.</p>
<p>The two bits of interest here are:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$distname</span> <span class="operator">=</span> <span class="symbol">$release</span><span class="operator">-></span><span class="word">metadata</span><span class="operator">-></span><span class="structure">{</span><span class="word">name</span><span class="structure">};</span><br /><span class="comment"># "URI-Title"<br /></span><br /><span class="keyword">my</span> <span class="symbol">$path</span> <span class="operator">=</span> <span class="symbol">$release</span><span class="operator">-></span><span class="word">download_url</span><span class="structure">;</span><br /><span class="comment"># "http://cpan.metacpan.org/authors/id/B/BO/BOOK/URI-Title-1.89.tar.gz"</span></code></pre>
<p>Notice that <code>download_url</code> is a direct accessor. The <code>metadata</code> accessor returns a hash reference, which you can drill into to get the specific bits of metadata you're after.</p>
<p>You can then give that <code>$path</code> to <a href="https://metacpan.org/module/CPAN::DistnameInfo">CPAN::DistnameInfo</a>, and the <code>dist</code> method tells you what it thinks the distribution name is. So Blink could compare that with the name from the metadata file, which handily is also available:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">CPAN::DistnameInfo</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dinfo</span> <span class="operator">=</span> <span class="word">CPAN::DistnameInfo</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="symbol">$path</span><span class="structure">);</span><br /><span class="word">push</span><span class="structure">(</span><span class="symbol">@bad</span><span class="operator">,</span> <span class="symbol">$path</span><span class="structure">)</span> <span class="word">if</span> <span class="symbol">$dinfo</span><span class="operator">-></span><span class="word">dist</span> <span class="operator">ne</span> <span class="symbol">$distname</span><span class="structure">;</span></code></pre>
<p>Handily, MetaCPAN has already done that conversion for you, and the distribution name according to <a href="https://metacpan.org/module/CPAN::DistnameInfo">CPAN::DistnameInfo</a> is available in the <code>distribution</code> field from the API, and the accessor of the same name. So the above code becomes:</p>
<pre><code class="code-listing"><span class="word">push</span><span class="structure">(</span><span class="symbol">@bad</span><span class="operator">,</span> <span class="symbol">$path</span><span class="structure">)</span> <span class="word">if</span> <span class="symbol">$release</span><span class="operator">-></span><span class="word">distribution</span> <span class="operator">ne</span> <span class="symbol">$release</span><span class="operator">-></span><span class="word">metadata</span><span class="operator">-></span><span class="structure">{</span><span class="word">name</span><span class="structure">};</span></code></pre>
<p>So now Blink could build a list of problem distributions, but he'd been told to send some pull requests as penance. How could he find out which of the distributions were on github?</p>
<p>He found an <a href="http://perlmaven.com/how-to-add-link-to-version-control-system-of-a-cpan-distributions">article</a> which explained how the github repository can be recorded in a distribution's metadata. If you look in <a href="https://api.metacpan.org/release/URI-Title">that API output</a>, you'll find it under the <code>resources</code> key.</p>
<p>You can use this fact to further constrain your MetaCPAN search, so that you only consider distributions with a github repo in their metadata:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$query</span> <span class="operator">=</span> <span class="structure">{</span> <span class="word">all</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="structure">{</span> <span class="word">status</span> <span class="operator">=></span> <span class="single">'latest'</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">maturity</span> <span class="operator">=></span> <span class="single">'released'</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="single">'resources.repository.url'</span> <span class="operator">=></span> <span class="single">'*github*'</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">]};</span></code></pre>
<p>Blink showed his code to Olaf, who explained that when searching on MetaCPAN you can specify which fields you're interested in from the API, and you'll only get those. This results in a lot fewer bytes coming back over the wire.</p>
<p>They paired up to refactor Blink's code, and ended up with this:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">MetaCPAN::Client</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$client</span> <span class="operator">=</span> <span class="word">MetaCPAN::Client</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="keyword">my</span> <span class="symbol">$query</span> <span class="operator">=</span> <span class="structure">{</span> <span class="word">all</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="structure">{</span> <span class="word">status</span> <span class="operator">=></span> <span class="single">'latest'</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">maturity</span> <span class="operator">=></span> <span class="single">'released'</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="single">'resources.repository.url'</span> <span class="operator">=></span> <span class="single">'*github*'</span> <span class="structure">}</span><br /> <span class="structure">]};</span><br /><span class="keyword">my</span> <span class="symbol">$params</span> <span class="operator">=</span> <span class="structure">{</span> <span class="word">fields</span> <span class="operator">=></span> <span class="structure">[</span><span class="words">qw/ metadata distribution /</span><span class="structure">]</span> <span class="structure">};</span><br /><span class="keyword">my</span> <span class="symbol">$result_set</span> <span class="operator">=</span> <span class="symbol">$client</span><span class="operator">-></span><span class="word">release</span><span class="structure">(</span><span class="symbol">$query</span><span class="operator">,</span> <span class="symbol">$params</span><span class="structure">);</span><br /><br /><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="symbol">$release</span> <span class="operator">=</span> <span class="symbol">$result_set</span><span class="operator">-></span><span class="word">next</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$release</span><span class="operator">-></span><span class="word">distribution</span> <span class="operator">ne</span> <span class="symbol">$release</span><span class="operator">-></span><span class="word">metadata</span><span class="operator">-></span><span class="structure">{</span><span class="word">name</span><span class="structure">})</span> <span class="structure">{</span><br /> <span class="word">printf</span> <span class="double">"Distribution '%s' has name '%s' in metadata\n"</span><span class="operator">,</span><br /> <span class="symbol">$release</span><span class="operator">-></span><span class="word">distribution</span><span class="operator">,</span><br /> <span class="symbol">$release</span><span class="operator">-></span><span class="word">metadata</span><span class="operator">-></span><span class="structure">{</span><span class="word">name</span><span class="structure">};</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p>Blink completed his task, and <a href="https://metacpan.org/author/TEODESIAN">TEODESIAN</a> and other authors got their gifts.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/MetaCPAN::Client">MetaCPAN::Client</a></p>
</li>
<li><p><a href="https://metacpan.org/module/CPAN::DistnameInfo">CPAN::DistnameInfo</a></p>
</li>
</ul>
</div>2014-12-15T00:00:00ZNeil BowersAll I want for Christmas is less boilerplatehttp://perladvent.org/2014/2014-12-14.html<div class='pod'><p>Santa's elves were once again programming away. With the population growing and Christmas more popular than ever they had replaced their hammers and saws with shiny new computers and keyboards, and CPAN modules that could order presents from Amazon and eBay and even Etsy.</p>
<p>It was critical that everything run smoothly, or all the girls and boys of the world would be waking up on Christmas morning to find no presents to mark Santa's visit. So, naturally, the elves had tested their code very thoroughly, taking full advantage of all the CPAN has to offer.</p>
<p>Their <code>t/</code> directory was bursting with <code>.t</code> files, and every time it came to create a new test a new <code>.t</code> file would be created, and the first 30 or so lines of another random <code>.t</code> file would be copied over to get it started.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Test::More</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Test::FailWarnings</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::Warn</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::Exception</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::Output</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::MockObject</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::MockModule</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::File</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::LongString</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::JSON</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Data::Dumper</span><span class="structure">;</span><br /><br /><span class="word">binmode</span> <span class="word">Test::More</span><span class="operator">-></span><span class="word">builder</span><span class="operator">-></span><span class="word">output</span><span class="operator">,</span> <span class="double">":encoding(utf8)"</span><span class="structure">;</span><br /><span class="word">binmode</span> <span class="word">Test::More</span><span class="operator">-></span><span class="word">builder</span><span class="operator">-></span><span class="word">failure_output</span><span class="operator">,</span> <span class="double">":encoding(utf8)"</span><span class="structure">;</span><br /><span class="word">binmode</span> <span class="word">Test::More</span><span class="operator">-></span><span class="word">builder</span><span class="operator">-></span><span class="word">todo_output</span><span class="operator">,</span> <span class="double">":encoding(utf8)"</span><span class="structure">;</span></code></pre>
<p>One day one particular elf was doing this copy-paste manoeuvre when something came to him in a flash: "Copy pasting code is bad!", he realised, "I would never copy and paste this much code around in <code>lib/SantasWorkshop/</code> so why is it ok in <code>t/</code>?". And, of course, he realised that it wasn't.</p>
<h3 id="Test-Kits">Test Kits</h3>
<p>The elf reached for the CPAN and pulled out Test::Kit, and created a shiny new module.</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">SantasWorkshop::Test</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Test::Kit</span><span class="structure">;</span><br /><br /><span class="word">include</span> <span class="single">'Test::More'</span><span class="structure">;</span><br /><br /><span class="word">include</span> <span class="single">'Test::FailWarnings'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::Warn'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::Exception'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::Output'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::MockObject'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::MockModule'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::File'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::LongString'</span><span class="structure">;</span><br /><span class="word">include</span> <span class="single">'Test::JSON'</span><span class="structure">;</span><br /><br /><span class="word">include</span> <span class="single">'Data::Dumper'</span><span class="structure">;</span><br /><br /><span class="word">binmode</span> <span class="word">Test::More</span><span class="operator">-></span><span class="word">builder</span><span class="operator">-></span><span class="word">output</span><span class="operator">,</span> <span class="double">":encoding(utf8)"</span><span class="structure">;</span><br /><span class="word">binmode</span> <span class="word">Test::More</span><span class="operator">-></span><span class="word">builder</span><span class="operator">-></span><span class="word">failure_output</span><span class="operator">,</span> <span class="double">":encoding(utf8)"</span><span class="structure">;</span><br /><span class="word">binmode</span> <span class="word">Test::More</span><span class="operator">-></span><span class="word">builder</span><span class="operator">-></span><span class="word">todo_output</span><span class="operator">,</span> <span class="double">":encoding(utf8)"</span><span class="structure">;</span></code></pre>
<p>And then he simply replaced all that boilerplate in the tests with <code>use SantasWorkshop::Test;</code> and he got all the testing subroutines he wanted imported in a single statement.</p>
<p>At this point our elf got a bit excited. He replaced ALL the boilerplate in ALL the tests!</p>
<pre><code class="code-listing">elf@workshop:~/code$ git show ea7ebd9 <span class="synSpecial">--shortstat</span><br />commit ea7ebd9cf387cd63d2a4b4e2f257e69d08ba7b5e<br />Author: Legolas Greenleaf <span class="synStatement"><</span>legolas@santasworkshop.fi<span class="synStatement">></span><br />Date: Sat Dec <span class="synConstant">13</span> 08:35:23 <span class="synConstant">2014</span> +<span class="synConstant">0100</span><br /><br />Migrate ALL tests to SantasWorkshop::Test Test Kit<br /><br /><span class="synConstant">1322</span> files changed, <span class="synConstant">2325</span> insertions<span class="synPreProc">(</span><span class="synSpecial">+</span><span class="synPreProc">)</span>, <span class="synConstant">7549</span> deletions<span class="synPreProc">(</span><span class="synSpecial">-</span><span class="synPreProc">)</span></code></pre>
<p>And would you believe that with all those lines of code deleted every test still passed, and every child around the world got their presents?</p>
<h3 id="Advanced-Features">Advanced Features</h3>
<p>When word got around to Santa he was very impressed; so much so that he wanted to give Test::Kit a go on his own projects. As he read the POD for the module he let out a jolly "ho ho ho!" when he saw a feature he thought was very nice.</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Santa::NaughtyNice::Test</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Test::Kit</span><span class="structure">;</span><br /><br /><span class="word">include</span> <span class="single">'Test::More'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">renamed</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="single">'ok'</span> <span class="operator">=></span> <span class="single">'nice'</span><span class="operator">,</span><br /> <span class="single">'fail'</span> <span class="operator">=></span> <span class="single">'naughty'</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">};</span></code></pre>
<p>Now he could assert in his tests that variables were <code>nice()</code>, and if anything went really wrong he just needed to use <code>naughty()</code> to add a 'not ok' to his test output.</p>
<p>What a jolly old time Santa will have writing tests now!</p>
<h2 id="SEE-ALSO">SEE ALSO</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Test::Kit">Test::Kit</a></p>
</li>
</ul>
</div>2014-12-14T00:00:00ZAlex BalhatchetNow I Have Better Optionshttp://perladvent.org/2014/2014-12-13.html<div class='pod'><p>Today we're looking at MooX::Options, a better way to parse command line options when you're using a Moo class for the basis of a script. Through MooX::Options we're able to leverage the power of building reusable parts of our scripts with roles and have those roles handle parsing and documenting their own command line arguments.</p>
<h3 id="Ye-Olde-Getopt::Long">Ye Olde Getopt::Long</h3>
<p>For a long time I considered command line argument parsing a solved problem within Perl. Perl shipped with Getopt::Long module with the very first version of Perl 5, and I've admired it's simplicity and power ever since... in fact I recommended it back in the first Perl Advent Calendar fourteen years ago.</p>
<p>GetOpt::Long uses a simple function interface into which you pass command line option specifications and references to variables you want to populate:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Getopt::Long</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$filename</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$verbose</span><span class="structure">;</span><br /><br /><span class="word">GetOptions</span><span class="structure">(</span><br /> <span class="double">"filename=s"</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$filename</span><span class="operator">,</span><br /> <span class="double">"verbose"</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$verbose</span><span class="operator">,</span><br /><span class="structure">)</span> <span class="operator">or</span> <span class="word">die</span><span class="structure">(</span><span class="double">"Error in command line argument"</span><span class="structure">);</span></code></pre>
<h3 id="Modern-Perl-Scripts">Modern Perl Scripts</h3>
<p>However, somewhere in the last fourteen years the way I write scripts has changed significantly. Where I used to write all my code in one file, I gradually moved more and more code into separate modules until I reached the natural conclusion: The whole code of the script is actually in a module and the script is nothing more than a shim to load the module, instantiate an object, and call the <code>run</code> method on it.</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="comment"># include the "lib" directory in the same directory as the<br /># script in our module path<br /></span><span class="keyword">use</span> <span class="word">FindBin</span> <span class="words">qw($FindBin::Bin)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">File::Spec::Functions</span> <span class="words">qw(catdir)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">lib</span> <span class="word">catdir</span><span class="structure">(</span><span class="symbol">$FindBin::Bin</span><span class="operator">,</span> <span class="double">"lib"</span><span class="structure">);</span><br /><br /><span class="keyword">use</span> <span class="word">MyScriptModule</span><span class="structure">;</span><br /><span class="word">print</span> <span class="word">MyScriptModule</span><span class="operator">-></span><span class="word">new</span><span class="operator">-></span><span class="word">run</span><span class="structure">;</span></code></pre>
<p>This has several advantages from code reuse (several scripts can use the same module but instantiate it with different options) through to ease of testing (we can instantiate our object directly in our test scripts and test that rather than having to execute a new Perl process to run the script.)</p>
<p>The pertinent question seems to be: How do we handle command line options in this situation?</p>
<p>One really basic tactic is to parse the options as before with Getopt::Long and then pass the options through to the object in the constructor:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="comment"># include the "lib" directory in the same directory as the<br /># script in our module path<br /></span><span class="keyword">use</span> <span class="word">FindBin</span> <span class="words">qw($FindBin::Bin)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">File::Spec::Functions</span> <span class="words">qw(catdir)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">lib</span> <span class="word">catdir</span><span class="structure">(</span><span class="symbol">$FindBin::Bin</span><span class="operator">,</span> <span class="double">"lib"</span><span class="structure">);</span><br /><br /><span class="keyword">use</span> <span class="word">Getopt::Long</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$filename</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$verbose</span><span class="structure">;</span><br /><br /><span class="word">GetOptions</span><span class="structure">(</span><br /> <span class="double">"filename=s"</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$filename</span><span class="operator">,</span><br /> <span class="double">"verbose"</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$verbose</span><span class="operator">,</span><br /><span class="structure">)</span> <span class="operator">or</span> <span class="word">die</span><span class="structure">(</span><span class="double">"Error in command line argument"</span><span class="structure">);</span><br /><br /><span class="keyword">use</span> <span class="word">MyScriptModule</span><span class="structure">;</span><br /><span class="word">print</span> <span class="word">MyScriptModule</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">verbose</span> <span class="operator">=></span> <span class="symbol">$verbose</span><span class="operator">,</span><br /> <span class="word">filename</span> <span class="operator">=></span> <span class="symbol">$filename</span><span class="operator">,</span><br /><span class="structure">)</span><span class="operator">-></span><span class="word">run</span><span class="structure">;</span></code></pre>
<p>The problem you can see here is this supposed shim script is getting very long and has a lot of logic in it. Logic that can't be now reused between scripts. Logic that has no easy way to be tested.</p>
<p>A slightly better tactic might be to move the parsing code inside a special constructor in the MyScriptModule class:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="comment"># include the "lib" directory in the same directory as the<br /># script in our module path<br /></span><span class="keyword">use</span> <span class="word">FindBin</span> <span class="words">qw($FindBin::Bin)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">File::Spec::Functions</span> <span class="words">qw(catdir)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">lib</span> <span class="word">catdir</span><span class="structure">(</span><span class="symbol">$FindBin::Bin</span><span class="operator">,</span> <span class="double">"lib"</span><span class="structure">);</span><br /><br /><span class="keyword">use</span> <span class="word">MyScriptModule</span><span class="structure">;</span><br /><span class="word">print</span> <span class="word">MyScriptModule</span><span class="operator">-></span><span class="word">new_with_options</span><span class="operator">-></span><span class="word">run</span><span class="structure">;</span></code></pre>
<p>Now it's a simple matter of programming to write the <code>new_with_options</code> method...or is it? A naive implementation might look something like this:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">new_with_options</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 /><br /> <span class="keyword">my</span> <span class="symbol">$filename</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$verbose</span><span class="structure">;</span><br /><br /> <span class="word">GetOptions</span><span class="structure">(</span><br /> <span class="double">"filename=s"</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$filename</span><span class="operator">,</span><br /> <span class="double">"verbose"</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$verbose</span><span class="operator">,</span><br /> <span class="structure">)</span> <span class="operator">or</span> <span class="word">die</span><span class="structure">(</span><span class="double">"Error in command line argument"</span><span class="structure">);</span><br /><br /> <span class="keyword">return</span> <span class="symbol">$class</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">verbose</span> <span class="operator">=></span> <span class="symbol">$verbose</span><span class="operator">,</span><br /> <span class="word">filename</span> <span class="operator">=></span> <span class="symbol">$filename</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>That's great until you want to do something like subclassing MyModuleScript to add a new option. How do you do that without having to copy and paste the existing logic that's in <code>new_with_options</code>? So in actuality the whole logic is much harder to write, you need some sort of overridable method that gathers parameters to pass to <code>GetOptions</code>, then you need some logic to pass that to the existing constructor.</p>
<p>This all sounds like a lot of work to do to when writing a simple script. What we need is a module like MooX::Options to help us out.</p>
<h3 id="Introducing-MooX::Options">Introducing MooX::Options</h3>
<p>Let's take a step back for a minute and re-evaluate what we're actually trying to do. Chances are if we've got a Moo object then our <code>verbose</code> attribute looks something like this:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Types::Standard</span> <span class="word">-all</span><span class="structure">;</span><br /><br /><span class="word">has</span> <span class="word">verbose</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="word">Bool</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>What we really need is some way to have that attribute gather its own command line arguments. Let's let MooX::Options do that for us:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Types::Standard</span> <span class="word">-all</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MooX::Options</span><span class="structure">;</span><br /><br /><span class="word">option</span> <span class="word">verbose</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="word">Bool</span><span class="operator">,</span><br /> <span class="word">doc</span> <span class="operator">=></span> <span class="single">'Flag to enable verbose output'</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>We've replaced the <code>has</code> keyword with <code>option</code>. This is essentially identical to the normal attribute except when we construct our Moo class in our script via the <code>new_with_options</code> constructor (which is now provided for us by MooX::Options):</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">MyScriptModule</span><span class="structure">;</span><br /><span class="word">print</span> <span class="word">MyScriptModule</span><span class="operator">-></span><span class="word">new_with_options</span><span class="operator">-></span><span class="word">run</span><span class="structure">;</span></code></pre>
<p>We can now set that <i>option</i> attribute from the command line:</p>
<pre><code> bash$ myscript --verbose</code></pre>
<p>We can control the type of argument we accept with <code>format</code>.</p>
<pre><code class="code-listing"><span class="word">option</span> <span class="word">filename</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="word">Str</span><span class="operator">,</span><br /> <span class="word">format</span> <span class="operator">=></span> <span class="single">'s'</span><span class="operator">,</span><br /> <span class="word">doc</span> <span class="operator">=></span> <span class="single">'The input filename'</span><br /><span class="structure">);</span></code></pre>
<p>This is the same format string used by Getopt::Long. The <code>--filename</code> option now can have a string value set at the command line:</p>
<pre><code> bash$ myscript --verbose --filename=/path/to/my/file</code></pre>
<p>It may seem redundant to have to specify both a type of <code>Str</code> and a format of <code>s</code>, but it's worth thinking that the latter is just a way of telling the command line parser what to do and is unrelated to what the type of the variable actually is. Expecting Moo to work out the command line option type from a type (given subclassing, coercion and other complexity of Type::Tiny types) would just be too clever a feature and probably result in gotchas and unexpected behavior in certain situations. It's best to just be explicit.</p>
<p>Along with the command line options you specify MooX::Options also provides options for outputting documentation (which you've been providing via the <code>doc</code> parameter to <code>option</code>) for each command line option.</p>
<pre><code> bash$ myscript --help
USAGE: myscript [-h] [long options...]
--filename: String
The input filename
--verbose:
Flag to enable verbose output
--usage:
show a short help message
-h --help:
show a help message
--man:
show the manual</code></pre>
<p>Why it's important to have this documentation programmatically compiled like this rather than specified in any one module's pod will become clear shortly.</p>
<h3 id="The-Role-Advantage">The Role Advantage</h3>
<p>The reason I really love MooX::Options is not that it just makes mapping command line options to attributes easy, it's that it lets me do that no matter where the attributes are defined. One of the key places that these attributes are often defined are inside of roles.</p>
<p>To give you an idea of the power of this I present my <i>verbose</i> role that I consume in pretty much every script module:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">MyScriptClass::Role::Verbose</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moo::Role</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MooX::Options</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Types::Standard</span> <span class="word">-all</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">our</span> <span class="symbol">$VERSION</span> <span class="operator">=</span> <span class="number">1</span><span class="structure">;</span><br /><br /><span class="word">option</span> <span class="word">verbose</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="word">Bool</span><span class="operator">,</span><br /> <span class="word">doc</span> <span class="operator">=></span> <span class="single">'If we should be verbose or not (default false)'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">logging_fh</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="word">FileHandle</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="keyword">return</span> <span class="cast">\</span><span class="symbol">*STDERR</span> <span class="structure">}</span><br /><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">note</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">return</span> <span class="word">unless</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">verbose</span><span class="structure">;</span><br /> <span class="word">print</span> <span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">logging_fh</span> <span class="structure">}</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="keyword">return</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>This role gives my class a <code>verbose</code> attribute (which can be set from the command line), and a <code>note</code> method that logs out output if and only if verbose has been set.</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">MyScriptClass::SplineReticulator</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">with</span><span class="structure">(</span><span class="single">'MyScriptModule::Role::Verbose'</span><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">run</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">note</span><span class="structure">(</span><span class="double">"reticulating splines"</span><span class="structure">);</span><br /> <span class="operator">...</span><br /><span class="structure">}</span></code></pre>
<p>Everything about the <code>verbose</code> command line option acts exactly the same as if it had been declared in the consuming class itself - the command line parsing is identical, and it's even included in the auto-generated documentation the same.</p>
<h3 id="Making-Things-Testable">Making Things Testable</h3>
<p>One of the handy things about tightly binding the command line options to attributes in this way is that it makes testing a breeze.</p>
<p>Here's another one of my handy standard roles:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">MyScriptClass::Role::Filename</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moo::Role</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MooX::Options</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Types::Standard</span> <span class="word">-all</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">our</span> <span class="symbol">$VERSION</span> <span class="operator">=</span> <span class="number">1</span><span class="structure">;</span><br /> <br /><span class="word">option</span> <span class="word">filename</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="word">Str</span><span class="operator">,</span><br /> <span class="word">format</span> <span class="operator">=></span> <span class="single">'s'</span><span class="operator">,</span><br /> <span class="word">doc</span> <span class="operator">=></span> <span class="single">'The input filename'</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">fh</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="single">'lazy'</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">FileHandle</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">_build_fh</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">if</span> <span class="structure">(</span><span class="core">defined</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">filename</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">open</span> <span class="word">my</span> <span class="symbol">$fh</span><span class="operator">,</span> <span class="double">"<"</span><span class="operator">,</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">filename</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="symbol">$fh</span><span class="structure">;</span><br /> <span class="structure">}</span><br /> <span class="keyword">return</span> <span class="cast">\</span><span class="symbol">*STDIN</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>The point in this role is to provide a <code>fh</code> attribute which contains an open filehandle to read input from. MooX::Options allows the class to take a filename to process in the <code>--filename</code> option which will then be automatically opened in the lazy builder for <code>fh</code>.</p>
<p>Using this role is pretty straight forward - you just assume you've got a <code>fh</code> attribute now:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">MyScriptClass::ReverseLine</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">with</span><span class="structure">(</span><span class="single">'MyScriptModule::Role::Filename'</span><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">run</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">$fh</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">fh</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$output</span> <span class="operator">=</span> <span class="double">""</span><span class="structure">;</span><br /> <span class="keyword">while</span> <span class="structure">(</span><span class="readline"><$fh></span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">chomp</span><span class="structure">;</span><br /> <span class="symbol">$output</span> <span class="operator">.=</span> <span class="word">reverse</span><span class="structure">;</span><br /> <span class="symbol">$output</span> <span class="operator">.=</span> <span class="double">"\n"</span><span class="structure">;</span><br /> <span class="structure">}</span><br /> <span class="keyword">return</span> <span class="symbol">$output</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>Because we can set the <code>--filename</code> option from the constructor rather than from the actual command line we can test this with a test script easily:</p>
<pre><code class="code-listing"><span class="word">is</span> <span class="word">MyScriptClass::ReverseLine</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">filename</span> <span class="operator">=></span> <span class="double">"test.txt"</span><br /><span class="structure">)</span><span class="operator">-></span><span class="word">run</span><span class="operator">,</span> <span class="heredoc"><<'ENDOFEXAMPLEOUTPUT'</span><span class="structure">;</span><br /><span class="heredoc_content">elpmaxe hcae fo liated yreve ni detseretni taht er'uoy fi ,yeH <br />?radnelac s'raey txen rof elcitra na gnitirw gniredisnoc tuoba woh <br />.pleh nac uoy woh rof 52-21-4102 rof yrtne eht eeS<br /></span><span class="heredoc_terminator">ENDOFEXAMPLEOUTPUT<br /></span></code></pre>
<p>(Of course, the smart thing to do would be to bypass the need for an external file entirely)</p>
<pre><code class="code-listing"><span class="word">is</span> <span class="word">MyScriptClass::ReverseLine</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">fh</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">*DATA</span> <span class="structure">)</span><span class="operator">-></span><span class="word">run</span><span class="operator">,</span> <span class="heredoc"><<'ENDOFEXAMPLEOUTPUT'</span><span class="structure">;</span><br /><span class="heredoc_content">too many secrets<br /></span><span class="heredoc_terminator">ENDOFEXAMPLEOUTPUT<br /></span><span class="separator">__DATA__</span><br /><span class="data">sterces ynam oot</span></code></pre>
<h3 id="Conclusion">Conclusion</h3>
<p>Where Getopt::Long used to be my go-to module for command line parsing. The abilities of MooX::Options to distribute parsing options between the attributes specified in the roles that make up my class has now means that, sadly for one of my favorite modules of fourteen years, Getopt::Long has been supplanted by MooX::Options on all my new projects.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/MooX::Options">MooX::Options</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Getopt::Long">Getopt::Long</a></p>
</li>
</ul>
</div>2014-12-13T00:00:00ZMark FowlerIf if, use use ifhttp://perladvent.org/2014/2014-12-12.html<div class='pod'><p>There's a common newbie mistake that looks something like this:</p>
<pre><code class="code-listing"><span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$ENV</span><span class="structure">{</span><span class="word">ADVENT_DEBUG</span><span class="structure">})</span> <span class="structure">{</span><br /> <span class="keyword">use</span> <span class="word">Devel::ecember</span> <span class="version">12.25.14</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>(I call this a newbie mistake to remind myself that I am still, now, and forever a newbie. I still make this mistake when I'm not paying attention.)</p>
<p>The problem, here, is that <code>use</code> happens at compile time, but <code>if</code> only controls the flow of the program at <i>run</i> time. This means that our debugger is loaded regardless of the environment. Whoops!</p>
<p>The instinct on how to fix this is often to use a <code>BEGIN</code> block, but it's not a very good instinct. In Perl, "compile time" and "run time" are relative. Once you've got your <code>if</code> in a <code>BEGIN</code> block, your <code>use</code> is in there too, and now it's still going to run earlier than your conditional!</p>
<p>So, what's a programmer to do?</p>
<p>This is where <code>if</code> comes in.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">if</span> <span class="symbol">$ENV</span><span class="structure">{</span><span class="word">ADVENT_DEBUG</span><span class="structure">}</span><span class="operator">,</span> <span class="single">'Devel::ecember'</span><span class="structure">;</span></code></pre>
<p>This might look like some weird new form of Perl's postfix conditionals, but it's not weird at all. Or, at least, it's not weird syntax. It's a rarely-seen core library for solving this problem, and it works just like any other module: when you <code>use</code> it, its <code>import</code> method is called, and decides what to do next: either use the library you wanted, or not.</p>
<p>You may have noticed that we left something out of our code! We wanted to specify a version number for our debugger: v12.25.14. <code>if</code> doesn't let us do that, but <a href="https://metacpan.org/module/Exporter">Exporter</a> comes to our rescue, at least somewhat, here:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">if</span> <span class="symbol">$ENV</span><span class="structure">{</span><span class="word">ADVENT_DEBUG</span><span class="structure">}</span><span class="operator">,</span> <span class="single">'Devel::ecember'</span><span class="operator">,</span> <span class="single">'12.25.13'</span><span class="structure">;</span></code></pre>
<p>It's important to realize that <code>if</code> isn't doing the equivalent of including a version number in a <code>use</code> statement. What's actually happening is that the string <code>12.25.13</code> is being passed to Devel::ecember's <code>import</code> routine. A little-known feature in Exporter notices when the first argument to <code>import</code> is version-like, and converts it to a call to the <code>VERSION</code> method.</p>
<p>What happens if the library you're conditionally loading doesn't use Exporter? Who knows! Probably nothing very good.</p>
<p>There's another complication, too. You can't tell <code>if</code> to load the library without calling its <code>import</code> routine. This doesn't come up often, fortunately!</p>
<p>On the other hand, there's another important use case for <code>if</code>. You can use if when you want to <i>un</i>import stuff, too. The canonical, gross example of this is:</p>
<pre><code class="code-listing"><span class="keyword">no</span> <span class="pragma">if</span> <span class="magic">$]</span> <span class="operator">>=</span> <span class="float">5.020</span><span class="operator">,</span> <span class="word">warnings</span> <span class="operator">=></span> <span class="double">"experimental::signatures"</span><span class="structure">;</span></code></pre>
<p>Fortunately, that's been rendered obsolete by <a href="https://metacpan.org/module/experimental">experimental</a>! Instead, consider:</p>
<pre><code class="code-listing"><span class="comment"># It's Christmas! Live a little!<br /></span><span class="keyword">no</span> <span class="pragma">if</span> <span class="structure">(</span><span class="word">localtime</span><span class="structure">)[</span><span class="number">4</span><span class="structure">]</span> <span class="operator">==</span> <span class="number">12</span> <span class="operator">-</span> <span class="number">1</span> <span class="operator">&&</span> <span class="structure">(</span><span class="word">localtime</span><span class="structure">)[</span><span class="number">3</span><span class="structure">]</span> <span class="operator">==</span> <span class="number">25</span><span class="operator">,</span> <span class="single">'strict'</span><span class="structure">;</span></code></pre>
<ul>
<li><p><a href="https://metacpan.org/module/if">if</a></p>
</li>
</ul>
</div>2014-12-12T00:00:00ZRicardo SignesA Tiny But Powerful Type Systemhttp://perladvent.org/2014/2014-12-11.html<div class='pod'><p>Perl doesn't (yet) have a native type system built into it, but as is often the case, powerful solutions can be found on the CPAN. <a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a> is a small, lightweight type system for Perl that is compatible with <a href="https://metacpan.org/module/Moose">Moose</a>, <a href="https://metacpan.org/module/Moo">Moo</a> and <a href="https://metacpan.org/module/Mouse">Mouse</a>. It ships with a useful set of standard types, and the underpinnings you need to quickly define type libraries of your own.</p>
<h3 id="A-Moo-Constraints-Recap">A Moo Constraints Recap</h3>
<p>Let's write a very simple <a href="https://metacpan.org/module/Moo">Moo</a>-based object representing what we'll be leaving out for jolly old St Nick this Christmas.</p>
<p>Accessors in <a href="https://metacpan.org/module/Moo">Moo</a> can be defined with a simple <code>isa</code> keyword that accepts a subroutine reference that can validate whatever you're setting the attribute to:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">StuffForSanta</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moo</span><span class="structure">;</span><br /><br /><span class="word">has</span> <span class="word">mincepies</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="word">die</span> <span class="double">"invalid"</span> <span class="word">unless</span> <span class="magic">$_</span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span> <span class="operator">=~</span> <span class="match">/\A-?[0-9]+\z/</span> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>So now StuffForSanta won't let us cheat:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$plate</span> <span class="operator">=</span> <span class="word">StuffForSanta</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">mincepies</span> <span class="operator">=></span> <span class="double">"lots"</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>Results in:</p>
<pre><code> isa check for "mincepies" failed: invalid at StuffForSanta.pm line 7.</code></pre>
<p>There are numerous problems with this simple approach however:</p>
<ul>
<li>The code isn't exactly what I'd call easy to read. You have to actually
parse the regular expression in your head each time to understand what's going
on</li>
<li>The error message doesn't actually tell you what's going wrong. Good luck
making sense of that during the production outage at 3:32am on Christmas Eve!
</li>
<li>Embedded like it is the constraint is hard to to test in isolation
without having to instantiate the StuffForSanta object</li>
<li>The code isn't reusable beyond the dreaded copy and paste</li>
</ul>
<p>What we need instead is a library of constraints that we can reuse, that have tests, and have easiy to read names. In the Modern Perl world we call such reusable constraints <i>types</i>.</p>
<h3 id="Introducing-Types::Standard">Introducing Types::Standard</h3>
<p>Handily, <a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a> comes with <a href="https://metacpan.org/module/Types::Standard">Types::Standard</a>, a bunch of built-in types that can be directly used with <a href="https://metacpan.org/module/Moo">Moo</a>, no further coding required:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">StuffForSanta</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moo</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Types::Standard</span> <span class="words">qw(:all)</span><span class="structure">;</span><br /><br /><span class="comment"># how many mince pies are there?<br /></span><span class="word">has</span> <span class="word">mincepies</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">Int</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="number">0</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="comment"># how many carrots got left out?<br /></span><span class="word">has</span> <span class="word">carrots</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">Int</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="number">0</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="comment"># and a drink<br /></span><span class="word">has</span> <span class="word">drink</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">Enum</span><span class="structure">[</span><span class="double">"Milk"</span><span class="operator">,</span><span class="double">"Sherry"</span><span class="structure">]</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>You'll note that the type names themselves (<code>Int</code>, <code>Enum</code>, etc) are barewords, not quoted strings nor variables. Under the hood <a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a> is doing clever things with subroutine prototypes and overloaded variables to provide the clear syntax you see above, none of which you need worry about in your day to day usage of the type system.</p>
<p>Now if we attempt to define an invalid object</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$plate</span> <span class="operator">=</span> <span class="word">StuffForSanta</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">carrots</span> <span class="operator">=></span> <span class="number">10</span><span class="operator">,</span><br /> <span class="word">drink</span> <span class="operator">=></span> <span class="double">"Prune Juice"</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>Our type system complains bitterly in a much more readable fashion when things go wrong:</p>
<pre><code> Value "Prune Juice" did not pass type constraint "Enum["Milk","Sherry"]" (in $args->{"drink"}) at plate.pl line 8
"Enum["Milk","Sherry"]" requires that the value is equal to "Milk" or "Sherry"</code></pre>
<h3 id="Writing-your-Own-Types">Writing your Own Types</h3>
<p>Writing your own type is very simple to do. You can use <a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a>'s constructor, or simpler yet, use the syntactic sugar for declaring types from <a href="https://metacpan.org/module/Type::Utils">Type::Utils</a>:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Type::Utils</span> <span class="word">-all</span><span class="structure">;</span><br /><br /><span class="word">declare</span> <span class="double">"USTelephone"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="structure">{</span> <span class="match">/^(?:[+]?1-)?\d{3}-?\d{3}-?\d{4}$/a</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">message</span> <span class="structure">{</span> <span class="double">"$_ doesn't look like a US telephone number to me"</span> <span class="structure">};</span></code></pre>
<p>Since declaring a type also defines the handy <code>is_Whatever</code> function call we can easily test the type:</p>
<pre><code class="code-listing"><span class="word">ok</span> <span class="word">is_USTelephone</span><span class="structure">(</span><span class="double">"+1-202-456-1111"</span><span class="structure">)</span><span class="operator">,</span> <span class="double">"Whitehouse telephone number valid"</span><span class="structure">;</span><br /><span class="word">ok</span> <span class="word">is_USTelephone</span><span class="structure">(</span><span class="double">"+7-495-695-37-76"</span><span class="structure">)</span><span class="operator">,</span> <span class="double">"Kremlin telephone number not valid"</span><span class="structure">;</span></code></pre>
<p>Rather than declaring your types in the class that you're going to be using them, you should put them in their own package that subclasses <a href="https://metacpan.org/module/Type::Libary">Type::Libary</a>:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Type::USTelephone</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">base</span> <span class="words">qw(Type::Library)</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="float">5.014</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">Type::Utils</span> <span class="word">-all</span><span class="structure">;</span><br /><br /><span class="word">declare</span> <span class="double">"USTelephone"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="structure">{</span> <span class="match">/^(?:1-)?\d{3}-?\d{3}-?\d{4}$/a</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">message</span> <span class="structure">{</span> <span class="double">"$_ doesn't look like a US telephone number to me"</span> <span class="structure">};</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>Then that type can be used in your object class:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">AlbanyPMMember</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moo</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Types::Standard</span> <span class="words">qw(:all)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Types::USTelephone</span> <span class="words">qw(:all)</span><span class="structure">;</span><br /><br /><span class="word">has</span> <span class="word">name</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"ro"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">Str</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">cell</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"ro"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">USTelephone</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="operator">...</span></code></pre>
<h3 id="Coercion">Coercion</h3>
<p>Automatic coercion allows Perl to automatically convert one type from another type in situations where this might be beneficial.</p>
<p>For example, let's add a <code>plate_color</code> attribute to our StuffForSanta Moo class:</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">plate_color</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">InstanceOf</span><span class="structure">[</span><span class="double">"Graphics::Color::RGB"</span><span class="structure">]</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>This is a standard type constraint from <a href="https://metacpan.org/module/Types::Standard">Types::Standard</a> that insists that this attribute only accepts an argument that is the specified type (i.e. only something that <code>->isa("Graphics::Color::RGB")</code>.)</p>
<p>However, while this works:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$plate</span> <span class="operator">=</span> <span class="word">StuffForSanta</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">plate_color</span> <span class="operator">=></span> <span class="word">Graphics::Color::RGB</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">red</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">green</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">blue</span> <span class="operator">=></span> <span class="float">0.9</span><span class="operator">,</span><br /> <span class="structure">)</span><br /> <span class="operator">...</span><br /><span class="structure">);</span></code></pre>
<p>It'd be nice if this worked too:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$plate</span> <span class="operator">=</span> <span class="word">StuffForSanta</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">plate_color</span> <span class="operator">=></span> <span class="double">"#ffffdd"</span><span class="operator">,</span><br /> <span class="operator">...</span><br /><span class="structure">);</span></code></pre>
<p>We'd like StuffForSanta to automatically create the <code>Graphics::Color::RGB</code> object for us from the string as needed.</p>
<p>First, in our type library let's create a more readable version of the <code>InstanceOf["Graphics::Color::RGB"]</code> type by creating a named type:</p>
<pre><code class="code-listing"><span class="word">class_type</span> <span class="word">Color</span><span class="operator">,</span> <span class="structure">{</span> <span class="word">class</span> <span class="operator">=></span> <span class="double">"Graphics::Color::RGB"</span> <span class="structure">};</span></code></pre>
<p>Now we can write:</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">plate_color</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">Color</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>Now let's create a named coercion:</p>
<pre><code class="code-listing"><span class="word">declare_coercion</span> <span class="double">"ColorFromStr"</span><span class="operator">,</span><br /> <span class="word">to_type</span> <span class="word">Color</span><span class="operator">,</span><br /> <span class="word">from</span> <span class="word">Str</span><span class="operator">,</span> <span class="word">via</span> <span class="structure">{</span><br /><span class="comment"> # unless this looks like #ffffff or #fff return the original<br /> # string to indicate no coercion is possible<br /></span> <span class="keyword">return</span> <span class="magic">$_</span> <span class="word">unless</span> <span class="match">/\A # (?: [0-9a-f]{3} | [0-9a-f]{6} ) \z/ix</span><span class="structure">;</span><br /><br /><span class="comment"> # turn it into a G::C::RGB object<br /></span> <span class="keyword">return</span> <span class="word">Graphics::Color::RGB</span><span class="operator">-></span><span class="word">from_hex_string</span><span class="structure">(</span> <span class="magic">$_</span> <span class="structure">);</span><br /> <span class="structure">};</span></code></pre>
<p>And add it to our <a href="https://metacpan.org/module/Moo">Moo</a> class attribute:</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">plate_color</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">Color</span><span class="operator">,</span><br /> <span class="word">coerce</span> <span class="operator">=></span> <span class="word">ColorFromStr</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>Now we can write:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$plate</span> <span class="operator">=</span> <span class="word">StuffForSanta</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">plate_color</span> <span class="operator">=></span> <span class="double">"#ffffdd"</span><span class="operator">,</span><br /> <span class="operator">...</span><br /><span class="structure">);</span><br /><br /><span class="word">say</span> <span class="symbol">$plate</span><span class="operator">-></span><span class="word">plate_color</span><span class="operator">-></span><span class="word">red</span><span class="structure">;</span><br /><span class="word">say</span> <span class="symbol">$plate</span><span class="operator">-></span><span class="word">plate_color</span><span class="operator">-></span><span class="word">green</span><span class="structure">;</span><br /><span class="word">say</span> <span class="symbol">$plate</span><span class="operator">-></span><span class="word">plate_color</span><span class="operator">-></span><span class="word">blue</span><span class="structure">;</span></code></pre>
<p>One important thing to note that this coercion only has effect in this one accessor where we've set <code>coercion</code> - we don't have to worry about accidentally triggering a coercion in other accessors and having spooky action at a distance.</p>
<h3 id="Per-Accessor-Moose-Coercion">Per Accessor Moose Coercion</h3>
<p>Up until this point our <a href="https://metacpan.org/module/Moo">Moo</a> and <a href="https://metacpan.org/module/Moose">Moose</a> code looks essentially identical, but the way <a href="https://metacpan.org/module/Moose">Moose</a> handles coercions is different to Moo: It has global coercions that apply any time a type is used in any accessor that has coercions enabled. This can lead to unpredictable action at a distance if we're not careful.</p>
<p><a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a> has a solution to this issue; Essentially it has a syntax for creating a one-off variant of a standard class with additional coercion ability.</p>
<p>A similar <a href="https://metacpan.org/module/Moose">Moose</a> accessor would look like this:</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">plate_color</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="double">"rw"</span><span class="operator">,</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="word">Color</span><span class="operator">-></span><span class="word">plus_coercions</span><span class="structure">(</span><span class="word">ColorFromStr</span><span class="structure">)</span><span class="operator">,</span><br /> <span class="word">coerce</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>The <code>Color->plus_coercions(ColorFromStr)</code> call actually returns a new one-off type that is a <code>Color</code> class with the additional <code>ColorFromStr</code> coercion.</p>
<h3 id="Speed-Optimizations">Speed Optimizations</h3>
<p>Because type systems often end up in <i>hot</i> areas of code, every little speed improvement can help. Up until now we've been declaring our code as simple subroutines, but we can optimize this further by giving our type system a string containing a snippet of code allowing the type system to directly compile this into the accessor routine.</p>
<p>To demonstrate how much quicker this can be, let's do a quick benchmark. First let's declare a simple type class:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">MyTyps</span><span class="structure">;</span><br /> <span class="keyword">use</span> <span class="pragma">base</span> <span class="words">qw(Type::Library)</span><span class="structure">;</span><br /><br /> <span class="keyword">use</span> <span class="float">5.014</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">Type::Utils</span> <span class="word">-all</span><span class="structure">;</span><br /><br /> <span class="word">declare</span> <span class="double">"ThreeChars"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="structure">{</span> <span class="core">defined</span> <span class="operator">&&</span> <span class="operator">!</span><span class="word">ref</span> <span class="operator">&&</span> <span class="word">length</span> <span class="operator">==</span> <span class="number">3</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">message</span> <span class="structure">{</span> <span class="double">"Not a three character string"</span> <span class="structure">};</span></code></pre>
<p>Now, let's create a simple object that uses it</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Simple</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moo</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MyTypes</span> <span class="word">-all</span><span class="structure">;</span><br /><br /><span class="word">has</span> <span class="word">three_chars</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="word">ThreeChars</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>And time how long it takes to instantiate a million of these:</p>
<pre><code> timethis 1000000: 10 wallclock secs (10.54 usr + 0.01 sys = 10.55 CPU) @ 94786.73/s (n=1000000)</code></pre>
<p>Now if we modify our constraint to have an <code>inline_as</code> subroutine that can generate a bunch of Perl code as needed:</p>
<pre><code class="code-listing"><span class="word">declare</span> <span class="double">"ThreeChars"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="structure">{</span> <span class="core">defined</span> <span class="operator">&&</span> <span class="operator">!</span><span class="word">ref</span> <span class="operator">&&</span> <span class="word">length</span> <span class="operator">==</span> <span class="number">3</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">inline_as</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$constraint</span><span class="operator">,</span> <span class="symbol">$var</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="double">"defined $var && !ref $var && length $var == 3"</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">message</span> <span class="structure">{</span> <span class="double">"Not a three character string"</span> <span class="structure">};</span></code></pre>
<p>This is signifcantly quicker:</p>
<pre><code> timethis 1000000: 9 wallclock secs ( 8.83 usr + 0.01 sys = 8.84 CPU) @ 113122.17/s (n=1000000)</code></pre>
<br><center><img src="benchmark.png" width="391" height="323"></center>
<h3 id="Conclusion">Conclusion</h3>
<p><a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a> offers a deceptively simple approach to creating types with Perl. Despite its <code>::Tiny</code> name, it is a powerful system that allows you to do complex validation. And unlike <a href="https://metacpan.org/module/Moose">Moose</a>-based type systems, <a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a>'s entire dependency chain involves only one Perl module (which is 100% Pure Perl) and does not require a compiler to build making it an excellent choice for code that needs to be easy to distribute.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Type::Tiny">Type::Tiny</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Type::Tiny::Manual">Type::Tiny::Manual</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Types::Standard">Types::Standard</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Type::Utils">Type::Utils</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Type::Library">Type::Library</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Moo">Moo</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Moose">Moose</a></p>
</li>
<li><p><a href="https://metacpan.org/module/MooseX::Types">MooseX::Types</a></p>
</li>
</ul>
</div>2014-12-11T00:00:00ZMark FowlerForeign Function Interface and Perlhttp://perladvent.org/2014/2014-12-10.html<div class='pod'><p><code>libffi</code> is a Foreign Function Interface (FFI) used by a number of scripting languages and virtual machine platforms to call native code. It doesn't require a compiler, and as long as dynamic libraries can be found, development packages aren't necessary either.</p>
<p>For Perl, this means that FFI::Raw (Perl bindings for <code>libffi</code>) provides a viable alternative to the traditional Foreign Function Interface, known as XS. There are lots of reasons why you might not want to implement something using XS. For me the motivation is not having to delve into perlapi or perlxs, both of which are a fine prescription for madness. There are even some good reasons why you might <i>want</i> to use <code>libffi</code> instead of XS; it should work with any language that generates machine code, so go ahead and write your extensions in assembly or rust!</p>
<h3 id="Calling-a-function">Calling a function</h3>
<p>FFI::Raw has a constructor that takes the name of the library, the name of the function that you want to bind to, the return type for that function, and a list of the argument types. For example, I can call the C <code>puts</code> function on my Linux system like this:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">FFI::Raw</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$lib</span> <span class="operator">=</span> <span class="single">'/lib/x86_64-linux-gnu/libc.so.6'</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$puts</span> <span class="operator">=</span> <span class="word">FFI::Raw</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="symbol">$lib</span><span class="operator">,</span> <span class="single">'puts'</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::int</span><span class="operator">,</span> <span class="comment"># return value type</span><br /> <span class="word">FFI::Raw::str</span><span class="operator">,</span> <span class="comment"># argument types</span><br /><span class="structure">);</span><br /><br /><span class="symbol">$puts</span><span class="operator">-></span><span class="word">call</span><span class="structure">(</span><span class="double">"hello world"</span><span class="structure">);</span></code></pre>
<p>I usually put the return value type and argument types on separate lines, as above, to differentiate them.</p>
<p>Recent versions of FFI::Raw have a shortcut where if you pass <code>undef</code> as the library argument it will search the currently running process for symbols. This is a good way to call functions in the standard C library, which usually has a different name on every platform.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$puts</span> <span class="operator">=</span> <span class="word">FFI::Raw</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="core">undef</span><span class="operator">,</span> <span class="single">'puts'</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::int</span><span class="operator">,</span> <span class="comment"># return value type</span><br /> <span class="word">FFI::Raw::str</span><span class="operator">,</span> <span class="comment"># argument types</span><br /><span class="structure">);</span></code></pre>
<h3 id="Finding-a-library">Finding a library</h3>
<p>For the rest of this article I am going to use <code>libmagic</code> as an example of how to create useful bindings. This library is commonly available on Unix systems and it provides an interface for determining the type of a file by its contents.</p>
<p>The first thing that we need to do is find the path to the libmagic library. To do that we will use FFI::CheckLib.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">FFI::CheckLib</span><span class="structure">;</span><br /><span class="keyword">my</span><span class="structure">(</span><span class="symbol">$lib</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">find_lib</span><span class="structure">(</span> <span class="word">lib</span> <span class="operator">=></span> <span class="single">'magic'</span> <span class="structure">);</span></code></pre>
<h3 id="The-bindings">The bindings</h3>
<p>Now we need to create the bindings for the <code>libmagic</code> library like we did for <code>puts</code> before.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$open</span> <span class="operator">=</span> <span class="word">FFI::Raw</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="symbol">$lib</span><span class="operator">,</span> <span class="single">'magic_open'</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::ptr</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::int</span><span class="operator">,</span><br /><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$load</span> <span class="operator">=</span> <span class="word">FFI::Raw</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="symbol">$lib</span><span class="operator">,</span> <span class="single">'magic_load'</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::int</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::ptr</span><span class="operator">,</span> <span class="word">FFI::Raw::str</span><span class="operator">,</span><br /><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$buffer</span> <span class="operator">=</span> <span class="word">FFI::Raw</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="symbol">$lib</span><span class="operator">,</span> <span class="single">'magic_buffer'</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::str</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::ptr</span><span class="operator">,</span> <span class="word">FFI::Raw::ptr</span><span class="operator">,</span> <span class="word">FFI::Raw::int</span><span class="operator">,</span><br /><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$close</span> <span class="operator">=</span> <span class="word">FFI::Raw</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="symbol">$lib</span><span class="operator">,</span> <span class="single">'magic_close'</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::void</span><span class="operator">,</span><br /> <span class="word">FFI::Raw::ptr</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>We also need some constants that are defined in <code>magic.h</code>:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">MAGIC_NONE</span> <span class="operator">=></span> <span class="hex">0x000</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">MAGIC_MIME</span> <span class="operator">=></span> <span class="hex">0x410</span><span class="structure">;</span></code></pre>
<p>Unfortunately there is no getting around this. Since we are not using a compiler, there is no reliable way of parsing the C header files, except for by implementing a C parser. Also requiring the C header files may mean installing development packages (if you recall one of the advantages of <code>libffi</code> is that we don't need those installed).</p>
<p>If the library that you are targeting changes its constants frequently then FFI::Raw may not be the tool that you want to use. On the other hand, if your library is frequently changing its interface like that then that library may not be the tool that you want to use either.</p>
<h3 id="Using-the-bindings">Using the bindings</h3>
<p>Now we can write a useful program using the bindings that we have created.</p>
<pre><code class="code-listing"><span class="comment"># Create a handle for interacting with libmagic<br /># replace MAGIC_NONE with MAGIC_MIME to get the<br /># mime type instead of a description<br /></span><span class="keyword">my</span> <span class="symbol">$magic</span> <span class="operator">=</span> <span class="symbol">$open</span><span class="operator">-></span><span class="word">call</span><span class="structure">(</span><span class="word">MAGIC_NONE</span><span class="structure">);</span><br /><br /><span class="comment"># Load the magic definitions file. undef gets<br /># translated into NULL, which means use the <br /># system default.<br /></span><span class="symbol">$load</span><span class="operator">-></span><span class="word">call</span><span class="structure">(</span><span class="symbol">$magic</span><span class="operator">,</span> <span class="core">undef</span><span class="structure">);</span><br /><br /><span class="comment"># read in the content of a file and convert it<br /># into a pointer<br /></span><span class="word">open</span> <span class="word">my</span> <span class="symbol">$fh</span><span class="operator">,</span> <span class="single">'<'</span><span class="operator">,</span> <span class="double">"unknownfiletype"</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$content</span> <span class="operator">=</span> <span class="word">do</span> <span class="structure">{</span> <span class="keyword">local</span> <span class="magic">$/</span><span class="structure">;</span> <span class="readline"><$fh></span> <span class="structure">};</span><br /><span class="word">close</span> <span class="symbol">$fh</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$ptr</span> <span class="operator">=</span> <span class="word">FFI::Raw::MemPtr</span><span class="operator">-></span><span class="word">new_from_buff</span><span class="structure">(</span><br /> <span class="symbol">$content</span><span class="operator">,</span> <span class="word">length</span> <span class="symbol">$content</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="comment"># pass the buffer into libmagic and print the results!<br /></span><span class="word">say</span> <span class="symbol">$buffer</span><span class="operator">-></span><span class="word">call</span><span class="structure">(</span><span class="symbol">$magic</span><span class="operator">,</span> <span class="symbol">$ptr</span><span class="operator">,</span> <span class="word">length</span> <span class="symbol">$content</span><span class="structure">);</span><br /><br /><span class="comment"># free up the resources used by the magic handle<br /></span><span class="symbol">$close</span><span class="operator">-></span><span class="word">call</span><span class="structure">(</span><span class="symbol">$magic</span><span class="structure">);</span></code></pre>
<p>In this example we use FFI::Raw::MemPtr to construct a memory pointer and copy the content of the file into that pointer. If you know that the library that you are using is not going to do any funny busines, like write into your buffer, then you can also skip the memory copy by using <a href="https://metacpan.org/module/FFI::Util">FFI::Util</a>'s <code>scalar_to_buffer</code> function:</p>
<pre><code class="code-listing"><span class="keyword">my</span><span class="structure">(</span><span class="symbol">$ptr</span><span class="operator">,</span> <span class="symbol">$size</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">scalar_to_buffer</span><span class="structure">(</span><span class="symbol">$content</span><span class="structure">);</span><br /><span class="word">say</span> <span class="symbol">$buffer</span><span class="operator">-></span><span class="word">call</span><span class="structure">(</span><span class="symbol">$magic</span><span class="operator">,</span> <span class="symbol">$ptr</span><span class="operator">,</span> <span class="symbol">$size</span><span class="structure">);</span></code></pre>
<p>It returns a pointer to the data stored by the scalar and the size of the data stored.</p>
<h3 id="Speed">Speed</h3>
<p>FFI::Raw provides a less complicated, more portable method for calling machine code from Perl. Any FFI (calling one language from an other) will inherently involve extra overhead, when you cross the language barrier. Because FFI::Raw is implemented itself in XS, you are taking a hit from both XS and <code>libffi</code> every time you call a function in your target library. Both XS and <code>libffi</code> are relatively fast, but XS will frequently be somewhat faster assuming you tune your XS correctly. The question that you should ask yourself: is the time spent debugging code, tuning XS and reading <a href="https://metacpan.org/module/perlapi">perlapi</a> really worth it? If more time is being spent in the library you are calling than in crossing the language barrier, then you should definitely consider FFI::Raw and save yourself some programmer time at the expense of a comparably small amout of CPU time.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/FFI::Raw">FFI::Raw</a></p>
</li>
<li><p><a href="https://metacpan.org/module/FFI::Raw::MemPtr">FFI::Raw::MemPtr</a></p>
</li>
<li><p><a href="https://metacpan.org/module/FFI::Util">FFI::Util</a></p>
</li>
<li><p><a href="https://metacpan.org/module/FFI::CheckLib">FFI::CheckLib</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Archive::Libarchive::FFI">Archive::Libarchive::FFI</a></p>
</li>
<li><p><a href="https://github.com/merrilymeredith/p5-FFI-Sweet">FFI::Sweet</a></p>
</li>
</ul>
</div>2014-12-10T00:00:00ZGraham OllisAsync PostgreSQL with Mojo::Pghttp://perladvent.org/2014/2014-12-09.html<div class='pod'><p>Over the years, I have worked with many variants of the ORM concept in various libraries and languages. However in the end, I find they often get in the way of writing clear and simple SQL powered web applications more than they are helping. After all, SQL is designed to extract sets of data across tables, not to just be mapped to objects representing rows.</p>
<p>However DBI, the standard Perl database library for executing staight SQL, is rather old and archaic. It is not a very inviting interface to use directly. I have experimented with various wrappers, but never really found one I liked...until now.</p>
<p>This fall, the Mojolicious project launched a new sub-project for accessing PostgreSQL databases: Mojo::Pg. It has powerful features like migrations and Async, but first lets look at the simple case:</p>
<h3 id="Simple-SQL-Simply">Simple SQL Simply</h3>
<p>With Mojo::Pg database connections are handled with URLs:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$pg</span> <span class="operator">=</span> <span class="word">Mojo::Pg</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="single">'postgresql://partridge'</span><span class="structure">)</span></code></pre>
<p>This simple format still fully supports the configuration of the underlying DBD::Pg driver:</p>
<pre><code class="code-listing"><span class="comment"># connect as user 'two' with password 'turtle' to the 'partridge'<br /># database running on port 5432 on the 'dove' server<br /></span><span class="keyword">my</span> <span class="symbol">$pg2</span> <span class="operator">=</span> <span class="word">Mojo::Pg</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="single">'postgresql://two:turtle@doves:5432/partridge?RaiseError=0&PrintError=1'</span><span class="structure">);</span></code></pre>
<p>The URL format has the advantage of being simple to define in an <code>%ENV</code> variable for PaaS deployment. In fact it is already supported by Heroku addons.</p>
<p>Mojo::Pg also provides a succinct wrapper around the Statement object for getting data out. You can use the DBI iterator, or you can wrap the entire result into a Mojo::Collection object.</p>
<pre><code class="code-listing"><span class="comment"># Get the db<br /></span><span class="keyword">my</span> <span class="symbol">$db</span> <span class="operator">=</span> <span class="symbol">$pg</span><span class="operator">-></span><span class="word">db</span><span class="structure">;</span><br /><br /><span class="comment"># Using results as an iterator<br /></span><span class="keyword">my</span> <span class="symbol">$res</span> <span class="operator">=</span> <span class="symbol">$db</span><span class="operator">-></span><span class="word">query</span><span class="structure">(</span><span class="single">'SELECT day, gift FROM twelvedays ORDER BY day'</span><span class="structure">);</span><br /><span class="keyword">while</span> <span class="structure">(</span><span class="keyword">my</span> <span class="symbol">$row</span> <span class="operator">=</span> <span class="symbol">$res</span><span class="operator">-></span><span class="word">hash</span><span class="structure">)</span> <span class="structure">{</span> <span class="word">say</span> <span class="double">"$row->{day}: $row->{gift}"</span> <span class="structure">}</span><br /><br /><span class="comment"># Using a collection as an array of hashes<br /></span><span class="keyword">my</span> <span class="symbol">$res</span> <span class="operator">=</span> <span class="symbol">$db</span><span class="operator">-></span><span class="word">query</span><span class="structure">(</span><span class="single">'SELECT day, gift FROM twelvedays ORDER BY day'</span><span class="structure">);</span><br /><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$row</span> <span class="structure">(</span><span class="symbol">$res</span><span class="operator">-></span><span class="word">hashes</span><span class="structure">)</span> <span class="structure">{</span> <span class="word">say</span> <span class="double">"$row->{day}: $row->{gift}"</span> <span class="structure">}</span><br /><br /><span class="comment"># Using a collection as an object<br /></span><span class="keyword">my</span> <span class="symbol">$res</span> <span class="operator">=</span> <span class="symbol">$db</span><span class="operator">-></span><span class="word">query</span><span class="structure">(</span><span class="single">'SELECT day, gift FROM twelvedays ORDER BY day'</span><span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$hashes</span> <span class="operator">=</span> <span class="symbol">$res</span><span class="operator">-></span><span class="word">hashes</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"First gift was: "</span> <span class="operator">.</span> <span class="symbol">$hashes</span><span class="operator">-></span><span class="word">first</span><span class="operator">-></span><span class="structure">{</span><span class="word">gift</span><span class="structure">};</span><br /><span class="word">say</span> <span class="double">"Last gift was: "</span> <span class="operator">.</span> <span class="symbol">$hashes</span><span class="operator">-></span><span class="word">last</span><span class="operator">-></span><span class="structure">{</span><span class="word">gift</span><span class="structure">};</span></code></pre>
<p>The ability for Mojo::Pg::Result to return the data structure in collections of whatever you want - hashes, arrays, etc - and Mojo::Collection to allow you to access the data either using standard Perl array operations or via expressive method calls makes writing what would otherwise very tricky with plain old DBI simple with Mojo::Pg.</p>
<h3 id="Transactions">Transactions</h3>
<p>Mojo::Pg also provides a simple scope guard for transactions, so that if your guard variable goes out of scope before commit is called on it the transaction will automatically be rolled back.</p>
<pre><code class="code-listing"><span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$tx</span> <span class="operator">=</span> <span class="symbol">$db</span><span class="operator">-></span><span class="word">begin</span><span class="structure">;</span><br /> <span class="symbol">$db</span><span class="operator">-></span><span class="word">do</span><span class="structure">(</span><span class="single">'UPDATE birds SET bird_count = bird_count + 4'</span><span class="structure">);</span><br /><br /><span class="comment"> # return if invoidce_true_love_for_calling_birds returned false, which<br /> # means the transaction will automatically be rolled back<br /></span> <span class="word">invoice_true_love_for_calling_birds</span><span class="structure">()</span> <span class="operator">or</span> <span class="keyword">return</span><span class="structure">;</span><br /><br /> <span class="symbol">$tx</span><span class="operator">-></span><span class="word">commit</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>This also comes in very handy in async transactions, as you can very easily handle failure by rolling back.</p>
<h3 id="Migrations">Migrations</h3>
<p>Keeping databases in sync is always a problem when developing databases. Mojo::Pg has a very straightforward solution. You define migrations in pure SQL, either in the DATA section of your file for simple apps, or a separate file, with each level of migrations separated by an SQL comment. Here is a simple illustration:</p>
<pre><code class="code-listing"><span class="synComment">-- 1 up</span><br /><span class="synStatement">create</span> <span class="synSpecial">table</span> rings (<span class="synSpecial">type</span> <span class="synType">varchar</span>(<span class="synConstant">255</span>));<br /><span class="synStatement">insert</span> <span class="synSpecial">into</span> rings <span class="synSpecial">values</span> (â~@~XGoldâ~@~Y);<br /><span class="synComment">-- 1 down</span><br /><span class="synStatement">drop</span> <span class="synSpecial">table</span> rings;</code></pre>
<p>This retains all the benefits of systems like DBIx::DeploymentHandler and Rails migrations without any of the complexity.</p>
<p>Bringing your database up to the latest schema version is a single straight forward command:</p>
<pre><code class="code-listing"><span class="symbol">$db</span><span class="operator">-></span><span class="word">migrations</span><span class="operator">-></span><span class="word">from_file</span><span class="structure">(</span><span class="single">'migrations.sql'</span><span class="structure">)</span><span class="operator">-></span><span class="word">migrate</span><span class="structure">;</span></code></pre>
<p>This will cause Mojo::Pg to examine the <code>mojo_migrations</code> table (creating it if needed) to work out what version the target database is currently running and then to execute all the statements needed to bring it up to the latest version</p>
<h3 id="ASync">ASync</h3>
<p>Finally, Mojo::Pg allows you to perform async/long poll operations against a PostgreSQL database meaning that your code can do other things while waiting for the database to return instead of blocking.</p>
<p>This works just as you would expect, by passing a callback as the last argument to query. Typically we combine this with Mojo::Delay, to allow better callback control:</p>
<pre><code class="code-listing">Mojo::IOLoop->delay(<br /> <span class="synStatement">sub </span>{<br /> <span class="synStatement">my</span> <span class="synIdentifier">$delay</span> = <span class="synStatement">shift</span>;<br /> <span class="synIdentifier">$db</span>->query(<span class="synConstant">'select laying from goose'</span> => <span class="synIdentifier">$delay</span>->begin);<br /> },<br /> <span class="synStatement">sub </span>{<br /> <span class="synStatement">my</span> (<span class="synIdentifier">$delay</span>, <span class="synIdentifier">$err</span>, <span class="synIdentifier">$results</span>) = <span class="synIdentifier">@_</span>;<br /> <span class="synIdentifier">$results</span>->arrays<br /> -><span class="synStatement">map</span>(<span class="synStatement">sub </span>{ [ <span class="synIdentifier">$aâ</span>~@~T>{<span class="synConstant">0</span>} + <span class="synIdentifier">$b->[</span><span class="synConstant">0</span><span class="synIdentifier">]</span> ] })-><span class="synStatement">say</span>;<br /> }<br />)-><span class="synStatement">wait</span>;</code></pre>
<p>The async support uses Mojo::IOLoop under the hood, but Mojo::IOLoop can also interact with AnyEvent through the EV compatibility layer.</p>
<p>Mojo::Pg also supports async waiting for notifications. This is a common pattern for web sockets.</p>
<pre><code class="code-listing"><span class="symbol">$db</span><span class="operator">-></span><span class="word">on</span><span class="structure">(</span><span class="word">notification</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">$db</span><span class="operator">,</span> <span class="symbol">$bird</span><span class="operator">,</span> <span class="symbol">$pid</span><span class="operator">,</span> <span class="symbol">$arg</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="symbol">$response</span><span class="operator">-></span><span class="word">write</span><span class="structure">(</span><span class="double">"<div class='swan-update' data-id='$arg'/>’)<br /> if $bird eq ‘swans’;<br />});<br />$db->listen(‘swans’);<br />Mojo::IOLoop->start unless Mojo::IOLoop->is_running;</span></code></pre>
<p>The notification can either be triggered manually from another process also connected to the PostgreSQL database:</p>
<pre><code class="code-listing"><span class="symbol">$db</span><span class="operator">-></span><span class="word">notify</span><span class="structure">(</span><span class="single">'swans'</span><span class="operator">,</span><span class="single">'11'</span><span class="structure">);</span></code></pre>
<p>Or the notification could be fired by a database trigger (meaning, for example, that Perl code can get an async notification whenever a table is updated.)</p>
<pre><code class="code-listing"><span class="synStatement">CREATE</span> <span class="synStatement">OR</span> <span class="synIdentifier">REPLACE</span> <span class="synSpecial">FUNCTION</span> swans_notify() RETURNS <span class="synSpecial">trigger</span> <span class="synSpecial">AS</span> $$<br /><span class="synSpecial">BEGIN</span><br /> PERFORM pg_notify(<span class="synSpecial">'</span><span class="synConstant">swans</span><span class="synSpecial">'</span>,<span class="synIdentifier">to_char</span>(NEW.id,<span class="synSpecial">'</span><span class="synConstant">9999999999</span><span class="synSpecial">'</span>));<br /> <span class="synSpecial">RETURN</span> <span class="synSpecial">NULL</span>;<br /><span class="synSpecial">END</span><br />$$ LANGUAGE plpgsql;<br /><br /><span class="synStatement">CREATE</span> <span class="synSpecial">TRIGGER</span> notify_about_swan_changes_trigger<br /> AFTER <span class="synStatement">INSERT</span><br /> <span class="synStatement">OR</span> <span class="synStatement">UPDATE</span><br /> <span class="synSpecial">ON</span> swans<br /><span class="synSpecial">FOR</span> EACH <span class="synSpecial">ROW</span> <span class="synStatement">EXECUTE</span> <span class="synSpecial">PROCEDURE</span> swans_notify();</code></pre>
<p>I hope this has got you excited about the possibilities of Mojo::Pg. It's still early days for this library, but it has already got a rather unique feature set.</p>
<p>If you want to learn more about the Mojolicious stack, stay tuned for an exciting announcement coming soon from the Mojolicious team.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Mojo::Pg">Mojo::Pg</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Mojo::Pg::Database">Mojo::Pg::Database</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Mojo::Pg::Results">Mojo::Pg::Results</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Mojo::Pg::Migrations">Mojo::Pg::Migrations</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Mojo::Collection">Mojo::Collection</a></p>
</li>
</ul>
</div>2014-12-09T00:00:00ZMarcus RambergThe Complexity of Perlhttp://perladvent.org/2014/2014-12-08.html<div class='pod'><h2 id="The-Complexity-of-Perl">The Complexity of Perl</h2>
<p>When you're writing code, one of your goals should be to make your code as simple as possible. It seems self-evident that simple code will be easier to understand and easier to maintain and will therefore contain fewer bugs than complex code.</p>
<p>Of course, we want to write software that does complex things. And this apparent paradox is easy enough to resolve. We just need to create a lot of very simple software and join it together in complex ways.</p>
<p>But what constitutes "complex code"? Can we measure the complexity of an arbitrary piece of code? And what level of complexity should we be aiming at?</p>
<p>Luckily for us, this is a solved problem. Back in 1976 Thomas J. McCabe came up with the idea of "cyclometric complexity". McCabe's idea was to measure the complexity of a piece of code by counting the number of possible execution paths that can be traced through the code.</p>
<p>Let's look at this with an example. Here's some arbitrary Perl code:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">foo</span> <span class="structure">{</span> <span class="comment"># 1: for non-empty code</span><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="symbol">@list</span> <span class="structure">)</span> <span class="structure">{</span> <span class="comment"># 1: "if"</span><br /> <span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$x</span> <span class="structure">(</span> <span class="symbol">@list</span> <span class="structure">)</span> <span class="structure">{</span> <span class="comment"># 1: "foreach"</span><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="operator">!</span> <span class="symbol">$x</span> <span class="structure">)</span> <span class="structure">{</span> <span class="comment"># 2: 1 for "if" and 1 for "!"</span><br /> <span class="word">do_something</span><span class="structure">(</span><span class="symbol">$x</span><span class="structure">);</span><br /> <span class="structure">}</span><br /> <span class="keyword">else</span> <span class="structure">{</span> <span class="comment"># 1 for "else"</span><br /> <span class="word">do_something_else</span><span class="structure">(</span><span class="symbol">$x</span><span class="structure">);</span><br /> <span class="structure">}</span><br /> <span class="structure">}</span><br /> <span class="structure">}</span><br /> <span class="keyword">return</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>This subroutine has a complexity of 6, which is calculated from the following elements:</p>
<ul>
<li><p>1 for having some code in the subroutine</p>
</li>
<li><p>1 for the first 'if' statement</p>
</li>
<li><p>1 for the 'foreach' statement</p>
</li>
<li><p>1 for the second 'if' statement</p>
</li>
<li><p>1 for the '!' in the second 'if' statement</p>
</li>
<li><p>1 for the 'else' statement</p>
</li>
</ul>
<p>Calculating this for any given subroutine is relatively simple. We just analyse the source code looking for certain tokens. But, as with so many things in Perl. we don't need to do it ourselves as someone has already written the code and put it on CPAN.</p>
<p>In this case, the module is called Perl::Metrics::Simple and it was written by Matisse Enzer. The code is based on PPI which is a handy way to extract useful information about Perl source code.</p>
<p>There are a couple of ways to use Perl::Metrics::Simple. The simple case is handled by a command line program called <code>countperl</code>. You pass it the name of a directory and it analyses any Perl files that it finds under that directory. To test it, I used my Perl module Symbol::Approx::Sub. The results start by giving some high-level stats about the code:</p>
<pre><code> Perl files found: 6
Counts
------
total code lines: 213
lines of non-sub code: 55
packages found: 6
subs/methods: 8
Subroutine/Method Size
----------------------
min: 3
max: 87
mean: 19.75
std. deviation: 28.08
median: 6.50</code></pre>
<p>That subroutine with 87 lines looks like it might be worth looking at further. It makes up over a third of the code in the distribution.</p>
<p>The program then looks at the McCabe Complexity measures. You'll notice that the analysis differentiates between code in subroutines and code that exists at the file level (outside of any subroutines).</p>
<pre><code> McCabe Complexity
-----------------
Code not in any subroutine
min: 2
max: 2
mean: 2.00
std. deviation: 0.00
median: 2.00
Subroutines/Methods
min: 1
max: 37
mean: 8.50
std. deviation: 11.99
median: 2.50</code></pre>
<p>The code outside of the subroutines looks fine. A McCabe measure of 2 means that the code is very simple. The subroutine code shows some more interesting numbers. But how do we interpret these numbers? A good rule of thumb seems to be to keep your code complexity under 20 and to get really worried if it goes over 30. So that maximum value of 37 should be a cause for concern.</p>
<p>The output then shows us the McCabe scores for each subroutine it found.</p>
<pre><code> List of subroutines, with most complex at top
---------------------------------------------
complexity sub path size
37 import lib/Symbol/Approx/Sub.pm 87
18 _make_AUTOLOAD lib/Symbol/Approx/Sub.pm 41
...</code></pre>
<p>I've only shown the first couple of lines here, as that shows the most interesting subroutines. The whole file is online if you'd like to see more.</p>
<p><a href="http://perlhacks.com/symbol-approx-sub.txt">http://perlhacks.com/symbol-approx-sub.txt</a></p>
<p>As you might suspect, the subroutine with the highest complexity is also the one with the most lines of code. That's really one that I should take a closer look at. Refactoring it to move a lot of the functionality into separate subroutines would make it simpler and, therefore, easier to maintain.</p>
<p>The <code>countperl</code> program has one more useful feature. If you run it with the <code>--html</code> command line option, it produces the same output in HTML format. You can see this version online also:</p>
<p><a href="http://perlhacks.com/symbol-approx-sub.html">http://perlhacks.com/symbol-approx-sub.html</a></p>
<p>Helpfully, in this version, the values are colour-coded which makes it easier to see the ones that require attention.</p>
<p>The <code>countperl</code> program is probably useful enough that it covers most requirements. You point it at code and it tells you the complexity of that code. If you want to do anything more complex, then you'll need to look at the documentation for Perl::Metrics::Simple itself. It's not complicated. You create a Perl::Metrics::Simple object.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$analyzer</span> <span class="operator">=</span> <span class="word">Perl::Metrics::Simple</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span></code></pre>
<p>And then call the <code>analyze_files</code> method, passing it a list of directories to analyse. This returns a Perl::Metrics::Simple::Analysis object</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$analysis</span> <span class="operator">=</span> <span class="symbol">$analyzer</span><span class="operator">-></span><span class="word">analyze_files</span><span class="structure">(</span><span class="single">'./lib'</span><span class="structure">);</span></code></pre>
<p>You can then call various methods on this object to get the actual data back. A good way to see how the methods are used is to look at the source of the <code>countperl</code> program. It's not, however, a great example of generating HTML - the source is littered with chunks of raw HTML and the whole thing would benefit greatly from being rewritten to use a templating engine.</p>
<p>One warning about working with Perl::Metrics::Simple. The objects it creates are inside-out objects. That means that the actual data is stored in lexical variables within the class's package. That can make debugging your code a little frustrating.</p>
<p>Since starting to work with Perl::Metrics::Simple, I've seen that there is also a Perl::Metrics distribution on CPAN. I plan to investigate that in near future.</p>
<p>Once you start measuring the complexity of code, it quickly becomes addictive. I'm constantly searching for subroutines with high complexity scores. So far, the highest score I've found is 209 (not my code, I hasten to add). I'd be interested to hear about any high scores that you find.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Perl::Metrics::Simple">Perl::Metrics::Simple</a></p>
</li>
<li><p><a href="https://metacpan.org/module/PPI">PPI</a></p>
</li>
<li><p><a href="http://en.wikipedia.org/wiki/Cyclomatic_complexity">http://en.wikipedia.org/wiki/Cyclomatic_complexity</a></p>
</li>
</ul>
</div>2014-12-08T00:00:00ZDave CrossOut of Timehttp://perladvent.org/2014/2014-12-07.html<div class='pod'><h2 id="NAME">NAME</h2>
<p>Time::Limit</p>
<h2 id="SYNOPSIS">SYNOPSIS</h2>
<p>Computer programs can go wrong in unexpected ways out of their control; Time::Limit can be used to limit how long a Perl script can run for and force it to exit in a predictable way cleaning up as much as possible after itself as it does so.</p>
<h3 id="Bobs-Tale">Bob's Tale</h3>
<p>Poor Bob. Stuck working on Christmas Eve because his pointy-haired-boss Ebinezer wouldn't let him go home until the server creating the TPS reports was done. At this rate he'd never leave in time to get to the post office and his little boy Tim wouldn't be getting his Christmas present after all.</p>
<p>The problem was that the TPS reports couldn't be left to run on their own. The custom binary that had been provided by TPS Solutions INC would randomly hang - not quit, not die - just sit there doing nothing. An infinite loop or something, Bob imagined, but it wasn't like he had the source code to debug it. A normal run would take about an hour, but if it was still going after that then standard operating procedure was to restart the script that executed it with a Ctrl-C and hope it worked next time (it usually did.) So Bob was stuck sitting there babysitting the computer while the minutes ticked away until the post office closed.</p>
<p>It wasn't as if it was a complicated script:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="pragma">autodie</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">TPS::Util</span> <span class="words">qw(tps_mangle tps_email)</span><span class="structure">;</span><br /><br /><span class="comment"># run the custom tps binary<br /></span><span class="word">system</span> <span class="double">"tps-generate"</span><span class="structure">;</span><br /><br /><span class="comment"># mangle and email the reports<br /></span><span class="word">tps_mangle</span><span class="structure">();</span><br /><span class="word">tps_email</span><span class="structure">(</span><span class="single">'escrooge@example.com'</span><span class="structure">);</span><br /><br /><span class="comment"># exit cleanly<br /></span><span class="word">exit</span><span class="structure">;</span></code></pre>
<p>If only there was a sensible way to kill the script automatically if it went wrong and restart it, then Bob would be able to leave it running and go home.</p>
<p>Simplistic solutions wouldn't work properly; Bob would need to be careful not only to kill the main script, but also kill the tps-generate binary as well if it was still running. Goodness only knows what would happen if two of those were running at once!</p>
<p>Also, Bob was worried about killing the script too harshly...if the mangling code was running then there were certain files to clean up on disk. It'd be nice to kill the script in such a way the signal handler attached to the process would get a chance to run. But Bob also worried about not killing the script hard enough...what if the signal handlers themselves also got into an infinite loop?</p>
<h3 id="Introducting-Time::Limit">Introducting Time::Limit</h3>
<p>What Bob needs is Time::Limit.</p>
<p>All Bob needs to do is install the module from the CPAN and then stick just one line of code at the top of the script:</p>
<pre><code class="code-listing"><span class="comment"># kill everything, including child processes, after 63 minutes<br /></span><span class="keyword">use</span> <span class="word">Time::Limit</span> <span class="word">-group</span><span class="operator">,</span> <span class="structure">(</span><span class="number">60</span> <span class="operator">+</span> <span class="number">3</span><span class="structure">)</span> <span class="operator">*</span> <span class="number">60</span><span class="structure">;</span></code></pre>
<p>After that Bob can just run the program repeatedly until it's done.</p>
<pre><code> bash$ until perl tps.pl; do echo "Trying again"; done</code></pre>
<p>Time::Limit handles the rest. Not only would it exit after 63 minutes if it ended up running that long, but the exit code it returned would let bash know to run it again.</p>
<p>In addition to this Time::Limit would kill the child processes, attempt to run cleanup code with a clean exit, or if after a time it still hadn't killed itself, send an untrappable signal to cause instant death. Pretty much handle everything how you'd hope it would.</p>
<p>As long as the server stays up, Bob's report is going to eventually run now. Get home to Tim, Bob! Who knows, your boss might be pleased enough to send someone round with a big turkey in the morning.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Time::Limit">Time::Limit</a></p>
</li>
<li><p><a href="http://www.gutenberg.org/ebooks/46">http://www.gutenberg.org/ebooks/46</a></p>
</li>
</ul>
</div>2014-12-07T00:00:00ZMark FowlerTesting The Naughty Or Nice Databasehttp://perladvent.org/2014/2014-12-06.html<div class='pod'><p>"Why", asked the Wise Old Elf, "are there three separate Santa users in the production database?"</p>
<p>The question was directed at Baubles MacTinsle, the hotshot new elf that had joined the team a few weeks ago. Baubles had been working on the rewrite of the code that interfaced with the Christmas database, and the Wise Old Elf wasn't happy with what he saw.</p>
<p>"Ah, well, er, you..um, see", Baubles started unpromisingly, "there was a bug in the new code. You know how it is. You never know if it's going to work right until you run it on the live database. No worries though, we got it all fixed up right away. And we thought we'd cleaned up all the data. Obviously missed a few..."</p>
<p>"This database can't have any errors in it!" spluttered the Wise Old Elf, "This is the canonical record of who's been naughty or nice! Big data? Humans have no idea. Do you have <i>any</i> idea how many times the average human child is naughty in a day? Rebuilding this would take weeks! Let me see the tests."</p>
<p>"Ah, tests....they're tedious to write you see. We...sorta skipped that bit on account of how long it takes..."</p>
<p>"Ah", exclaimed the Wise Old Elf. "I'll have to show you Test::DatabaseRow"</p>
<h3 id="Test::DatabaseRow">Test::DatabaseRow</h3>
<p>"Let me show you how to write a simple test", the Wise Old Elf began. "First we start the tests like any normal test suite. Turning on strictures, loading Test::More and of course Test::DatabaseRow itself"</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Test::More</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::DatabaseRow</span><span class="structure">;</span></code></pre>
<p>"Next we we need to hook up Test::DatabaseRow to our database"</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">DBI</span><span class="structure">;</span><br /><span class="keyword">local</span> <span class="symbol">$Test::DatabaseRow::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="double">"dbi:SQLite:dbname=test.db"</span><span class="operator">,</span><span class="double">""</span><span class="operator">,</span><span class="double">""</span><span class="structure">);</span></code></pre>
<p>"The local statement sets the default database handle that all subsequent Test::DatabaseRow tests will use unless a <code>dbh</code> argument is explicitly passed to them. Since we're only testing one database we can save ourselves some typing if we set a default like this at the top of our script."</p>
<p>Baubles was nodding enthusiastically. He was all about typing less.</p>
<p>"Well, here's the first test we're doing", the Wise Old Elf continued, "we're checking that there's exactly one row returned from a SQL statement that selects everyone that has the first name Santa"</p>
<pre><code class="code-listing"><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">sql</span> <span class="operator">=></span> <span class="double">"SELECT * FROM staff WHERE first_name = 'Santa'"</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>"Oh oh, you'r not using bind parameters", the young elf shouted, "you're going to get us HACKED".</p>
<p>"Well, no", the Wise Old Elf countered humorlessly. "There's no variable. But you right, bind parameters are a good idea, and this is how we use them".</p>
<pre><code class="code-listing"><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">sql</span> <span class="operator">=></span> <span class="structure">[</span> <span class="double">"SELECT * FROM staff WHERE first_name = ?"</span><span class="operator">,</span> <span class="single">'Santa'</span> <span class="structure">]</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>"Er, thanks Sir, that's kinda nice, but...look, we just don't have time to write so much SQL."</p>
<p>The Wise Old Elf sighed. He was pretty sure Baubles would argue whatever he needed to avoid writing the tests. Luckily, he had an answer. "Well, you don't have to write the SQL if you don't want to. Test::DatabaseRow is able to write the SQL for us too."</p>
<pre><code class="code-listing"><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">table</span> <span class="operator">=></span> <span class="double">"staff"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="operator">=></span> <span class="structure">[</span> <span class="word">first_name</span> <span class="operator">=></span> <span class="single">'Santa'</span> <span class="structure">]</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>The young elf looked despondent. Then, it suddenly dawned on him, "But I still have to write SQL if I need to do a like, or say something is not something, right?"</p>
<p>"We've got that covered too"</p>
<pre><code class="code-listing"><span class="comment"># check we've got all the original reindeer in the database<br /></span><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">table</span> <span class="operator">=></span> <span class="double">"staff"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="single">'='</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">species</span> <span class="operator">=></span> <span class="single">'Reindeer'</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="single">'!='</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">nose_color</span> <span class="operator">=></span> <span class="single">'red'</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="single">'like'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">address</span> <span class="operator">=></span> <span class="single">'%North Pole%'</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">7</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>MacTinsle threw his little elf arms up in the air in resignation. "Okay, okay, I give up. I'll write the tests."</p>
<h3 id="Explicit-Tests">Explicit Tests</h3>
<p>"All right, but let me show you a problem first. Look at this test where we're checking Santa's last name is right."</p>
<pre><code class="code-listing"><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">table</span> <span class="operator">=></span> <span class="double">"staff"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="word">first_name</span> <span class="operator">=></span> <span class="double">"Santa"</span><span class="operator">,</span><br /> <span class="word">last_name</span> <span class="operator">=></span> <span class="double">"Claws"</span><br /> <span class="structure">]</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>"Can you see the problem?"</p>
<p>The younger elf scratched his beard for a minute and then slowly started to shake his head.</p>
<p>"The problem is my young friend that if the test fails you can't tell <code>how</code>. The database just doesn't return any results."</p>
<pre><code> not ok 1 - simple db test
# Failed test 'simple db test'
# at test.pl line 11.
# Got the wrong number of rows back from the database.
# got: 0 rows back
# expected: 1 rows back</code></pre>
<p>"We'd be better off writing the test like so:"</p>
<pre><code class="code-listing"><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">table</span> <span class="operator">=></span> <span class="double">"staff"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="word">first_name</span> <span class="operator">=></span> <span class="double">"Santa"</span><span class="operator">,</span><br /> <span class="structure">]</span><span class="operator">,</span><br /> <span class="word">tests</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="word">last_name</span> <span class="operator">=></span> <span class="double">"Claws"</span><span class="operator">,</span><br /> <span class="structure">]</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>"This causes Perl to load the row that matchs the where parameters into memory and then compare it within Perl to see that the tests match. Because <code>Claws</code> looks like a string not a number it'll do a string equality comparison. And if something goes wrong you'll see something that tells you <b>how</b> it went wrong:"</p>
<pre><code> not ok 1 - simple db test
# Failed test 'simple db test'
# at test.pl line 11.
# While checking column 'last_name' on 1st row
# got: 'Clause'
# expected: 'Claws'
1..6
# Looks like you failed</code></pre>
<p>"I like it. But...wait, you said that Test::DatabaseRow essentially guesses if it should do a number comparison or a string comparison by what it's comparing the result against...what if it guesses wrong?</p>
<p>"Just like the <code>where</code> parameter, the <code>tests</code> parameter can also take an explicit hashref of comparisons:"</p>
<pre><code class="code-listing"><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">table</span> <span class="operator">=></span> <span class="double">"staff"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="single">'first_name'</span> <span class="operator">=></span> <span class="double">"Rudolph"</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">tests</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="single">'eq'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">idcode</span> <span class="operator">=></span> <span class="double">"480058686"</span><span class="operator">,</span> <span class="comment"># must be exact string</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="single">'=~'</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">address</span> <span class="operator">=></span> <span class="regexp">qr/North Pole/</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>"And if you want to write something very complex, you can always capture the data from the test if you really need to:"</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">%row</span><span class="structure">;</span><br /><span class="word">all_row_ok</span><span class="structure">(</span><br /> <span class="word">table</span> <span class="operator">=></span> <span class="double">"staff"</span><span class="operator">,</span><br /> <span class="word">where</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="single">'first_name'</span> <span class="operator">=></span> <span class="double">"Frosty"</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">store_row</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">%row</span><span class="operator">,</span><br /> <span class="word">results</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">}</span><br /><br /><span class="comment"># don't care if we use snowman or snowperson<br /># but the last name should match the species<br /></span><span class="word">is</span><span class="structure">(</span><span class="symbol">$row</span><span class="operator">-></span><span class="structure">{</span><span class="word">last_name</span><span class="structure">}</span><span class="operator">,</span> <span class="symbol">$row</span><span class="operator">-></span><span class="structure">{</span><span class="word">species</span><span class="structure">});</span></code></pre>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Test::DatabaseRow">Test::DatabaseRow</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Test::More">Test::More</a></p>
</li>
<li><p><a href="https://metacpan.org/module/DBI">DBI</a></p>
</li>
</ul>
</div>2014-12-06T00:00:00ZMark FowlerA Subroutine By Any Other Namehttp://perladvent.org/2014/2014-12-05.html<div class='pod'><p>Perl's function prototypes can be used in clever ways to create new syntax, but abusing anonymous subroutines in this fashion can often result in hard to read stacktraces which make your code hard to debug. One simple solution is to manually name all your anonymous subroutines using the handy Sub::Util module</p>
<h3 id="Creating-New-Syntax-With-Perl">Creating New Syntax With Perl</h3>
<p>Often I find myself having to sort a list by some property of the item I'm sorting, for example the number of bytes the strings would take to encode in utf-8.</p>
<p>This is easy enough, if you're prepared to be inefficent:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Encode</span> <span class="words">qw(encode_utf8)</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@sorted</span> <span class="operator">=</span> <span class="word">sort</span> <span class="structure">{</span> <br /> <span class="word">length</span> <span class="word">encode_utf8</span> <span class="symbol">$a</span> <span class="operator"><=></span> <span class="word">length</span> <span class="word">encode_utf8</span> <span class="symbol">$b</span><br /><span class="structure">}</span> <span class="symbol">@strings</span><span class="structure">;</span></code></pre>
<p>The problem with this is that Perl has to recalcuate the utf-8 encoding of the string multiple times: Every time it wants to compare the length of a string against another string (which it has to do multiple times as it's sorting.) There's a standard trick that you can do in Perl to avoid this called a Schwartzian transform:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@sorted</span> <span class="operator">=</span> <br /> <span class="word">map</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span> <span class="structure">}</span><br /> <span class="word">sort</span> <span class="structure">{</span> <span class="symbol">$a</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="operator"><=></span> <span class="symbol">$b</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="structure">}</span><br /> <span class="word">map</span> <span class="structure">{</span> <span class="structure">[</span><span class="magic">$_</span><span class="operator">,</span> <span class="word">length</span> <span class="word">encode_utf8</span> <span class="magic">$_</span> <span class="structure">]</span> <span class="structure">}</span> <span class="magic">@_</span><span class="structure">;</span></code></pre>
<p>This rather ugly syntax was created by Randal Schwartz to build a data structure on the fly that contains the weighting value, sort that, then extract the original (now sorted) values out again. Easy to understand, right? No? Maybe we could abstract that away in a subroutine call?</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">weighted_sort</span> <span class="structure">{</span><br /><span class="comment"> # the anonymous subroutine that calculates a weighting for whatever is<br /> # in $_<br /></span> <span class="keyword">my</span> <span class="symbol">$weighter</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <br /> <span class="word">map</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span> <span class="structure">}</span><br /> <span class="word">sort</span> <span class="structure">{</span> <span class="symbol">$a</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="operator"><=></span> <span class="symbol">$b</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="structure">}</span><br /> <span class="word">map</span> <span class="structure">{</span> <span class="structure">[</span><span class="magic">$_</span><span class="operator">,</span> <span class="symbol">$weighter</span><span class="operator">-></span><span class="structure">()</span> <span class="structure">]</span> <span class="structure">}</span> <span class="magic">@_</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>This can then be used like so:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@sorted</span> <span class="operator">=</span> <span class="word">weighted_sort</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="word">length</span> <span class="word">encode_utf8</span> <span class="magic">$_</span> <span class="structure">}</span><span class="operator">,</span> <span class="symbol">@strings</span><span class="structure">);</span></code></pre>
<p>It's not the most pretty of syntax but it sure beats the confusing Schwartzian transform we had in the middle of our code before. However, The anonymous subroutine is jarring, and there's lots of extra brackets. Ideally we'd like to be able to call it like map where the subroutine looks just like a block of code in the middle of our statement:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@sorted</span> <span class="operator">=</span> <span class="word">weighted_sort</span> <span class="structure">{</span> <span class="word">length</span> <span class="word">encode_utf8</span> <span class="magic">$_</span> <span class="structure">}</span> <span class="symbol">@strings</span><span class="structure">;</span></code></pre>
<p>Which isn't that hard to do. If we specify a prototype for our subroutine where the first argument is an anonymous subroutine (i.e. the <code>&</code> prototype) and the remaining arguments are a list (i.e. the <code>@</code> prototype) like so:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">weighted_sort</span><span class="prototype">(&@)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /><span class="structure">}</span></code></pre>
<p>Then Perl is smart enough to let us remove the surrounding <code>()</code> and leave out the <code>sub</code> before and <code>,</code> after the anonymous subroutine. And then we have what amounts to new syntax. Wonderful!</p>
<h3 id="The-Debug-Problem-With-New-Syntax">The Debug Problem With New Syntax</h3>
<p>The major problem with using anonymous subroutines to synthesize new syntax is that they remain anonymous when we really need to know what they are - in stack traces!</p>
<p>For example:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@sorted</span> <span class="operator">=</span> <span class="word">weighted_sort</span> <span class="structure">{</span> <span class="word">karma_rating</span><span class="structure">(</span><span class="magic">$_</span><span class="operator">,</span> <span class="number">2</span> <span class="structure">)</span> <span class="structure">}</span> <span class="symbol">@stuff</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">nautghtyness_rating</span> <span class="structure">{</span><br /> <span class="word">print</span> <span class="word">STDERR</span> <span class="word">Devel::StackTrace</span><span class="operator">-></span><span class="word">new</span> <span class="word">if</span> <span class="symbol">$DEBUG_NAUGHTYNESS</span><span class="structure">;</span><br /> <span class="operator">...</span><br /><span class="structure">}</span></code></pre>
<p>This prints out:</p>
<pre><code> Trace begun at karma.pl line 22
main::karma_rating('1,2,3,4', 2) called at karma.pl line 19
main::__ANON__ at karma.pl line 16
main::weighted_sort('CODE(0x7fd91b02a240)', 'a', 'b', 'c', 'd') called at karma.pl line 19
...</code></pre>
<p>Wait, that makes no sense. What's this <code>__ANON__</code> in the middle of our code? Oh, right, that's the <code>{ karma_rating($_, 2 ) }</code> subroutine. Wouldn't it be nice if this had a name?</p>
<h3 id="Sub::Util-to-the-rescue">Sub::Util to the rescue.</h3>
<p>This is where Sub::Util steps in, allowing us to name the subroutine anything we want:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Sub::Util</span> <span class="words">qw(set_subname)</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">weighted_sort</span><span class="prototype">(&@)</span> <span class="structure">{</span><br /><span class="comment"> # the anonymous subroutine that calculates a weighting for whatever is<br /> # in $_<br /></span> <span class="keyword">my</span> <span class="symbol">$weighter</span> <span class="operator">=</span> <span class="word">set_subname</span><span class="structure">(</span><span class="double">"weighted_sort_weighting_block"</span><span class="operator">,</span> <span class="core">shift</span><span class="structure">);</span><br /><br /> <span class="keyword">return</span> <br /> <span class="word">map</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span> <span class="structure">}</span><br /> <span class="word">sort</span> <span class="structure">{</span> <span class="symbol">$a</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="operator"><=></span> <span class="symbol">$b</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="structure">}</span><br /> <span class="word">map</span> <span class="structure">{</span> <span class="structure">[</span><span class="magic">$_</span><span class="operator">,</span> <span class="symbol">$weighter</span><span class="operator">-></span><span class="structure">()</span> <span class="structure">]</span> <span class="structure">}</span> <span class="magic">@_</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>And now when we run our code we get this:</p>
<pre><code> Trace begun at karma.pl line 22
main::karma_rating('a', 2) called at karma.pl line 19
main::weighted_sort_weighting_block at karma.pl line 16
main::weighted_sort('CODE(0x7f926b02f9b0)', 'a', 'b', 'c', 'd') called at karma.pl line 19
...</code></pre>
<p>Which makes our stack traces that little bit more readable!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Sub::Util">Sub::Util</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Sub::Name">Sub::Name</a></p>
</li>
<li><p><a href="https://metacpan.org/module/List::UtilsBy">List::UtilsBy</a></p>
</li>
</ul>
</div>2014-12-05T00:00:00ZMark FowlerPSGI, Enabling Modern Web Technology in Perlhttp://perladvent.org/2014/2014-12-04.html<div class='pod'><p>In recent years we've seen an explosion of powerful web technologies in Perl not at the least due to the creation of the PSGI specification.</p>
<p>PSGI and Plack allow us to glue together webservers and web frameworks in interesting ways, not only allowing us to hook any webservice up to any web framework, but allowing us to chain our frameworks together and transform output in interesting and exciting ways.</p>
<h3 id="Why-PSGI">Why PSGI?</h3>
<p>PSGI is a convention that allows an easy way to connect webservers and web frameworks together. By following the convention any PSGI compatible webserver can connect to any PSGI compatible web framework. When someone writes a new web framework, as long as it supports PSGI, then it'll work with any webserver. Whenever someone writes a new webserver, as long as it supports PSGI (or has an adapter written for it like Apache and nginx do) they can support any of the web frameworks.</p>
<h3 id="PSGI-by-example">PSGI by example</h3>
<p>PSGI applications are surprisingly simple to write:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$env</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="structure">[</span><br /> <span class="single">'200'</span><span class="operator">,</span><br /> <span class="structure">[</span> <span class="single">'Content-Type'</span> <span class="operator">=></span> <span class="single">'text/plain'</span> <span class="structure">]</span><span class="operator">,</span><br /> <span class="structure">[</span> <span class="double">"Merry Christmas from $env->{PATH_INFO}\n"</span><span class="structure">]</span><br /> <span class="structure">]</span><br /><span class="structure">};</span></code></pre>
<p>You can actually launch the application in the simple Perl script above as a functioning webserver with the <code>plackup</code> command that comes with plack.</p>
<pre><code> bash$ plackup merryxmas.pl
HTTP::Server::PSGI: Accepting connections at http://0:5000/</code></pre>
<p>Plackup expects the last thing in the script to be the subroutine reference that is the PSGI application. And it works just as you might expect:</p>
<pre><code> bash$ curl http://127.0.0.1:5000/santa/and/the/elves
Merry Christmas from /santa/and/the/elves</code></pre>
<p>This all works because at its most basic a PSGI compatible web application is a simple subroutine. The subroutine is passed one argument - a hashref representing the environment variables, and returns something representing the response.</p>
<p>These environment variables represent the environment the webserver would normally see like <code>PATH_INFO</code>, <code>QUERY_STRING</code>, etc, etc and a few PSGI specific ones including <code>psgi.input</code> (a IO::Handle like object that allows the reading of the request body) and <code>psgi.errors</code> (an IO::Handle that can be written to to, say, write to apache's error log.) The subroutine return value is one of three things - an arrayref containing the strings that make up the output, or a IO::Handle like object the output can be read from, or another callback that can be used for server push like applications.</p>
<p>There's slightly more to the PSGI spec than this - for example, there's optional streaming support so if the server and client want they can send parts of the web page back before the whole thing has been generated - but that's the gist of it.</p>
<h3 id="Plack">Plack</h3>
<p>Aside from providing us with the handy <code>plackup</code> command line utility, what's Plack's role in this? Well at the very least Plack can be thought of as a slightly higher level abstraction that sits on top of the raw PSGI specification to make it easier to do the common things with the PSGI input and output.</p>
<p>For example, something as simple as getting a query parameter is complicated since it's entirely the responsibility of the PSGI application to decode the contents of the <code>QUERY_STRING</code> to get at the query parameters. Similarly cookies are problematic, requiring both encoding and setting and parsing and decoding http header strings.</p>
<p>Plack provides a <b>Plack::Request</b> and <b>Plack::Response</b> classes that can be constructed from the incoming <code>$env</code> hash and be used to build the array ref response respectively.</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Plack::Request</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$request</span> <span class="operator">=</span> <span class="word">Plack::Request</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="core">shift</span><span class="structure">);</span><br /><br /><span class="comment"> # get who is saying merry christmas<br /></span> <span class="keyword">my</span> <span class="symbol">$who</span> <span class="operator">=</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">param</span><span class="structure">(</span><span class="single">'who'</span><span class="structure">);</span><br /><br /><span class="comment"> # did they come back a second time?<br /></span> <span class="keyword">my</span> <span class="symbol">$again</span> <span class="operator">=</span> <span class="double">""</span><span class="structure">;</span><br /> <span class="symbol">$again</span> <span class="operator">=</span> <span class="double">" again"</span> <span class="word">if</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">cookies</span><span class="operator">-></span><span class="structure">{</span><span class="word">again</span><span class="structure">};</span><br /><br /><span class="comment"> # create a response in a much more friendly way<br /></span> <span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">new_response</span><span class="structure">;</span><br /> <span class="symbol">$response</span><span class="operator">-></span><span class="word">status</span><span class="structure">(</span><span class="number">200</span><span class="structure">);</span><br /> <span class="symbol">$response</span><span class="operator">-></span><span class="word">content_type</span><span class="structure">(</span><span class="double">"text/plain"</span><span class="structure">);</span><br /> <span class="symbol">$response</span><span class="operator">-></span><span class="word">body</span><span class="structure">(</span><span class="double">"Merry Christmas$again from $who"</span><span class="structure">);</span><br /> <span class="symbol">$response</span><span class="operator">-></span><span class="word">cookies</span><span class="operator">-></span><span class="structure">{</span><span class="word">again</span><span class="structure">}</span> <span class="operator">=</span> <span class="number">1</span><span class="structure">;</span><br /><br /><span class="comment"> # convert the response back into an array ref<br /> # and return it<br /></span> <span class="keyword">return</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">finalize</span><span class="structure">;</span><br /><span class="structure">};</span></code></pre>
<p></p>
<pre><code> bash$ plackup merryxmas2.pl
HTTP::Server::PSGI: Accepting connections at http://0:5000/
bash$ curl -b jar -c jar http://127.0.0.1:5000?who=Santa+and+the+elves
Merry Christmas from Santa and the elves
bash$ curl -b jar -c jar http://127.0.0.1:5000?who=Santa+and+the+elves
Merry Christmas again from Santa and the elves</code></pre>
<h3 id="Plack-Middleware">Plack Middleware</h3>
<p>One of the handy things about the PSGI specification is that it makes it trivial for a PSGI compatible client to make a request to another PSGI compatible client to help fulfill the request. Because the <i>outer</i> client is playing the role of yet another compatible PSGI webserver the <i>inner</i> client doesn't need to care its not directly hooked up to the so-called <i>real</i> web server.</p>
<p>For example, we could easily adapt our previous script to give a Very Special Christmas Message from Mr Hankey:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Plack::Request</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="operator">...</span> <span class="comment"># as before</span><br /><span class="structure">};</span><br /><br /><span class="keyword">my</span> <span class="symbol">$app2</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$env</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$request</span> <span class="operator">=</span> <span class="word">Plack::Request</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="symbol">$env</span><span class="structure">);</span><br /><br /><span class="comment"> # If Mr Hankey is saying Merry Christmas, send them to the<br /> # video instead.<br /></span> <span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$request</span><span class="operator">-></span><span class="word">param</span><span class="structure">(</span><span class="single">'who'</span><span class="structure">)</span> <span class="operator">eq</span> <span class="double">"Mr Hankey"</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$request</span><span class="operator">-></span><span class="word">new_response</span><span class="structure">;</span><br /> <span class="symbol">$response</span><span class="operator">-></span><span class="word">redirect</span><span class="structure">(</span><span class="double">"http://www.hulu.com/watch/249828"</span><span class="structure">);</span><br /> <span class="keyword">return</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">finalize</span><span class="structure">();</span><br /> <span class="structure">}</span><br /><br /><span class="comment"> # otherwise chain through to the original app<br /></span> <span class="keyword">return</span> <span class="symbol">$app</span><span class="operator">-></span><span class="structure">(</span><span class="symbol">$env</span><span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Because we're just wrapping the original application we don't have to alter the application in any way. Of course, in this example, we have the source code for the original application in the same file - but the application could be provided third party code inside a module and the same technique would work.</p>
<p>Plack provides the <b>Plack::Middleware</b> class that makes the process of modifying the response easier, and along with <b>Plack::Util</b> helps us deal with the slightly more complex cases where there's a callback for a response from our inner class:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Plack::Middleware::XReindeer</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">base</span> <span class="words">qw(Plack::Middleware)</span><span class="structure">;</span><br /><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="word">Plack::Util</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Acme::MetaSyntactic::reindeer</span> <span class="words">qw(metareindeer)</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">call</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">$env</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /><span class="comment"> # run the original application<br /></span> <span class="keyword">my</span> <span class="symbol">$res</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">app</span><span class="operator">-></span><span class="structure">(</span><span class="symbol">$env</span><span class="structure">);</span><br /><br /><span class="comment"> # now modify the response. Use response_cb to turn<br /> # any response into the three-item list before we process it<br /></span> <span class="word">Plack::Util::response_cb</span><span class="structure">(</span><span class="symbol">$res</span><span class="operator">,</span> <span class="keyword">sub</span> <span class="structure">{</span><br /><span class="comment"> # get the three item arrayref<br /></span> <span class="keyword">my</span> <span class="symbol">$res</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /><span class="comment"> # add an extra header with some random reindeer<br /></span> <span class="word">push</span> <span class="cast">@</span><span class="structure">{</span> <span class="symbol">$res</span><span class="operator">-></span><span class="structure">[</span><span class="number">1</span><span class="structure">]</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="double">"X-Reindeer"</span> <span class="operator">=></span> <span class="word">metareindeer</span><span class="structure">;</span><br /><br /><span class="comment"> # return nothing; It doesn't matter what we return, we<br /> # always directly modify the original arrayref<br /></span> <span class="keyword">return</span><span class="structure">;</span><br /> <span class="structure">});</span><br /> <span class="structure">}</span><br /><br /> <span class="number">1</span><span class="structure">;</span></code></pre>
<p>By turning our middleware into a <b>Plack::Middleware</b> subclass we can easily make use of the <code>Plack::Builder</code> module to glue our applications together:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Plack::Builder</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="operator">...</span> <span class="structure">};</span><br /><br /><span class="comment"># builder returns a new app annoymous sub that wraps $app with the<br /># middleware we specify<br /></span><br /><span class="word">builder</span> <span class="structure">{</span><br /> <span class="word">enable</span> <span class="double">"XReindeer"</span><span class="structure">;</span><br /> <span class="symbol">$app</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>Plenty of pre-existing middleware modules exist on CPAN. For example we could have implemented gzip compression on our application as well just by wrapping the output with <b>Plack::Middleware::Deflater</b>.</p>
<pre><code class="code-listing"><span class="word">builder</span> <span class="structure">{</span><br /> <span class="word">enable</span> <span class="double">"Deflater"</span><span class="structure">;</span><br /> <span class="word">enable</span> <span class="double">"XReindeer"</span><span class="structure">;</span><br /> <span class="symbol">$app</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<h3 id="Plack::Test">Plack::Test</h3>
<p>Another great thing about abstracting away the actual webserver that our PSGI application is talking to is that we don't actually have to have a real webserver at the outer layer at all! If we just want to test our application we can do this in process by just sending input to the anonymous subroutine and examining the return values.</p>
<p>This is a tremendous improvement over such frameworks as Apache::Test that actually have to launch a mod_perl Apache webserver in another process and talk to it over TCP/IP sockets. Not only is talking in process significantly less complex, but its an order of magnitude quicker and can save many minutes off a test suite execution time.</p>
<p>Plack ships with the Plack::Test module that can perform the job of the external server. Designed to have LWP style requests thrown at it and LWP style responses coming back, it gets the job done with minimal fuss:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Test::More</span> <span class="word">tests</span> <span class="operator">=></span> <span class="number">4</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Plack::Test</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">HTTP::Request::Common</span> <span class="words">qw(GET)</span><span class="structure">;</span><br /><br /><span class="comment"># load the application from the other script<br /></span><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="word">do</span> <span class="single">'merryxmas3.pl'</span><span class="structure">;</span><br /><br /><span class="word">test_psgi</span><br /> <span class="word">app</span> <span class="operator">=></span> <span class="symbol">$app</span><span class="operator">,</span><br /> <span class="word">client</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="core">shift</span><span class="operator">-></span><span class="structure">(</span><span class="word">GET</span> <span class="single">'/?who=Santa'</span><span class="structure">);</span><br /> <span class="word">is</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">status</span><span class="operator">,</span> <span class="number">200</span><span class="structure">;</span><br /> <span class="word">is</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">content</span><span class="operator">,</span> <span class="double">"Merry Christmas from Santa\n"</span><span class="structure">;</span><br /> <span class="structure">};</span><br /><br /><span class="word">test_psgi</span><br /> <span class="word">app</span> <span class="operator">=></span> <span class="symbol">$app</span><span class="operator">,</span><br /> <span class="word">client</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="core">shift</span><span class="operator">-></span><span class="structure">(</span><span class="word">GET</span> <span class="single">'/?who=Mr+Hankey'</span><span class="structure">);</span><br /> <span class="word">is</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">status</span><span class="operator">,</span> <span class="number">302</span><span class="structure">;</span><br /> <span class="word">like</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">header</span><span class="structure">(</span><span class="single">'Location'</span><span class="structure">)</span><span class="operator">,</span> <span class="regexp">qr/hulu[.]com/</span><span class="structure">;</span><br /> <span class="structure">};</span><br /><br /><span class="word">done_testing</span><span class="structure">;</span></code></pre>
<h3 id="In-Conclusion">In Conclusion</h3>
<p>Plack and PSGI offer a wonderful toolset. I'm blown away that I can go from a simple server for testing:</p>
<pre><code> bash$ plackup perladventcalendar.pl</code></pre>
<p>Right the way up to running a powerful pre-forking server (like Starman) suitable for handling the traffic that the Perl Advent Calendar receives by just changing one command line argument:</p>
<pre><code> bash$ plackup -s Starman perladventcalendar.pl</code></pre>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/PSGI">PSGI</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Plack">Plack</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Plack::Builder">Plack::Builder</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Plack::Util">Plack::Util</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Plack::Middleware">Plack::Middleware</a></p>
</li>
</ul>
</div>2014-12-04T00:00:00ZMark FowlerAttention Seeking Behaviorhttp://perladvent.org/2014/2014-12-03.html<div class='pod'><p>Since perl 5.14, Perl has shipped with HTTP::Tiny and JSON:PP which allows accessing a large collection of web services without installing any additional modules trivial. I have a set of scripts that can be put on any server on the Internet with a modern Perl installed that can send me notifications.</p>
<h3 id="Distractions-are....oooh-shiny">Distractions are....oooh, shiny!</h3>
<p>Ever get bored waiting for a script to complete on a remote server? Happens to me all the time. Then next thing I know I realize I've been reading the Perl Weekly for half an hour and the remote command completed twenty five minutes ago.</p>
<p>Ooops.</p>
<p>What I need is some way to notify me that we're done now. In my ideal world, I'd have a script that I could call like this</p>
<pre><code> bash$ perl something_really_long.pl; notify "done with really long task"</code></pre>
<p>How could I go about writing that?</p>
<h3 id="Drop-me-an-email">Drop me an email</h3>
<p>The simplest solution would be to send me an email, with a command that looks like:</p>
<pre><code> bash$ perl something_really_long.pl; emailnotify "done with really long task"</code></pre>
<p>Traditionally we'd do this by initializing a SMTP connection from the notifying machine itself; This is impractical these days for several reasons including modern SPAM filtering not trusting connections from random servers, and, of course, talking SMTP is non-trivial without several non-core modules from the CPAN.</p>
<p>Luckily in our modern cloud like infrastructure email-as-a-service is a real thing. Several providers allow you to request an email send with nothing more than a HTTP request. One such provider is Mandrill, who currently offer a large number of free emails on their trial account.</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">HTTP::Tiny</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">JSON::PP</span> <span class="words">qw(encode_json)</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$text</span> <span class="operator">=</span> <span class="word">join</span> <span class="double">" "</span><span class="operator">,</span> <span class="symbol">@ARGV</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$API_KEY</span> <span class="operator">=</span> <span class="single">'<redacted>'</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$FROM</span> <span class="operator">=</span> <span class="single">'mark@example.com'</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$TO</span> <span class="operator">=</span> <span class="single">'mark@example.com'</span><span class="structure">;</span><br /><br /><span class="word">HTTP::Tiny</span><span class="operator">-></span><span class="word">new</span><span class="structure">()</span><span class="operator">-></span><span class="word">post</span><span class="structure">(</span><br /> <span class="single">'https://mandrillapp.com/api/1.0/messages/send.json'</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">content</span> <span class="operator">=></span> <span class="word">encode_json</span><span class="structure">({</span><br /> <span class="word">key</span> <span class="operator">=></span> <span class="symbol">$API_KEY</span><span class="operator">,</span><br /> <span class="word">message</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">text</span> <span class="operator">=></span> <span class="symbol">$text</span><span class="operator">,</span><br /> <span class="word">subject</span> <span class="operator">=></span> <span class="double">"Email notification"</span><span class="operator">,</span><br /> <span class="word">from_name</span> <span class="operator">=></span> <span class="double">"Email notifier"</span><span class="operator">,</span><br /> <span class="word">from_email</span> <span class="operator">=></span> <span class="symbol">$FROM</span><span class="operator">,</span><br /> <span class="word">to</span> <span class="operator">=></span> <span class="structure">[</span> <span class="structure">{</span> <span class="word">email</span> <span class="operator">=></span> <span class="symbol">$TO</span> <span class="structure">}</span> <span class="structure">]</span><span class="operator">,</span><br /> <span class="structure">}</span><br /> <span class="structure">})</span><span class="operator">,</span><br /> <span class="structure">}</span><br /><span class="structure">);</span></code></pre>
<h3 id="Cut-me-some-Slack">Cut me some Slack</h3>
<p>Okay, I admit it. I never check my email in a timely fashion these days. If I dropped everything to check my email each time a new message arrived, I'd spend my entire day being interrupted by the latest breaking Buffy The Vampire Slayer news from London.pm rather than getting work done.</p>
<p>Anyway, all the cool kids are moving onto next generation communication systems like Slack. Often described as "Modern IRC", Slack is a web chat system that can also run in desktop clients and on mobile devices. Slack has a range of notification systems built in, from using modern HTML5 browser notifications into sending push notifications to the iOS devices that pretty much never leaves my side.</p>
<p>By leveraging this notification system on top of a free account I can send messages to my cell phone.</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">HTTP::Tiny</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">JSON::PP</span> <span class="words">qw(encode_json)</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$text</span> <span class="operator">=</span> <span class="word">join</span> <span class="double">" "</span><span class="operator">,</span> <span class="symbol">@ARGV</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$SECRET_URL</span> <span class="operator">=</span> <span class="single">'https://hooks.slack.com/services/<redacted>'</span><span class="structure">;</span><br /><br /><span class="word">HTTP::Tiny</span><span class="operator">-></span><span class="word">new</span><span class="structure">()</span><span class="operator">-></span><span class="word">post_form</span><span class="structure">(</span><br /> <span class="symbol">$SECRET_URL</span><span class="operator">,</span><br /> <span class="structure">{</span><br /> <span class="word">payload</span> <span class="operator">=></span> <span class="word">encode_json</span><span class="structure">({</span><br /> <span class="word">channel</span> <span class="operator">=></span> <span class="double">"#test"</span><span class="operator">,</span><br /> <span class="word">text</span> <span class="operator">=></span> <span class="symbol">$text</span><span class="operator">,</span><br /> <span class="structure">})</span><br /> <span class="structure">}</span><br /><span class="structure">);</span></code></pre>
<h3 id="Last-ditch:-all-going-to-POTS">Last ditch: all going to POTS</h3>
<p>Sometimes I'm away from my computer (shocking I know) and my cell phone is plugged in upstairs charging. What could we do to notify me in this situation? As a last ditch I guess we could call my house landline phone and hope that whoever answers it can track me down.</p>
<p>Twillo offers a service where it can phone you up and use text-to-speech to read you your message. A free trial account will be able to call the number that you verified the account from (with a disclaimer played before your message is read to remind you that this is just a trial account.)</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">HTTP::Tiny</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$ACCOUNT_SID</span> <span class="operator">=</span> <span class="single">'<redacted>'</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$API_TOKEN</span> <span class="operator">=</span> <span class="single">'<redacted>'</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$FROM</span> <span class="operator">=</span> <span class="single">'+15185551234'</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$TO</span> <span class="operator">=</span> <span class="single">'+15185555678'</span><span class="structure">;</span><br /><br /><span class="comment"># get the message<br /></span><span class="keyword">my</span> <span class="symbol">$text</span> <span class="operator">=</span> <span class="word">join</span> <span class="double">" "</span><span class="operator">,</span> <span class="symbol">@ARGV</span><span class="structure">;</span><br /><br /><span class="comment"># escape it to stick it in the xml<br /></span><span class="symbol">$text</span> <span class="operator">=~</span> <span class="substitute">s/</&lt;/g</span><span class="structure">;</span><br /><span class="symbol">$text</span> <span class="operator">=~</span> <span class="substitute">s/&/&amp;/g</span><span class="structure">;</span><br /><br /><span class="comment"># Create the Twillo XML containg what should be contained in the call<br /></span><span class="keyword">my</span> <span class="symbol">$xml</span> <span class="operator">=</span> <span class="double">"<Response><Say>$text</Say></Response>"</span><span class="structure">;</span><br /><br /><span class="comment"># Twillo needs a URL to fetch XML that contains what should be said in the<br /># call. This url just will contain whatever we send in it in the Twiml<br /># parameter<br /></span><span class="symbol">$xml</span> <span class="operator">=~</span> <span class="substitute">s/([^A-Za-z0-9])/"%".uc(sprintf("%2.2x",ord($1)))/eg</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$url</span> <span class="operator">=</span> <span class="double">"http://twimlets.com/echo?Twiml="</span><span class="operator">.</span><span class="symbol">$xml</span><span class="structure">;</span><br /><br /><span class="comment"># make the call<br /></span><span class="word">HTTP::Tiny</span><span class="operator">-></span><span class="word">new</span><span class="structure">()</span><span class="operator">-></span><span class="word">post_form</span><span class="structure">(</span><br /> <span class="double">"https://$ACCOUNT_SID:$API_TOKEN\@api.twilio.com/2010-04-01/Accounts/$ACCOUNT_SID/Calls.json"</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">Url</span> <span class="operator">=></span> <span class="symbol">$url</span><span class="operator">,</span><br /> <span class="word">To</span> <span class="operator">=></span> <span class="symbol">$TO</span><span class="operator">,</span><br /> <span class="word">From</span> <span class="operator">=></span> <span class="symbol">$FROM</span><span class="operator">,</span><br /> <span class="structure">}</span><br /><span class="structure">);</span></code></pre>
<h3 id="Installing-the-utilities-on-the-remote-server">Installing the utilities on the remote server.</h3>
<p>Now I have these handy notification tools, how do I ship the scripts to the boxes I want to use them on? Ideally I'd use some sort of version control system like git, but not all the boxes have that installed. They all do have Perl however, so how can we leverage that to do our installation in pain free way?</p>
<p>First I need to run some code locally to package up my scripts into one single installer script:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><br /><span class="keyword">use</span> <span class="float">5.012</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">@filenames</span> <span class="operator">=</span> <span class="words">qw(<br /> emailnotify<br /> slacknotify<br /> phonenotify<br />)</span><span class="structure">;</span><br /><br /><span class="word">print</span> <span class="heredoc"><<'ENDOFHEADER'</span><span class="structure">;</span><br /><span class="heredoc_content">use autodie;<br />chdir($ENV{HOME});<br />mkdir("bin") unless -d "bin";<br />chdir("bin");<br /></span><span class="heredoc_terminator">ENDOFHEADER<br /></span><br /><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$filename</span> <span class="structure">(</span><span class="symbol">@filenames</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">say</span> <span class="double">"{"</span><span class="structure">;</span><br /> <span class="word">say</span> <span class="literal">q!open my $fh, ">", "!</span><span class="operator">.</span><span class="symbol">$filename</span><span class="operator">.</span><span class="single">'";'</span><span class="structure">;</span><br /> <span class="word">say</span> <span class="literal">q!print $fh <<'ENDOFSCRIPT';!</span><span class="structure">;</span><br /> <span class="word">open</span> <span class="word">my</span> <span class="symbol">$fh</span><span class="operator">,</span> <span class="double">"<"</span><span class="operator">,</span> <span class="symbol">$filename</span><span class="structure">;</span><br /> <span class="keyword">while</span> <span class="structure">(</span><span class="readline"><$fh></span><span class="structure">)</span> <span class="structure">{</span> <span class="word">print</span> <span class="structure">}</span><br /> <span class="word">say</span> <span class="double">""</span><span class="structure">;</span><br /> <span class="word">say</span> <span class="literal">q!ENDOFSCRIPT!</span><span class="structure">;</span><br /> <span class="word">say</span> <span class="interpolate">qq!chmod(0775,"$filename");!</span><span class="structure">;</span> <br /> <span class="word">say</span> <span class="double">"}"</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>The output of this script itself is a Perl script, one that I can store on a secret gist from gist.github.com, and access again using the raw URL link from anywhere that is connected to the Internet.</p>
<p>So, on any server I want to install my commands on now I can issue a simple curl command to download and immediately execute the Perl script from its secret location.</p>
<pre><code> bash$ curl https://gist.githubusercontent.com/2shortplanks/<redacted>/gistfile1.txt | perl</code></pre>
<p>The downloaded Perl script reconstitutes the original scripts that were found on my local machine on the remote server that's executing the command.</p>
<h3 id="Always-on">Always on</h3>
<p>So, now computers all over the Internet can reach me day or night. If you'll excuse me, I'm just off to shop online for some earplugs...</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/HTTP::Tiny">HTTP::Tiny</a></p>
</li>
<li><p><a href="JSON:PP">JSON:PP</a></p>
</li>
<li><p><a href="https://mandrillapp.com/api/docs/messages.JSON.html">https://mandrillapp.com/api/docs/messages.JSON.html</a></p>
</li>
<li><p><a href="http://slack.com/">http://slack.com/</a></p>
</li>
<li><p><a href="https://www.twilio.com/docs/api/rest/making-calls">https://www.twilio.com/docs/api/rest/making-calls</a></p>
</li>
</ul>
</div>2014-12-03T00:00:00ZMark FowlerMaking a list, checking it twice...http://perladvent.org/2014/2014-12-02.html<div class='pod'><p>Christmas is coming. There aren't many shopping days left, and it's time to get organized when it comes to gift buying!</p>
<p>This year I decided I wanted to create an on-disk database of all the present ideas that I had for people. It's nothing more than a single table database schema that looks like this:</p>
<pre><code class="code-listing"><span class="synStatement">CREATE</span> <span class="synSpecial">TABLE</span> gifts (<br /> name TEXT,<br /> recipient TEXT,<br /> url TEXT,<br /> price_in_cents <span class="synType">INTEGER</span><br />);</code></pre>
<p>Turning this SQL into a working database is a one liner involving the sqlite3 command line utility that <code>sqlite3</code> that ships with OS X.</p>
<pre><code> bash$ sqlite3 xmas.db < xmas.sql</code></pre>
<p>This creates a simple file based sqlite3 database which has more that sufficient performance for my usage, doesn't require installing any long running daemons (like say PostgreSQL or MySQL do), and can be talked to easily to Perl from DBI via the DBD::SQLite module.</p>
<h3 id="Building-the-Perl-ORM">Building the Perl ORM</h3>
<p>Okay, now we need to be able to talk to it from Perl. While talking via DBI is easy, using a object relational mapper like DBIx::Class allows us to skip the SQL writing entirely.</p>
<p>First we need to write a bunch of Perl classes that handle the mapping. Or rather, we can use the <code>dbicdump</code> command line utility that ships with DBIx::Class::Schema::Loader to do it all for us:</p>
<pre><code> bash$ dbicdump -o dump_directory=lib XmasList dbi:SQLite:xmas.db</code></pre>
<p>The <code>dbicdump</code> command inspects the database and writes out a bunch of files for us:</p>
<pre><code> bash$ find lib
lib
lib/XmasList
lib/XmasList/Result
lib/XmasList/Result/Gift.pm
lib/XmasList.pm</code></pre>
<p>Now we can easily write a script to put things in the database without having to write any SQL:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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">lib</span> <span class="words">qw(lib)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">XmasList</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$schema</span> <span class="operator">=</span> <span class="word">XmasList</span><span class="operator">-></span><span class="word">connect</span><span class="structure">(</span><span class="double">"dbi:SQLite:xmas.db"</span><span class="structure">);</span><br /><br /><span class="symbol">$schema</span><span class="operator">-></span><span class="word">resultset</span><span class="structure">(</span><span class="single">'Gift'</span><span class="structure">)</span><span class="operator">-></span><span class="word">create</span><span class="structure">({</span><br /> <span class="word">name</span> <span class="operator">=></span> <span class="double">"Donation to the Perl 5 Core Maintenance Fund"</span><span class="operator">,</span><br /> <span class="word">url</span> <span class="operator">=></span> <span class="double">"http://www.perlfoundation.org/perl_5_core_maintenance_fund"</span><span class="operator">,</span><br /> <span class="word">price_in_cents</span> <span class="operator">=></span> <span class="number">100_00</span><span class="operator">,</span><br /> <span class="word">recipient</span> <span class="operator">=></span> <span class="double">"Leon"</span><span class="operator">,</span><br /><span class="structure">});</span></code></pre>
<h3 id="Populating-Directly-From-Safari">Populating Directly From Safari</h3>
<p>Of course, writing Perl code to insert stuff into my database is still too much work for the lazy programmer that I am. What I really want is the ability to take what I'm directly looking at in my web browser and put it into the database at the click of a button.</p>
<p>Actually, it so happens I can easily write a chunk of JavaScript to work out these details for me. For example, here's a snippet of JavaScript that creates an object with those details for any listing on Etsy.</p>
<pre><code class="code-listing"><span class="synIdentifier">{</span><br /> <span class="synConstant">"name"</span> : $(<span class="synConstant">"h1"</span>).text(),<br /> <span class="synConstant">"price_in_cents"</span> : parseFloat( $(<span class="synConstant">"#listing-price .currency-value"</span>).text() ) * 100,<br /> <span class="synConstant">"recipient"</span> : <span class="synStatement">window</span>.<span class="synStatement">prompt</span>(<span class="synConstant">"Who is this for?"</span>),<br /> <span class="synConstant">"url"</span> : <span class="synStatement">document</span>.<span class="synStatement">location</span>.href<br /><span class="synIdentifier">}</span>;</code></pre>
<p>What I need is a way to get this data from JavaScript into my database, ideally via Perl. There's a module for that:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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">lib</span> <span class="words">qw(lib)</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">XmasList</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Mac::Safari::JavaScript</span> <span class="words">qw(safari_js)</span><span class="structure">;</span><br /><br /><span class="comment"># run some JavaScript in Safari, and then put the results in a Perl variable<br /></span><span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="word">safari_js</span> <span class="heredoc"><<'END_OF_JAVASCRIPT'</span><span class="structure">;</span><br /><span class="heredoc_content"> return {<br /> "name" : $("h1").text(),<br /> "price_in_cents" : parseFloat( $("#listing-price .currency-value").text() ) * 100,<br /> "recipient" : window.prompt("Who is this for?"),<br /> "url" : document.location.href<br /> };<br /></span><span class="heredoc_terminator">END_OF_JAVASCRIPT<br /></span><br /><span class="comment"># put that data in the Database<br /></span><span class="keyword">my</span> <span class="symbol">$schema</span> <span class="operator">=</span> <span class="word">XmasList</span><span class="operator">-></span><span class="word">connect</span><span class="structure">(</span><span class="double">"dbi:SQLite:xmas.db"</span><span class="structure">);</span><br /><span class="symbol">$schema</span><span class="operator">-></span><span class="word">resultset</span><span class="structure">(</span><span class="single">'Gift'</span><span class="structure">)</span><span class="operator">-></span><span class="word">create</span><span class="structure">(</span><span class="cast">%</span><span class="structure">{</span> <span class="symbol">$data</span> <span class="structure">});</span></code></pre>
<p>This uses the fact that you can execute arbitary JavaScript in the current Safari window via AppleScript. Of course, this involves several layers of encoding and decoding (from Perl to AppleScript, then from AppleScript to JavaScript, then from JavaScript back to AppleScript and finally AppleScript back to Perl) and several steps so that errors properly propagate, which is the complexity the module handles for us.</p>
<p>While I can trigger the above script by executing it in the terminal, the really really lazy programmer in me just uses a third party application like KeyboardMaestro to trigger the script from a keyboard shortcut.</p>
<p>Okay, enough work. Let's go shopping!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Mac::Safari::JavaScript">Mac::Safari::JavaScript</a></p>
</li>
<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::Schema::Loader">DBIx::Class::Schema::Loader</a></p>
</li>
<li><p><a href="https://metacpan.org/module/dbicdump">dbicdump</a></p>
</li>
<li><p><a href="http://www.keyboardmaestro.com/">http://www.keyboardmaestro.com/</a></p>
</li>
</ul>
</div>2014-12-02T00:00:00ZMark FowlerNo Room At The I.N.N.http://perladvent.org/2014/2014-12-01.html<div class='pod'><p>"INN's DOWN!"</p>
<p>It was not the cry that Joseph wanted to hear from the developers' cubicals. I.N.N. (Integration Now & Nightly) was the continuous integration server at Bethlehem LLC - responsible for testing the Perl code needed for their tax auditing application. If Joseph didn't get the system up and running soon, they were going to miss their deadline.</p>
<p>With a sigh, Joseph logged onto INN, and instantly he realized what the problem was. There was no room at the INN root filesystem.</p>
<p>Out of space on a CI server? How is that even possible? But wait, what was this, a directory for each test script run, each containing megabytes of verbose logs, test excel spreadsheets, and pngs of graphs.</p>
<p>Given that the tests were run hundreds of times a day...it was surprising that things hadn't got out of control before now.</p>
<h3 id="The-Problem-With-Temp-Dirs">The Problem With Temp Dirs</h3>
<p>Joseph couldn't blame the developer for having a temp directory. Often a test needs to write out a bunch of things during a test run. Just a few uses of temp directories in tests are:</p>
<dl>
<dt>Providing a place to put test-generated config files that must be created on a per-run basis</dt>
<dd>
</dd>
<dt>A place you can store files your module produces in order to re-read them back in and check they were created properly (or have them hanging around after the test run to poke at if things go wrong)</dt>
<dd>
</dd>
<dt>A place to write copious logs and any other data that might help you work out what caused your test to fail</dt>
<dd>
</dd>
</dl>
<p>All in all very useful. But how should the developers code a temp directory in order not to ruin Joseph's afternoon?</p>
<p>A naive approach might be something along the lines of:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Test::More</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">File::Temp</span> <span class="words">qw( tempdir )</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dir</span> <span class="operator">=</span> <span class="word">tempdir</span><span class="structure">();</span><br /><span class="word">note</span> <span class="double">"Tempdir is $dir"</span><span class="structure">;</span><br /><br /><span class="operator">...</span></code></pre>
<p>The problem with this is that a new temp dir is created for each and every run of the test suite. And poor old Joseph found out the hard way that this means on a server that runs the test a lot of times that disk space can be exhausted if the test produces many megabytes of logs or output data.</p>
<p>One simple solution would be to have the test automatically tidy up after itself. This is a trivial change:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Test::More</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">File::Temp</span> <span class="words">qw( tempdir )</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dir</span> <span class="operator">=</span> <span class="word">tempdir</span><span class="structure">(</span> <span class="word">CLEANUP</span> <span class="operator">=></span> <span class="number">1</span> <span class="structure">);</span><br /><span class="word">note</span> <span class="double">"Tempdir is $dir"</span><span class="structure">;</span><br /><br /><span class="operator">...</span></code></pre>
<p>The <code>CLEANUP => 1</code> causes the test directory to automatically be deleted when the program exits. Of course, the problem is that this happens as soon as the program exits even if the tests fail. You can't go dig through logs for why a failure happened if the directory where the logs have been written to has just been deleted!</p>
<p>Both 'solutions' also suffer from the problem that a different path is created each time the script runs, which can be very tedious to work with when you're trying to repeatedly get a test script to run and have to copy and paste the name of the directory your logs are in this run from the diagnostic output.</p>
<h3 id="Test::TempDir::Tiny-to-the-rescue">Test::TempDir::Tiny to the rescue</h3>
<p>Test::TempDir::Tiny isn't any more complicated to use than File::Temp:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></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="word">Test::More</span> <span class="word">tests</span> <span class="operator">=></span> <span class="number">1</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Test::TempDir::Tiny</span> <span class="words">qw( tempdir )</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dir</span> <span class="operator">=</span> <span class="word">tempdir</span><span class="structure">();</span><br /><span class="word">note</span> <span class="double">"Tempdir is $dir"</span><span class="structure">;</span><br /><br /><span class="operator">...</span></code></pre>
<p>But now the location of the tests is always the same. For the test <code>t/mary/babyj.t</code> the first tempdir created with <code>tempdir</code> will be created at <code>tmp/t_mary_babyj_t/default_1</code>.</p>
<pre><code> bash$ perl t/mary/babyj.t
1..1
# Tempdir is /home/ci/build/tmp/t_mary_babyj_t/default_1
not ok 1 - onto this day a child process is forked
# Failed test 'onto this day a child process is forked'
# at t/mary/babyj.t line 11.
# Looks like you failed 1 test of 1.</code></pre>
<p>Each time time the script executes the test directory is cleared out automatically. Now we only have one copy of the script output on the server!</p>
<p>But even better, see what happens when the tests in the scripts pass:</p>
<pre><code> bash$ perl t/mary/babyj.t
1..1
# Tempdir is /home/ci/build/tmp/t_mary_babyj_t/default_1
ok 1 - onto this day a child process is forked
bash$ ls /home/ci/build/tmp/t_mary_babyj_t/default_1
ls: /home/ci/build/tmp/t_mary_babyj_t: No such file or directory</code></pre>
<p>The temp directory is removed! If no other test script temp directories remain in <code>tmp</code> that directory is removed too:</p>
<pre><code> bash$ ls /home/ci/build/tmp
ls: /home/ci/build/tmp: No such file or directory</code></pre>
<p>This means on a successful run the server is left in a "clean" state. Awesome.</p>
<h3 id="Stuck-in-the-stable">Stuck in the stable</h3>
<p>Joseph sent an email to the developers to tell them to switch to Test::TempDir::Tiny while he cleaned up INN. Until there was room on INN the code would be stuck in whatever had been promoted to the stable branch.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Test::TempDir::Tiny">Test::TempDir::Tiny</a></p>
</li>
<li><p><a href="https://metacpan.org/module/File::Temp">File::Temp</a></p>
</li>
</ul>
</div>2014-12-01T00:00:00ZMark Fowler