Perl Advent Calendar 2020http://perladvent.org/2020/2024-03-13T21:03:17ZMark FowlerXML::Atom::SimpleFeedUntil then, we'll have to muddle through somehowhttp://perladvent.org/2020/2020-12-25.html<div class='pod'><p><img src="judy.jpeg">
</p>
<p>In the immortal words of Judy Garland:</p>
<p><i> <p> Have yourself a merry little Christmas<br> Let your heart be light<br> Next year all our troubles will be out of sight </p> <p> Have yourself a merry little Christmas<br> Make the yuletide gay<br> Next year all our troubles will be miles away </p> <p> Once again as in olden days<br> Happy golden days of yore<br> Faithful friends who were near to us<br> Will be dear to us once more </p> <p> Someday soon we all will be together<br> If the fates allow<br> Until then, we'll have to muddle through somehow<br> So have yourself a merry little Christmas now </p> </i>
</p>
<p>There's been so much awesomeness in the Perl community over the past year that I'd like to thank each and every one involved for making the best of things. For example, I really enjoyed <a href="https://perlconference.us/tpc-2020-cloud/">Conference In The Cloud</a>. Despite not being able to see my friends and members of the community in person, I got to speak at a conference without the usual hassle of flying and being away from my family.</p>
<p>Thank you one and all.</p>
<p>So until next year, or <i>Someday soon when we will all be together</i> I wish you the very happiest of Christmas.</p>
</div>2020-12-25T00:00:00ZMark FowlerChoices, choices, so many choices!http://perladvent.org/2020/2020-12-24.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Every day we have to tell our computers about the hundreds of choices we make each day. Yes, I'd like to get the blue scarf, not the green one. Change into this directory not that one. Please force push those changes all over that branch. Yes, of course I'm sure!</p>
<p>Being the command line geeks we are, most of the time this comes in the form of passing arguments to command line programs. Passing option flags. Setting environment variables before we run the script. All of these things are awesome. We can script them. There's command history. We can use command line tab completion (if we've setup bash or zsh just right.)</p>
<p>But sometimes this can get complex. Maybe as users we don't (or can't) know what all the options are without starting to run the script. Maybe we need to be presented with more choices depending on some of the choices we've already made. Maybe the program needs to ask the user something after it's done something with a remote server, and there was no way to predict what questions it needed to have the answer for when the program was originally run. Or maybe we just want something more user friendly than forcing the user to look up in the man page what options they need to pass.</p>
<p>In these situations we tend to build an interactive GUI app or a web app. However, both of these are much harder to do than writing a program that parses simple command line options - there's event loops to consider, callbacks, possibly listening on various ports. Maybe there's a better, er, <i>choice</i>.</p>
<h3 id="Introducing-Term::Choose">Introducing Term::Choose</h3>
<p><a href="https://metacpan.org/module/Term::Choose">Term::Choose</a> is a module that allows us to interactively pick from the terminal from several options. It's <i>really</i> simple to use:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Term::Choose</span> <span class="words">qw( choose )</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$reindeer</span> <span class="operator">=</span> <span class="word">choose</span><span class="structure">([</span><span class="words">qw(<br /> Ruldolph<br /> Dasher Dancer Prancer Vixen<br /> Comet Cupid Dunder Blixem<br />)</span><span class="structure">]</span><span class="operator">,</span> <span class="structure">{</span> <span class="word">prompt</span> <span class="operator">=></span> <span class="single">'Who is your favourite reindeer?'</span> <span class="structure">})</span> <span class="operator">or</span> <span class="word">exit</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"Cool I like $reindeer too!"</span><span class="structure">;</span></code></pre>
<p><img src="chooser.gif" width="678" height="177" alt="Terminal demo">
</p>
<p>The user simply moves the selection around with the cursor keys and hits <code>RETURN</code> to pick one. Easy!</p>
<p>Coding this is considerably more simple than developing a GUI or web app, and because it's running on a terminal you can make use of it anywhere - even on a remote server you're connected to over ssh without the overhead and the complexity of doing something tricky with an X-server.</p>
<p>Note also that Term::Choose is a good terminal citizen. It cleans up after itself, removing the interactive prompt from the screen.</p>
<h3 id="More-options-than-fit-on-the-screen">More options than fit on the screen</h3>
<p>If you have more options than fit on the screen then the screen scrolls when you move down past the last option:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Term::Choose</span> <span class="words">qw( choose )</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$film</span> <span class="operator">=</span> <span class="word">choose</span><span class="structure">(</span><br /> <span class="cast">\</span><span class="symbol">@films</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">prompt</span> <span class="operator">=></span> <span class="single">'What Christmas movie shall I rent?'</span> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">)</span> <span class="operator">or</span> <span class="word">exit</span><span class="structure">;</span><br /><span class="word">say</span> <span class="double">"Renting $film"</span><span class="structure">;</span></code></pre>
<p><img src="choosef.gif" width="678" height="177" alt="Terminal demo">
</p>
<p>Neat! You really don't have to think about it.</p>
<h3 id="Picking-More-Than-One-Option">Picking More Than One Option</h3>
<p>If you use the <code>choose</code> function in list context you can pick more than one option. Just hitting <code>RETURN</code> works as before, picking just the one option. However, hitting <code>SPACE</code> selects multiple options, and then <code>RETURN</code> submits them all.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Term::Choose</span> <span class="words">qw( choose )</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">@options</span> <span class="operator">=</span> <span class="word">choose</span><span class="structure">([</span><br /> <span class="single">'with wrapping paper'</span><span class="operator">,</span><br /> <span class="single">'with a bow on it'</span><span class="operator">,</span><br /> <span class="single">'with ribbons'</span><span class="operator">,</span><br /> <span class="single">'with a gift tag'</span><span class="operator">,</span><br /><span class="structure">]</span><span class="operator">,</span> <span class="structure">{</span> <span class="word">prompt</span> <span class="operator">=></span> <span class="single">'How should I wrap up the present?'</span> <span class="structure">});</span><br /><span class="word">say</span> <span class="double">"Wrapping up the present with $_"</span> <span class="word">for</span> <span class="symbol">@options</span><span class="structure">;</span></code></pre>
<p><img src="choosew.gif" width="678" height="177" alt="Terminal demo">
</p>
<h3 id="The-Right-Choice">The Right Choice</h3>
<p>Like all my favourite Perl modules, Term::Choose is powerful but simple to use. It does one thing, and does it well. It's the right choice.</p>
</div>2020-12-24T00:00:00ZMark FowlerProc::Daemonhttp://perladvent.org/2020/2020-12-23.html<div class='pod'><p>Sometimes we want to run a script forever. We want it to monitor what's going on, or perform some action periodically, and we don't want it to go away when we log out.</p>
<p><b>Proc::Daemon</b> is a handy little utility class that can handle all the complicated operating system related tasks that are involved in making the script completely fork into the background. With one simple command your script will can be detached from the terminal login session you're using. Along with <b>Proc::PID::File</b> you can manage background tasks with the smallest amount of effort.</p>
<p>One of the more common ways of tackling spam is to is maintaining a whitelist of addresses of people you trust that you're willing to always accept mail from (or at the very least, trust <i>more</i> than other addresses) and blacklists of people we don't ever want to hear from again.</p>
<p>The hard thing about maintaining the whitelist and blacklist is providing a mechanism for updating the lists. The solution I came up with was a special mailbox on my mailserver that if I put a message in it would be added to the correct list and then moved back into my inbox or spam folder. This means I'm able to update my whitelist/blacklists using any of the mail clients I normally use (Apple Mail, pine and Squirrel Mail) over IMAP without any problem.</p>
<p>The script that runs on the server that updates the blacklist is fairly simple. I keep my mail in maildir format meaning that any mail I've put for blacklisting will be in the <code>.blacklist</code> folder. Let's start by writing the part of the script that finds that file:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><br /><span class="comment"># turn on my message<br /></span><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><br /><span class="comment"># load my collection of modules<br /></span><span class="keyword">use</span> <span class="word">File::Copy</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">File::Find::Rule</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Email::Simple</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Email::Address</span><span class="structure">;</span><br /><br /><span class="comment"># find all messages in the blacklist folder<br /></span><span class="keyword">my</span> <span class="symbol">@files</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="word">File::Find::Rule</span><br /> <span class="operator">-></span><span class="word">file</span><br /> <span class="operator">-></span><span class="word">in</span><span class="structure">(</span><span class="double">"/home/mark/Maildir/.blacklist/cur"</span><span class="structure">)</span><span class="operator">,</span><br /> <span class="word">File::Find::Rule</span><br /> <span class="operator">-></span><span class="word">file</span><br /> <span class="operator">-></span><span class="word">in</span><span class="structure">(</span><span class="double">"/home/mark/Maildir/.blacklist/new"</span><span class="structure">)</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="comment"># stop here unless we found any mails<br /></span><span class="word">exit</span> <span class="word">unless</span> <span class="symbol">@files</span><span class="structure">;</span></code></pre>
<p>We then need to open the blacklist file for appending - we're hopefully going to add some addresses to the end.</p>
<pre><code class="code-listing"><span class="comment"># open the file we're updating<br /></span><span class="word">open</span> <span class="word">my</span> <span class="symbol">$list_fh</span><span class="operator">,</span><span class="double">">>"</span><span class="operator">,</span> <span class="double">"/home/mark/.my_blacklist"</span><br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"Can't open the blacklist: $!"</span><span class="structure">;</span></code></pre>
<p>And then start a loop that works though each of the files we found and loads them one by one into memory, works out what the from address was, and prints it out to <code>$list_fh</code>.</p>
<pre><code class="code-listing"><span class="comment"># read in each of the messages<br /></span><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="structure">(</span><span class="symbol">@files</span><span class="structure">)</span><br /><span class="structure">{</span><br /> <span class="word">print</span> <span class="double">"Looking at '$file'\n"</span><span class="structure">;</span><br /><br /><span class="comment"> # read in the file<br /></span> <span class="word">open</span> <span class="word">my</span> <span class="symbol">$in_fh</span><span class="operator">,</span><span class="double">"&lt;"</span><span class="operator">,</span> <span class="symbol">$file</span><br /> <span class="operator">or</span> <span class="word">next</span><span class="structure">;</span> <span class="comment"># can't read it? Skip it</span><br /> <span class="keyword">my</span> <span class="symbol">$message_text</span> <span class="operator">=</span> <span class="word">join</span> <span class="single">''</span><span class="operator">,</span> <span class="symbol">&lt</span><span class="structure">;</span><span class="symbol">$in_fh</span><span class="operator">></span><span class="structure">;</span><br /> <span class="word">close</span> <span class="symbol">$in_fh</span><span class="structure">;</span><br /><br /><span class="comment"> # make it an email simple object<br /></span> <span class="keyword">my</span> <span class="symbol">$email</span> <span class="operator">=</span> <span class="word">Email::Simple</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="symbol">$message_text</span><span class="structure">);</span><br /><br /><span class="comment"> # get the email addresses and store them in the blacklist<br /></span> <span class="word">eval</span><br /> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$header</span> <span class="operator">=</span> <span class="symbol">$email</span><span class="operator">-></span><span class="word">header</span><span class="structure">(</span><span class="double">"From"</span><span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"No From"</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">@address</span> <span class="operator">=</span> <span class="word">Email::Address</span><span class="operator">-></span><span class="word">parse</span><span class="structure">(</span><span class="symbol">$header</span><span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"No addresses parsed"</span><span class="structure">;</span><br /> <span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$address</span> <span class="structure">(</span><span class="symbol">@address</span><span class="structure">)</span><br /> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$from</span> <span class="operator">=</span> <span class="symbol">$address</span><span class="operator">-></span><span class="word">address</span><br /> <span class="operator">or</span> <span class="word">next</span><span class="structure">;</span><br /> <span class="word">print</span> <span class="double">"...Found address '$from'\n"</span><span class="structure">;</span><br /> <span class="word">print</span> <span class="symbol">$list_fh</span> <span class="double">"$from\n"</span><span class="structure">;</span><br /> <span class="structure">}</span><br /><br /><span class="comment"> # move the mail to my spambox<br /></span> <span class="word">move</span><span class="structure">(</span><span class="symbol">$file</span><span class="operator">,</span> <span class="double">"/home/mark/Maildir/.spam.blacklisted/cur"</span><span class="structure">);</span><br /><br /> <span class="structure">};</span> <span class="comment"># ignore all errors</span><br /><span class="structure">}</span></code></pre>
<h3 id="Running-The-Script-Forever">Running The Script Forever</h3>
<p>Making this script run forever is pretty simple...we just need to wrap the whole code in a while loop with a sleep command so that it waits five seconds between runs and doesn't overload the server:</p>
<pre><code class="code-listing"><span class="comment"># run forever<br /></span><span class="keyword">while</span> <span class="structure">(</span><span class="number">1</span><span class="structure">)</span><br /><span class="structure">{</span><br /> <span class="word">sleep</span><span class="structure">(</span><span class="number">5</span><span class="structure">);</span><br /> <span class="word">eval</span><br /> <span class="structure">{</span><br /> <span class="operator">...</span><span class="word">rest</span> <span class="word">of</span> <span class="word">code</span> <span class="word">from</span> <span class="word">the</span> <span class="word">script</span><span class="operator">...</span><br /> <span class="structure">};</span><br /><span class="structure">}</span></code></pre>
<p>Note the use of <code>eval</code> so that if we get die from any errors then the whole run isn't aborted - we just wait five seconds and try again. Along these lines we also need to change the script to not exit if there are new mails and rather go back to waiting again. Changing:</p>
<pre><code class="code-listing"><span class="comment"># stop here unless we found any mails<br /></span><span class="word">exit</span> <span class="word">unless</span> <span class="symbol">@files</span><span class="structure">;</span></code></pre>
<p>To:</p>
<pre><code class="code-listing"><span class="comment"># stop here unless we found any mails<br /></span><span class="word">die</span> <span class="double">"not this time"</span> <span class="word">unless</span> <span class="symbol">@files</span><span class="structure">;</span></code></pre>
<p>causes it to skip to the end of the loop and start the next sleep.</p>
<h3 id="Running-The-Script-In-The-Background">Running The Script In The Background</h3>
<p>If we run the script from the shell then this runs forever</p>
<pre><code> bash$ perl blacklist.pl &</code></pre>
<p>Well...at least until we log out and close the shell.</p>
<pre><code class="code-listing"><span class="word">bash</span><span class="cast">$</span> <span class="word">exit</span><br /><span class="structure">[</span><span class="number">1</span><span class="structure">]</span><span class="operator">+</span> <span class="word">Done</span> <span class="word">perl</span> <span class="word">blacklist</span><span class="operator">.</span><span class="word">pl</span><br /><span class="word">Connection</span> <span class="word">to</span> <span class="word">perladvent</span><span class="operator">.</span><span class="word">org</span> <span class="word">closed</span><span class="operator">.</span><br /><span class="word">bash</span><span class="cast">$</span> </code></pre>
<p>At which point the script is killed because it's parent is killed. What we need to do is reparent the process to a higher process (normally <code>init</code>) and free up all other resources it's using (like closing STDIN, STDOUT and STDERR and moving to another directory) This is actually quite complicated to get right. Luckily, <b>Proc::Daemon</b> does all this for us. We simply just have to insert at the top of the script the code:</p>
<pre><code class="code-listing"><span class="comment"># make this run in the background.<br /></span><span class="keyword">use</span> <span class="word">Proc::Daemon</span><span class="structure">;</span><br /><span class="word">Proc::Daemon::Init</span><span class="structure">;</span></code></pre>
<p>And magically it'll all fork into the background for us. And that's all there is to it! Told you this was easy.</p>
<h3 id="Controlling-The-Forked-Process">Controlling The Forked Process</h3>
<p>It's be nice if we could control the forked process, to tell it to stop running when we want for example. This is actually quite complicated. Let's walk though what needs to be done.</p>
<p>Firstly, we need to keep track of if the process is running or not, and what process it's running as. To do this we use a <i>PID file</i>, a file that is stored somewhere on disk that has simply the process id of the process that's running. To do this we use <b>Proc::PID::File</b>. This module has one routine that we want to use:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Proc::PID::File</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$pid</span> <span class="operator">=</span> <span class="word">Proc::PID::File</span><span class="operator">-></span><span class="word">running</span><span class="structure">(</span><span class="word">name</span> <span class="operator">=></span> <span class="double">"foo"</span><span class="structure">);</span></code></pre>
<p>The <code>running</code> routine returns the pid contained in the file if one existed (i.e. another process is already running) or returns <code>undef</code> if one wasn't and writes to the file with the current pid of the process we're currently using. Crucially, when the current process exits it deletes the pid file.</p>
<p>We can start to adapt the script like so:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><br /><span class="comment"># turn on the safety features<br /></span><br /><span class="keyword">use</span> <span class="word">Proc::Daemon</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Proc::PID::File</span><span class="structure">;</span><br /><br /><span class="comment"># did we get a stop command?<br /></span><span class="keyword">if</span> <span class="structure">(</span><span class="symbol">@ARGV</span> <span class="operator">&&</span> <span class="symbol">$ARGV</span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span> <span class="operator">eq</span> <span class="double">"stop"</span><span class="structure">)</span><br /><span class="structure">{</span><br /><span class="comment"> # we need to send a signal to the running process to tell it<br /> # to quit<br /></span><br /><span class="comment"> # get the pid file (in /var/run by default)<br /></span> <span class="keyword">my</span> <span class="symbol">$pid</span> <span class="operator">=</span> <span class="word">Proc::PID::File</span><span class="operator">-></span><span class="word">running</span><span class="structure">(</span><span class="word">name</span> <span class="operator">=></span> <span class="double">"blacklist"</span><span class="structure">);</span><br /> <span class="keyword">unless</span> <span class="structure">(</span><span class="symbol">$pid</span><span class="structure">)</span><br /> <span class="structure">{</span> <span class="word">die</span> <span class="double">"Not already running!"</span> <span class="structure">}</span><br /><br /><span class="comment"> # and send a signal to that process<br /></span> <span class="word">kill</span><span class="structure">(</span><span class="number">2</span><span class="operator">,</span><span class="symbol">$pid</span><span class="structure">);</span> <span class="comment"># you may need a different signal for your system</span><br /> <span class="word">print</span> <span class="double">"Stop signal sent!\n"</span><span class="structure">;</span><br /> <span class="word">exit</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="comment"># fork into the background<br /># do this first because our process id will change<br /></span><span class="word">Proc::Daemon::Init</span><span class="structure">;</span><br /><br /><span class="comment"># write the pid file, exiting if there's one there already.<br /># this pid file will automatically be deleted when this script<br /># exits.<br /></span><span class="keyword">if</span> <span class="structure">(</span><span class="word">Proc::PID::File</span><span class="operator">-></span><span class="word">running</span><span class="structure">(</span><span class="word">name</span> <span class="operator">=></span> <span class="double">"blacklist"</span><span class="structure">))</span><br /> <span class="structure">{</span> <span class="word">die</span> <span class="double">"Already running!"</span> <span class="structure">}</span></code></pre>
<p>The second problem that remains is that we're killing the process straight out without giving it a chance to do anything else. This isn't a good idea - it might be in the middle of something important like processing a mail and removing it might cause corruption. What we need to do is add a signal handler which catches the kill signal and logs that it's been received and then when it's safe to exit it'll check the flag and exit then . At the top of the file we add:</p>
<pre><code class="code-listing"><span class="comment"># when we get a INT signal, set the exit flag<br /></span><span class="symbol">$SIG</span><span class="structure">{</span><span class="word">INT</span><span class="structure">}</span> <span class="operator">=</span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="symbol">$::exit</span> <span class="operator">=</span> <span class="number">1</span> <span class="structure">}</span></code></pre>
<p>Then in our while loop we write:</p>
<pre><code class="code-listing"><span class="keyword">while</span> <span class="structure">(</span><span class="number">1</span><span class="structure">)</span><br /><span class="structure">{</span><br /> <span class="word">exit</span> <span class="word">if</span> <span class="symbol">$::exit</span><span class="structure">;</span><br /> <span class="word">sleep</span><span class="structure">(</span><span class="number">5</span><span class="structure">);</span><br /> <span class="word">exit</span> <span class="word">if</span> <span class="symbol">$::exit</span><span class="structure">;</span><br /> <span class="operator">...</span><br /><span class="structure">}</span></code></pre>
</div>2020-12-23T00:00:00ZMark FowlerPlaying it safe with Safe::Isahttp://perladvent.org/2020/2020-12-22.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Earlier this year in Manhattan, a garage worker drove an Audi into an open car elevator shaft. The car fell three floors and the worker escaped through the sun roof.</p>
<p>Every year I see stories of people falling in elevator shafts — sometimes dying — when the elevator they are expecting to be there suddenly isn't.</p>
<p>But what do elevator shafts have to do with Perl?</p>
<p>There is a common idiom for checking an object's class that is remarkably like stepping through an elevator door without checking that the elevator is there:</p>
<pre><code class="code-listing"><span class="keyword">if</span> <span class="structure">(</span> <span class="symbol">$thing</span><span class="operator">-></span><span class="word">isa</span><span class="structure">(</span> <span class="double">"Class::I'm::Looking::For"</span> <span class="structure">)</span> <span class="structure">}</span> <span class="structure">{</span><br /><span class="comment"> # do something with $thing<br /></span><span class="structure">}</span></code></pre>
<p>If <code>$thing</code> is an unblessed reference, you've just fallen down the elevator shaft and gotten a fatal error.</p>
<p>If <code>$thing</code> is a scalar, then it's treated like a class name. That might be what you want, but if you really wanted <i>an object</i>, then you're in trouble if you call any object methods on it.</p>
<p>Usually, the <code>isa</code> method comes from the <a href="https://metacpan.org/module/UNIVERSAL">UNIVERSAL</a> class, so maybe you thought (or were taught) to call it as a function:</p>
<pre><code class="code-listing"><span class="keyword">if</span> <span class="structure">(</span> <span class="word">UNIVERSAL::isa</span><span class="structure">(</span> <span class="symbol">$thing</span><span class="operator">,</span> <span class="double">"Class::I'm::Looking::For"</span> <span class="structure">)</span> <span class="structure">}</span> <span class="structure">{</span><br /><span class="comment"> # do something with $thing<br /></span><span class="structure">}</span></code></pre>
<p>That is wrong, too, because <code>isa</code> is supposed to be a <i>method</i>, and you've just skipped the entire <code>@ISA</code> hierarchy. If any class defined its own <code>isa</code> method, you'll get a different answer than what you should. (A <a href="https://en.wikipedia.org/wiki/Mock_object">mock object</a> used in testing might do that, for instance.)</p>
<p>You might have learned to check for an object first, with <a href="https://metacpan.org/module/Scalar::Util">Scalar::Util</a> and <code>blessed</code>:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Scalar::Util</span> <span class="single">'blessed'</span><span class="structure">;</span><br /><br /><span class="keyword">if</span> <span class="structure">(</span> <span class="word">blessed</span><span class="structure">(</span> <span class="symbol">$thing</span> <span class="structure">)</span> <span class="operator">&&</span> <span class="symbol">$thing</span><span class="operator">-></span><span class="word">isa</span><span class="structure">(</span> <span class="double">"Class::I'm::Looking::For"</span> <span class="structure">)</span> <span class="structure">}</span> <span class="structure">{</span><br /><span class="comment"> # do something with $thing<br /></span><span class="structure">}</span></code></pre>
<p>That is mostly correct (someone could have blessed an object into the class "0" for instance), but in any ordinary code, it will do what you want.</p>
<p>Unfortunately, that's a lot to write over and over, as you might if you're using some sort of exception object system like <a href="https://metacpan.org/module/Throwable">Throwable</a> or <a href="https://metacpan.org/module/failures">failures</a> or the venerable <a href="https://metacpan.org/module/Exception::Class">Exception::Class</a>.</p>
<p>For example, imagine you're using <a href="https://metacpan.org/module/failures">failures</a> and you've wrapped some possibly fatal code with <code>try</code> from <a href="https://metacpan.org/module/Try::Tiny">Try::Tiny</a> and you need to test the error to see if it's an object of various types or just a string.</p>
<p>Do you really want to type <code>blessed</code> in every conditional?</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">failures</span> <span class="words">qw/io::file io::network/</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Try::Tiny</span><span class="structure">;</span><br /><br /><span class="word">try</span> <span class="structure">{</span><br /> <span class="word">something_that_might_fail</span><span class="structure">()</span><br /><span class="structure">}</span><br /><span class="word">catch</span> <span class="structure">{</span><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="word">blessed</span><span class="structure">(</span><span class="magic">$_</span><span class="structure">)</span> <span class="operator">&&</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">isa</span><span class="structure">(</span><span class="double">"failure::io::file"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">elsif</span><span class="structure">(</span> <span class="word">blessed</span><span class="structure">(</span><span class="magic">$_</span><span class="structure">)</span> <span class="operator">&&</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">isa</span><span class="structure">(</span><span class="double">"failure::io"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">elsif</span><span class="structure">(</span> <span class="word">blessed</span><span class="structure">(</span><span class="magic">$_</span><span class="structure">)</span> <span class="operator">&&</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">isa</span><span class="structure">(</span><span class="double">"failure"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">else</span> <span class="structure">{</span> <span class="comment"># string or ref or other object exception</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p>Or wrap it all in another <code>if</code> just to test <code>blessed</code>?</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">failures</span> <span class="words">qw/io::file io::network/</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Try::Tiny</span><span class="structure">;</span><br /><br /><span class="word">try</span> <span class="structure">{</span><br /> <span class="word">something_that_might_fail</span><span class="structure">()</span><br /><span class="structure">}</span><br /><span class="word">catch</span> <span class="structure">{</span><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="word">blessed</span><span class="structure">(</span><span class="magic">$_</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">isa</span><span class="structure">(</span><span class="double">"failure::io::file"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">elsif</span><span class="structure">(</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">isa</span><span class="structure">(</span><span class="double">"failure::io"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">elsif</span><span class="structure">(</span> <span class="magic">$_</span><span class="operator">-></span><span class="symbol">$isa</span><span class="structure">(</span><span class="double">"failure"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">else</span> <span class="structure">{</span> <span class="comment"># other object</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="structure">}</span><br /> <span class="keyword">else</span> <span class="structure">{</span> <span class="comment"># string or ref exception</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p><a href="https://metacpan.org/module/Safe::Isa">Safe::Isa</a> makes this easier by exporting an <code>$_isa</code> variable containing a code reference that you can use in place of <code>UNIVERSAL::isa</code>. It checks <code>blessed</code> and <code>isa</code> for you, just the way you want:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Safe::Isa</span><span class="structure">;</span><br /><br /><span class="keyword">if</span> <span class="structure">(</span> <span class="symbol">$thing</span><span class="operator">-></span><span class="symbol">$_isa</span><span class="structure">(</span> <span class="double">"Class::I'm::Looking::For"</span> <span class="structure">)</span> <span class="structure">}</span> <span class="structure">{</span><br /><span class="comment"> # do something with $thing<br /></span><span class="structure">}</span></code></pre>
<p>This works because Perl treats a code reference on the right side of an arrow operator as a method to invoke. These are equivalent:</p>
<pre><code class="code-listing"><span class="symbol">$thing</span><span class="operator">-></span><span class="symbol">$_isa</span><span class="structure">(</span> <span class="double">"Class::I'm::Looking::For"</span> <span class="structure">)</span><br /><span class="symbol">$_isa</span><span class="operator">-></span><span class="structure">(</span> <span class="symbol">$thing</span><span class="operator">,</span> <span class="double">"Class::I'm::Looking::For"</span> <span class="structure">)</span></code></pre>
<p>That makes our earlier <code>failures</code> example a bit more concise:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">failures</span> <span class="words">qw/io::file io::network/</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Try::Tiny</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Safe::Isa</span><span class="structure">;</span> <span class="comment"># for $_isa</span><br /><br /><span class="word">try</span> <span class="structure">{</span><br /> <span class="word">something_that_might_fail</span><span class="structure">()</span><br /><span class="structure">}</span><br /><span class="word">catch</span> <span class="structure">{</span><br /> <span class="keyword">if</span> <span class="structure">(</span> <span class="magic">$_</span><span class="operator">-></span><span class="symbol">$_isa</span><span class="structure">(</span><span class="double">"failure::io::file"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">elsif</span><span class="structure">(</span> <span class="magic">$_</span><span class="operator">-></span><span class="symbol">$_isa</span><span class="structure">(</span><span class="double">"failure::io"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">elsif</span><span class="structure">(</span> <span class="magic">$_</span><span class="operator">-></span><span class="symbol">$_isa</span><span class="structure">(</span><span class="double">"failure"</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /> <span class="keyword">else</span> <span class="structure">{</span><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p><a href="https://metacpan.org/module/Safe::Isa">Safe::Isa</a> gives you several similar helpers, including <code>$_can</code>, <code>$_does</code>, and <code>$_DOES</code>, plus a generic <code>$_call_if_object</code> code reference that works like this:</p>
<pre><code class="code-listing"><span class="symbol">$thing</span><span class="operator">-></span><span class="symbol">$_call_if_object</span><span class="structure">(</span><span class="word">method_name</span> <span class="operator">=></span> <span class="symbol">@args</span><span class="structure">);</span></code></pre>
<p>The lesson is this: calling a method on something that you aren't sure is an object is like stepping into an elevator without checking that it's there. Most of the time, you're safe, right until you have a long fall and crash.</p>
<p>Using <a href="https://metacpan.org/module/Safe::Isa">Safe::Isa</a> gives you a safe, concise way to look before you step.</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Safe::Isa">Safe::Isa</a></p>
</li>
</ul>
</div>2020-12-22T00:00:00ZDavid GoldenGift Exchanges as a Practical Example of Cyclic Directional Graphshttp://perladvent.org/2020/2020-12-21.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Sometimes, graphs are huge, complex drawings showing the far-stretching relationships between myriads of elements.</p>
<p>Other times? We just feel the need to draw a few boxes and arrows to get a visual idea of what the heck is going on.</p>
<p>For those latter cases, <a href="https://metacpan.org/module/Graph::Easy">Graph::Easy</a> is your friend.</p>
<p><i>Graph::Easy</i> is a helping elf with no delusion of grandeur. It is primary meant for tackling modest graphs (think less than 100 nodes), but it does it with a simplicity and an ease of use that is very nice indeed.</p>
<p>For example, let's say you're managing a gift exchange. A simple one where you just have to decide who's giving to who, and what. Well, that's easy enough:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="version">5.16.0</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Graph::Easy</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">List::AllUtils</span> <span class="words">qw/ shuffle /</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@peeps</span> <span class="operator">=</span> <span class="word">shuffle</span> <span class="words">qw/<br /> alice bernard charlotte dee ezekiel <br /> felicia gregory heidi isaac julia karl <br /> leo marie nathan<br />/</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@gifts</span> <span class="operator">=</span> <span class="word">shuffle</span> <span class="words">qw/<br /> book CD slippers teddy bear bathrobe<br /> mittens scarf chocolate candles wine<br /> clock calendar mirror playing cards<br /> beanie<br />/</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$exchange</span> <span class="operator">=</span> <span class="word">Graph::Easy</span><span class="operator">-></span><span class="word">new</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">$i</span><span class="operator">,</span> <span class="symbol">$p</span> <span class="structure">)</span> <span class="operator">=</span> <span class="word">each</span> <span class="symbol">@peeps</span> <span class="structure">)</span> <span class="structure">{</span><br /><span class="comment"> # from, to, gift<br /></span> <span class="symbol">$exchange</span><span class="operator">-></span><span class="word">add_edge</span><span class="structure">(</span> <span class="symbol">$p</span><span class="operator">,</span> <span class="symbol">$peeps</span><span class="structure">[</span><span class="symbol">$i</span><span class="operator">-</span><span class="number">1</span><span class="structure">]</span><span class="operator">,</span> <span class="symbol">$gifts</span><span class="structure">[</span><span class="symbol">$i</span><span class="structure">]</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Our graph now contains all the information we want, and we can get it back in a variety of formats. We can get a human-friendly list of edges:</p>
<pre><code class="code-listing"><span class="word">print</span> <span class="symbol">$exchange</span><span class="operator">-></span><span class="word">as_txt</span><span class="structure">;</span></code></pre>
<p>which will output</p>
<pre><code> [ ezekiel ] -- wine --> [ heidi ]
[ heidi ] -- CD --> [ bernard ]
[ bernard ] -- slippers --> [ charlotte ]
[ charlotte ] -- playing --> [ leo ]
[ leo ] -- book --> [ karl ]
[ karl ] -- cards --> [ nathan ]
[ nathan ] -- chocolate --> [ felicia ]
[ felicia ] -- scarf --> [ marie ]
[ marie ] -- teddy --> [ gregory ]
[ gregory ] -- bear --> [ dee ]
[ dee ] -- beanie --> [ alice ]
[ alice ] -- mirror --> [ julia ]
[ julia ] -- bathrobe --> [ isaac ]
[ isaac ] -- clock --> [ ezekiel ]</code></pre>
<p>or we can get an ascii representation of the graph:</p>
<pre><code> print $exchange->as_ascii;</code></pre>
<p>which output</p>
<pre><code> chocolate
+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
v |
+-------+ beanie +---------+ candles +------+ book +---------+ teddy +---------+ cards +-------+ clock +-----------+ slippers +--------+ calendar +---------+ bear +-----+ mittens +-------+ playing +-----+ mirror +-------+ CD +-------+
| marie | --------> | gregory | ---------> | karl | ------> | ezekiel | -------> | felicia | -------> | isaac | -------> | charlotte | ----------> | nathan | ----------> | bernard | ------> | dee | ---------> | julia | ---------> | leo | --------> | alice | ----> | heidi |
+-------+ +---------+ +------+ +---------+ +---------+ +-------+ +-----------+ +--------+ +---------+ +-----+ +-------+ +-----+ +-------+ +-------+</code></pre>
<p>Granted, that format is useful for small graphes, but it get hard to grok for bigger ones. For those, there are better suited graphical output formats. Like <code>svg</code>, provided by <a href="https://metacpan.org/module/Graph::Easy::As_svg">Graph::Easy::As_svg</a> (which is not part of the core <i>Graph::Easy</i> distribution):</p>
<pre><code class="code-listing"><span class="word">print</span> <span class="symbol">$exchange</span><span class="operator">-></span><span class="word">as_svg</span><span class="structure">;</span></code></pre>
<p>which gives us the prettier</p>
<div style='overflow:scroll'>
<svg width="2456.312" height="165.56" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<!-- Generated at Sun Dec 1 14:49:55 2013 by:
Graph::Easy v0.73
Graph::Easy::As_svg v0.23
-->
<title>Untitled graph</title>
<defs>
<!-- open arrow -->
<g id="ah" stroke-linecap="round" stroke-width="1">
<line x1="-8" y1="-4" x2="1" y2="0" />
<line x1="1" y1="0" x2="-8" y2="4" />
</g>
<!-- class definitions -->
<style type="text/css"><![CDATA[
.edge {
font-size: 13px;
stroke: black;
text-align: center;
}
.graph {
font-size: 16px;
text-align: center;
}
.node {
font-size: 16px;
text-align: center;
}
]]></style>
</defs>
<!-- graph background with border (mainly for printing) -->
<rect x="0.5" y="0.5" width="2454.312" height="163.56" fill="white" stroke="white" />
<g id="0" class="edge">
<!-- from ezekiel to nathan -->
<!-- horizontal -->
<line x1="105.92" y1="114.92" x2="200.25" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="201.25" y="114.92"/>
<text x="114" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">playing</text>
</g>
<g id="11" class="edge">
<!-- from julia to dee -->
<!-- horizontal -->
<line x1="1769.82" y1="114.92" x2="1853.1" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="1854.1" y="114.92"/>
<text x="1779" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">clock</text>
</g>
<g id="13" class="edge">
<!-- from heidi to julia -->
<!-- horizontal -->
<line x1="1588.21" y1="114.92" x2="1692.17" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="1693.17" y="114.92"/>
<text x="1595" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">bathrobe</text>
</g>
<g id="15" class="edge">
<!-- from charlotte to heidi -->
<!-- horizontal -->
<line x1="1408.45" y1="114.92" x2="1504.02" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="1505.02" y="114.92"/>
<text x="1416" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">candles</text>
</g>
<g id="17" class="edge">
<!-- from felicia to charlotte -->
<!-- horizontal -->
<line x1="1212.03" y1="114.92" x2="1292.23" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="1293.23" y="114.92"/>
<text x="1222" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">wine</text>
</g>
<g id="19" class="edge">
<!-- from gregory to felicia -->
<!-- horizontal -->
<line x1="1018.33" y1="114.92" x2="1120.04" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="1121.04" y="114.92"/>
<text x="1025" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">calendar</text>
</g>
<g id="21" class="edge">
<!-- from bernard to gregory -->
<!-- horizontal -->
<line x1="838.86" y1="114.92" x2="909.54" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="910.54" y="114.92"/>
<text x="850" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">CD</text>
</g>
<g id="23" class="edge">
<!-- from marie to bernard -->
<!-- horizontal -->
<line x1="652.89" y1="114.92" x2="732.78" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="733.78" y="114.92"/>
<text x="663" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">bear</text>
</g>
<g id="25" class="edge">
<!-- from isaac to marie -->
<!-- horizontal -->
<line x1="479.01" y1="114.92" x2="564.02" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="565.02" y="114.92"/>
<text x="488" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">teddy</text>
</g>
<g id="27" class="edge">
<!-- from nathan to isaac -->
<!-- horizontal -->
<line x1="299.28" y1="114.92" x2="395.15" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="396.15" y="114.92"/>
<text x="307" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">mittens</text>
</g>
<g id="3" class="edge">
<!-- from karl to ezekiel -->
<!-- south/west corner -->
<g stroke="#000000">
<line x1="2412.31" y1="49.14" x2="2412.31" y2="75.88" />
<line x1="2386.31" y1="49.64" x2="2412.81" y2="49.64" />
</g>
<!-- horizontal -->
<line x1="94" y1="49.64" x2="2386.31" y2="49.64" stroke="#000000" />
<text x="119.6" y="44" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">book</text>
<!-- south/east corner -->
<g stroke="#000000">
<line x1="55.5" y1="49.14" x2="55.5" y2="74.75" />
<line x1="55" y1="49.64" x2="94" y2="49.64" />
</g>
<use stroke="#000000" xlink:href="#ah" transform="translate(55.5 75.75)rotate(90)"/>
</g>
<g id="5" class="edge">
<!-- from leo to karl -->
<!-- horizontal -->
<line x1="2274.45" y1="114.92" x2="2372.88" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="2373.88" y="114.92"/>
<text x="2282" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">slippers</text>
</g>
<g id="7" class="edge">
<!-- from alice to leo -->
<!-- horizontal -->
<line x1="2113.5" y1="114.92" x2="2206.3" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="2207.3" y="114.92"/>
<text x="2122" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">mirror</text>
</g>
<g id="9" class="edge">
<!-- from dee to alice -->
<!-- horizontal -->
<line x1="1925.05" y1="114.92" x2="2031.36" y2="114.92" stroke="#000000" />
<use stroke="#000000" xlink:href="#ah" x="2032.36" y="114.92"/>
<text x="1932" y="110" style="font-family:sans-serif;font-size:12.8px" fill="#000000" stroke="none">chocolate</text>
</g>
<g id="1" class="node">
<!-- ezekiel, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="76" x="17.5" y="82.78" />
<text x="55" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">ezekiel</text>
</g>
<g id="2" class="node">
<!-- nathan, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="73" x="213.668" y="82.78" />
<text x="250" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">nathan</text>
</g>
<g id="4" class="node">
<!-- karl, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="51" x="2386.812" y="82.78" />
<text x="2412" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">karl</text>
</g>
<g id="6" class="node">
<!-- leo, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="42" x="2219.524" y="82.78" />
<text x="2240" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">leo</text>
</g>
<g id="8" class="node">
<!-- alice, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="55" x="2046.276" y="82.78" />
<text x="2073" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">alice</text>
</g>
<g id="10" class="node">
<!-- dee, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="46" x="1865.132" y="82.78" />
<text x="1888" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">dee</text>
</g>
<g id="12" class="node">
<!-- julia, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="52" x="1706.788" y="82.78" />
<text x="1732" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">julia</text>
</g>
<g id="14" class="node">
<!-- heidi, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="57" x="1517.588" y="82.78" />
<text x="1546" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">heidi</text>
</g>
<g id="16" class="node">
<!-- charlotte, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="92" x="1303.884" y="82.78" />
<text x="1349" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">charlotte</text>
</g>
<g id="18" class="node">
<!-- felicia, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="67" x="1134.38" y="82.78" />
<text x="1167" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">felicia</text>
</g>
<g id="20" class="node">
<!-- gregory, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="85" x="919.996" y="82.78" />
<text x="962" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">gregory</text>
</g>
<g id="22" class="node">
<!-- bernard, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="85" x="744.396" y="82.78" />
<text x="786" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">bernard</text>
</g>
<g id="24" class="node">
<!-- marie, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="66" x="576.276" y="82.78" />
<text x="609" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">marie</text>
</g>
<g id="26" class="node">
<!-- isaac, rect -->
<rect fill="#ffffff" height="64.28" stroke="#000000" width="59" x="408.756" y="82.78" />
<text x="438" y="120" style="font-family:serif" fill="#000000" text-anchor="middle">isaac</text>
</g>
</svg>
</div>
<p>And, of course, in true Perlish fashion, we can also take things into our own hands and just work on the graph ourselves:</p>
<pre><code class="code-listing"><span class="word">printf</span> <span class="double">"From: %s, To: %s, item: %s\n"</span><span class="operator">,</span> <br /> <span class="magic">$_</span><span class="operator">-></span><span class="word">label</span><span class="operator">,</span> <br /><span class="comment"> # because we know there's only one edge per peep<br /></span> <span class="word">map</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">to</span><span class="operator">-></span><span class="word">label</span><span class="operator">,</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">label</span> <span class="structure">}</span><span class="magic">$_</span><span class="operator">-></span><span class="word">edges</span> <span class="word">for</span> <span class="symbol">$exchange</span><span class="operator">-></span><span class="word">nodes</span><span class="structure">;</span></code></pre>
<p>which gives us</p>
<pre><code> From: alice, To: karl, item: beanie
From: bernard, To: leo, item: playing
From: charlotte, To: felicia, item: CD
From: dee, To: dee, item: chocolate
From: ezekiel, To: marie, item: mittens
From: felicia, To: dee, item: chocolate
From: gregory, To: nathan, item: bathrobe
From: heidi, To: ezekiel, item: book
From: isaac, To: bernard, item: cards
From: julia, To: charlotte, item: mirror
From: karl, To: julia, item: scarf
From: leo, To: gregory, item: clock
From: marie, To: alice, item: calendar
From: nathan, To: nathan, item: bathrobe</code></pre>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Graph::Easy">Graph::Easy</a></p>
</li>
</ul>
</div>2020-12-21T00:00:00ZYanick ChampouxHelp! Rudolf's Nose Won't Light Up!http://perladvent.org/2020/2020-12-20.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Often we find ourselves writing code that copes with <i>optional</i> dependencies; Code that will use a module to do amazing things if it's installed, but will muddle through with some lesser code path if that dependency is missing or unavailable on the system. When developing this code we need to test how the code works in both situations, preferably without breaking parts of our system setup just to check that the alternative code paths still work!</p>
<p>How can we do this? Gather round, I have a story to tell...</p>
<h3 id="A-Christmas-Tale">A Christmas Tale</h3>
<p>At the north pole Cyber-Santa was in a bit of a pickle because he'd forgotten to charge the batteries for his new Robo-Reindeer's light-up nose! How would he be able to find his way through the dark and deliver techno-toys to all the good programmers and sysadmins?</p>
<p>Cyber-Santa was stressing out and whining on Twitter when one of his older elves reminded him that cost over-runs on the Reindeer Upgrade Project meant that he was still using the old sleigh, and that still had mounting brackets for old oil lamps.</p>
<p>"But do we know that those lamps still work? Are they bright enough?", Cyber-Santa asked</p>
<p>"Oh yes", replied the elf. "Don't you remember, last Christmas we weren't sure whether all the new Robo-Reindeer would be ready in time, so we did our <a href="https://en.wikipedia.org/wiki/Sinterklaas">test run</a> both with and without cybernetic cervids, and everything worked just fine."</p>
<p>"Let me show you how we tested this", said the elf elaborated, "I'll take you step by step through what we normally do. First, we dig the sleigh out from under that snowdrift. Would you mind doing it, only my poor old back is giving me gyp right now....and then could you fetch the reindeer and attach them to the sleigh?",</p>
<p>So Santa dug out the sleigh, fetched the reindeer, got kicked by the reindeer, harnessed them and <i>finally</i> climbed up into the driver's seat, all sweaty and bruised and smelling of reindeer.</p>
<p>"So at this point, we're ready to go, right?" asked the elf.</p>
<p>"Yes!", said Cyber-Santa.</p>
<p>"Wrong!", replied the elf, "We're not yet ready. If you turn to page two of your Sleigh Operations Manual you'll see the pre-flight checklist. The ninety fourth item on the list (after 'are the presents tied down?' and 'do you have <a href="https://en.wikipedia.org/wiki/A_Twisted_Christmas">banging choonz</a> queued up on your iPod?') is 'is the robot providing sufficient lighting to navigate by?'".</p>
<p>And so Santa checked, and the glowing Robo-NoZe™ wasn't working because of that flat battery.</p>
<p>"And after checklist item ninety four it tells you that if it isn't working you should use an oil lamp, doesn't it", scolded the elf.</p>
<p>Santa looked a bit sheepish and apologised, muttering something about being too eager to get his deliveries done so he could relax with a pint and some pork scratchings.</p>
<p>"I'll let you off this time", scolded the elf, "but don't do it again."</p>
<p>"But ... but ..." Santa said hesitantly "how do we know it will work?"</p>
<p>"Oh, right, I was going to show you how we tested this wasn't I. Sorry, I'm getting forgetful in my old age. Let's go indoors and simulate it on your laptop where it'll be nice and warm" smirked the elf, who really preferred the previous Santa, because the elf's children got to play with left over toys and far preferred traditional wooden blocks and balls and things instead of the modern nonsense that Cyber-Santa was obsessed with.</p>
<h3 id="Modeling-With-Perl">Modeling With Perl</h3>
<p>"First let's simulate what you just did", said the elf. "We'll create a sleigh object, and a factory class to simulate the field that the reindeer come from.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$sleigh</span> <span class="operator">=</span> <span class="word">Sleigh</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="keyword">my</span> <span class="symbol">@reindeer</span> <span class="operator">=</span> <span class="word">ReindeerFactory</span><span class="operator">-></span><span class="word">fetch</span><span class="structure">(</span><span class="number">9</span><span class="structure">);</span></code></pre>
<p>"Then we'll harness the reindeer to the sleigh and have the sleigh run through the pre-flight checks because you're so forgetful. Then, once the pre-flight checks are complete we can get going:</p>
<pre><code class="code-listing"><span class="symbol">$sleigh</span><span class="operator">-></span><span class="word">harness</span><span class="structure">(</span><span class="symbol">@reindeer</span><span class="structure">);</span><br /><span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$sleigh</span><span class="operator">-></span><span class="word">pre_flight</span><span class="structure">())</span> <span class="structure">{</span><br /><span class="comment"> # FIXME, deliver presents here<br /></span><span class="structure">}</span></code></pre>
<p>"So far, so simple. Now, consider that right now your pasture contains Robo-Reindeer, but previously it contained normal reindeer. So the ReindeerFactory has to look something like this:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">ReindeerFactory</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$reindeer_class</span> <span class="operator">=</span> <span class="word">eval</span> <span class="double">"use RoboReindeer"</span> <span class="operator">?</span> <span class="double">"RoboReindeer"</span> <span class="operator">:</span><br /> <span class="word">eval</span> <span class="double">"use BioReindeer"</span> <span class="operator">?</span> <span class="double">"BioReindeer"</span> <span class="operator">:</span><br /> <span class="word">die</span><span class="structure">(</span><span class="double">"No reindeer found\n"</span><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">fetch</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$number_wanted</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="structure">((</span><span class="symbol">$reindeer_class</span><span class="operator">-></span><span class="word">new</span><span class="structure">())</span> <span class="operator">x</span> <span class="symbol">$number_wanted</span><span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>"I see", said Santa, "so if the RoboReindeer module is installed (or if in real life I've got RoboReindeer in the pasture) then the factory will give me those, otherwise it'll give me BioReindeer. Very clever. That looks like a pain to test though."</p>
<p>"Yes, unfortunately it is" admitted the elf. "We had to run through the whole damned process twice, once for Robo-Reindeer, once for normal ones, being very careful to keep the two completely separate."</p>
<p>Santa was very thankful that he had elves to do that sort of hard work for him, but thought that it looked like a jolly useful technique for some of his hobby projects. "If only I could automate that in Perl..." mused Santa. But he put that aside, because he had a busy two days ahead of him.</p>
<h3 id="Magic-in-INC">Magic in @INC</h3>
<p>After he'd done his two days work for the whole year, and was stretched out on the sofa with a glass of brandy and some mince pies, Santa was still wondering how to automate that. Obviously he could wrap all his tests in a shell script that would install/uninstall modules as appropriate, but that seemed terribly inelegant. But then it dawned on him - all he needed to do was interfere with how Perl loaded modules.</p>
<p>Normally the <code>@INC</code> array is just a list of directories in which perl will look, one directory after another, for modules that you try to <code>use</code>. But you can also put code-refs in it. For example:</p>
<pre><code> $ perl -E '
BEGIN { unshift @INC, sub { say "Hello World" } }
use Foo;
'
Hello World
[loud complaining from perl]</code></pre>
<p>(NB the BEGIN block is required so that we get to diddle <code>@INC</code> at compile- time. The complaining from perl is because <code>say</code> returns something that perl doesn't know what to do with)</p>
<p>When Perl finds a code-ref in <code>@INC</code> it passes the desired module to the code- ref, with its name reformatted from something like <code>Foo::Bar</code> to a filename like <code>Foo/Bar.pm</code>. Your code-ref can then decide not to do anything, thus making perl look in the next place listed in <code>@INC</code>, or it can return the source code for a module:</p>
<p>To have your sub-routine do nothing and have Perl carry on to the next entry in <code>@INC</code> have it return <code>undef</code>:</p>
<pre><code> $ perl -E '
BEGIN { unshift @INC, sub { return undef } }
use File::Temp;
'</code></pre>
<p>That code-ref has absolutely no effect - when Perl tries to <code>use File::Temp</code> it first executes our subroutine, which returns <code>undef</code>, so Perl then tries to load it from the directories that make up the rest of the list, and eventually succeeds.</p>
<p>So what if we want to prevent <code>File::Temp</code> from loading? Our <code>@INC</code> hook has to return an open filehandle which Perl can read the module code from, and the code we return (which Perl will then read and execute as if it were the <code>File::Temp</code> module) should just die instead:</p>
<pre><code> $ perl -E '
BEGIN { unshift @INC, sub {
# is this what we're hiding? return an alternative file-handle
if ($_[1] eq "File/Temp.pm") {
open my $fh, "<", \"die(qq{$_[1] is hidden})";
return $fh;
}
# not something we're hiding, return undef so Perl will continue as normal
return undef;
} }
use File::Temp;
'
File/Temp.pm is hidden at /loader/0x7ffe498186e8/File/Temp.pm line 1.
Compilation failed in require at -e line 8.
BEGIN failed--compilation aborted at -e line 8.</code></pre>
<h3 id="PERL5OPT-and--M">PERL5OPT and -M</h3>
<p>Santa was very happy and wrapped this up in a module:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Without</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">import</span> <span class="structure">{</span><br /> <span class="core">shift</span><span class="structure">;</span><br /><span class="comment"> # translate a list of modules to a list of filenames<br /></span> <span class="keyword">my</span> <span class="symbol">@hidden</span> <span class="operator">=</span> <span class="word">map</span> <span class="structure">{</span><br /> <span class="substitute">s!::!/!g</span><span class="structure">;</span><br /> <span class="double">"$_.pm"</span><span class="structure">;</span><br /> <span class="structure">}</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="word">unshift</span> <span class="symbol">@INC</span><span class="operator">,</span> <span class="keyword">sub</span> <span class="structure">{</span><br /><span class="comment"> # $_[0] is this sub-routine itself.<br /></span> <span class="keyword">my</span> <span class="symbol">$wanted</span> <span class="operator">=</span> <span class="magic">$_</span><span class="structure">[</span><span class="number">1</span><span class="structure">];</span><br /> <span class="keyword">if</span><span class="structure">(</span><span class="word">grep</span> <span class="structure">{</span> <span class="symbol">$wanted</span> <span class="operator">eq</span> <span class="magic">$_</span> <span class="structure">}</span> <span class="symbol">@hidden</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="cast">\</span><span class="double">"die(qq{$wanted is hidden})"</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="symbol">$fh</span><br /> <span class="structure">}</span><br /> <span class="keyword">return</span> <span class="core">undef</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>So that he could invoke like this to test his code with both RoboReindeer and BioReindeer, with one but not the other, and even without both:</p>
<pre><code> make test &&
PERL5OPT=-MWithout=RoboReindeer make test &&
PERL5OPT=-MWithout=BioReindeer make test &&
PERL5OPT=-MWithout=RoboReindeer,BioReindeer make test</code></pre>
<p>PERL5OPT is an environment variable that contains extra command line arguments that will be passed to any Perl process. -M is used to load a module on the command line, but using it to pass arguments to the module's <code>import()</code>method is less well known.</p>
<h3 id="A-few-days-later">A few days later</h3>
<p>Santa was very pleased with himself and later that week he went to his local Perl Mongers meeting, with his laptop, so that he could show everyone his nifty new trick.</p>
<p>"Oh, you wanted <a href="https://metacpan.org/module/Devel::Hide">Devel::Hide</a>", they told him, adding that <code>PERL5OPT</code> isn't used in taint-mode and that the trick of using open to turn a scalar into a filehandle didn't work in some really old perls.</p>
<p>"Bother", said Santa, as he deleted his code and installed Devel::Hide from the CPAN. "Ah well, it was fun anyway."</p>
<pre><code> make test &&
PERL5OPT=-MDevel::Hide=RoboReindeer make test &&
PERL5OPT=-MDevel::Hide=BioReindeer make test &&
PERL5OPT=-MDevel::Hide=RoboReindeer,BioReindeer make test</code></pre>
<h3 id="SEE-ALSO">SEE ALSO</h3>
<ul>
<li><p><a href="https://metacpan.org/module/Devel::Hide">Devel::Hide</a></p>
</li>
<li><p>For details on <code>PERL5OPT</code> and <code>-M</code>, see <a href="https://metacpan.org/module/perlrun">perlrun</a>.</p>
</li>
<li><p>For details on magical @INC, see <a href="https://metacpan.org/module/perlfunc#require">"require" in perlfunc</a>.</p>
</li>
</ul>
</div>2020-12-20T00:00:00ZDavid CantrellGathering all the Presentshttp://perladvent.org/2020/2020-12-19.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Happy the Elf wasn't. Normally Happy by name and happy by nature, the elf was uncharacteristically grumpy. And the reason for this? An email from Santa.</p>
<pre><code> From: Santa <bigred@workshop.org.northpole>
To: All Staff <all@workshop.org.northpole>
Subject: Bonus Scheme
Greetings all!
Starting this year every elf working on project Christmas Eve will be
receiving a wonderful Christmas gift of their own!
Ho ho ho!
Santa.</code></pre>
<p>A well intentioned goodwill gesture for sure - however as usual no one had considered the effect this would have on the poor programmer-elf who would have to implement the code! Case in point: the simple code Happy had written many moons ago in order to pick what presents were needed to be produced this year:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">present_list</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span><br /> <span class="word">map</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">presents_asked_for</span> <span class="structure">}</span><br /> <span class="word">grep</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">naughty_or_nice</span> <span class="operator">eq</span> <span class="single">'nice'</span> <span class="structure">}</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">children</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>It's simple functional code to get all presents asked for by all the nice children.</p>
<p>Now, with these new requirements, Happy would probably have to introduce a temporary variable:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">present_list</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="symbol">$shift</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">@entities</span><span class="structure">;</span><br /> <span class="word">push</span> <span class="symbol">@entities</span><span class="operator">,</span> <span class="word">grep</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">naughty_or_nice</span> <span class="operator">eq</span> <span class="single">'nice'</span> <span class="structure">}</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">children</span><span class="structure">;</span><br /> <span class="word">push</span> <span class="symbol">@entities</span><span class="operator">,</span> <span class="word">grep</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">worked_on_xmas_eve</span> <span class="structure">}</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">elves</span><br /> <span class="word">if</span> <span class="symbol">$config</span><span class="operator">-></span><span class="word">santa_extra_gift_enabled</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="word">map</span> <span class="structure">{</span><br /> <span class="magic">$_</span><span class="operator">-></span><span class="word">presents_asked_for</span><br /> <span class="structure">}</span> <span class="symbol">@entities</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>Feeling there must be a better solution, Happy scoured the CPAN until he found the <a href="https://metacpan.org/module/List::Gather">List::Gather</a> module, which uses Perl's pluggable keyword facilities to provide new <code>gather</code> and <code>take</code> syntax.</p>
<p>The <code>gather</code> keyword introduces a block of code that returns the list of whatever is taken within that block by making calls to `take` within.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">List::Gather</span> <span class="words">qw( gather take )</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">presents</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="word">map</span> <span class="structure">{</span><br /> <span class="magic">$_</span><span class="operator">-></span><span class="word">presents_asked_for</span><br /> <span class="structure">}</span> <span class="word">gather</span> <span class="structure">{</span><br /> <span class="word">take</span> <span class="word">grep</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">naughty_or_nice</span> <span class="operator">eq</span> <span class="single">'nice'</span> <span class="structure">}</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">children</span><span class="structure">;</span><br /> <span class="word">take</span> <span class="word">grep</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">worked_on_xmas_eve</span> <span class="structure">}</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">elves</span><br /> <span class="word">if</span> <span class="symbol">$config</span><span class="operator">-></span><span class="word">santa_extra_gift_enabled</span><span class="structure">;</span><br /> <span class="structure">};</span><br /><span class="structure">}</span></code></pre>
<p>Now this did make Happy happy. What made him more happy was that when he got the next email from Santa with even more requirements he knew just what to do:</p>
<pre><code> From: Santa <bigred@workshop.org.northpole>
To: All Staff <all@workshop.org.northpole>
Subject: Bonus Scheme EXTENDED!
Greetings all!
I'm feeling extra jolly because of all your hard work! So jolly I've decided
to extend our bonus scheme to the wives and husbands of those people working
on Project Christmas Eve!
Ho ho ho!
Santa.</code></pre>
<p>Because <code>gather { ... }</code> is a block containing arbitrary statements he was easily able to convert the <code>push ... grep</code> into a more complex <code>for</code> loop, right in the middle of the <code>gather</code> statement:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">List::Gather</span> <span class="words">qw( gather take )</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">presents</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="word">map</span> <span class="structure">{</span><br /> <span class="magic">$_</span><span class="operator">-></span><span class="word">presents_asked_for</span><br /> <span class="structure">}</span> <span class="word">gather</span> <span class="structure">{</span><br /> <span class="word">take</span> <span class="word">grep</span> <span class="structure">{</span> <span class="magic">$_</span><span class="operator">-></span><span class="word">naughty_or_nice</span> <span class="operator">eq</span> <span class="single">'nice'</span> <span class="structure">}</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">children</span><span class="structure">;</span><br /><br /> <span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$config</span><span class="operator">-></span><span class="word">santa_extra_gift_enabled</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">for</span> <span class="keyword">my</span> <span class="symbol">$elf</span> <span class="structure">(</span><span class="symbol">$self</span><span class="operator">-></span><span class="word">elves</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">next</span> <span class="word">unless</span> <span class="symbol">$elf</span><span class="operator">-></span><span class="word">worked_on_xmas_eve</span><span class="structure">;</span><br /> <span class="word">take</span> <span class="symbol">$elf</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$spouse</span> <span class="operator">=</span> <span class="symbol">$elf</span><span class="operator">-></span><span class="word">spouse</span><span class="structure">;</span><br /> <span class="word">next</span> <span class="word">unless</span> <span class="symbol">$spouse</span><span class="structure">;</span><br /> <span class="word">next</span> <span class="word">if</span> <span class="symbol">$spouse</span><span class="operator">-></span><span class="word">worked_on_xmas_eve</span><span class="structure">;</span><br /> <span class="word">take</span> <span class="symbol">$spouse</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></code></pre>
<h3 id="Constructor">Constructor</h3>
<p>Now that Happy had <a href="https://metacpan.org/module/List::Gather">List::Gather</a> in his toolset he started to find all kinds of places that he could use it.</p>
<p>The present wrapping code was a perfect example. Here's the code Happy needed to modify:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$wrapping</span> <span class="operator">=</span> <span class="word">Present::Wrapping</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">color</span> <span class="operator">=></span> <span class="single">'green'</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>Happy needed to make changes so that if the gift was large, the Present::Wrapping instance would be set up to use an extra large sheet, passing the <code>extra_large_sheet</code> option if and only if <code>$gift->large</code> was true. His first attempt was to pull out the arguments into an array that he built up in advance:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@args</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="word">color</span> <span class="operator">=></span> <span class="single">'green'</span><span class="structure">;</span><br /><span class="structure">);</span><br /><br /><span class="word">push</span> <span class="symbol">@args</span><span class="operator">,</span> <span class="word">extra_large_sheet</span> <span class="operator">=></span> <span class="number">1</span><br /> <span class="word">if</span> <span class="symbol">$gift</span><span class="operator">-></span><span class="word">large</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$wrapping</span> <span class="operator">=</span> <span class="word">Present::Wrapping</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="symbol">@args</span> <span class="structure">);</span></code></pre>
<p>This code, besides taking many more lines than before, is also somewhat less readable. Another programmer-elf looking at the code for the first time has no idea what the arguments being created are for until they read the very last line; Only at that point can they go back and make sense of why <code>@args</code> is set up the way it is.</p>
<p>The traditional way to write this inline is to abuse the ternary operation, producing the particularly unreadable:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$wrapping</span> <span class="operator">=</span> <span class="word">Present::Wrapping</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">color</span> <span class="operator">=></span> <span class="single">'green'</span><span class="operator">,</span><br /> <span class="structure">(</span> <span class="structure">(</span><span class="symbol">$gift</span><span class="operator">-></span><span class="word">large</span><span class="structure">)</span> <span class="operator">?</span> <span class="structure">(</span> <span class="word">extra_large_sheet</span> <span class="operator">=></span> <span class="number">1</span> <span class="structure">)</span> <span class="operator">:</span> <span class="structure">())</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>Happy wasn't happy about this code. All those brackets weren't only hard to type but forced Happy to think too hard whenever he was debugging code that used this construct. Had he missed a brace? Did he need to wrap the <code>$gift->large</code> in brackets or not?</p>
<p>Now that he had <a href="https://metacpan.org/module/List::Gather">List::Gather</a> in his toolset, Happy was able to do something much more readable:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$wrapping</span> <span class="operator">=</span> <span class="word">Present::Wrapping</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="word">gather</span> <span class="structure">{</span><br /> <span class="word">take</span> <span class="word">color</span> <span class="operator">=></span> <span class="single">'green'</span><span class="structure">;</span><br /> <span class="word">take</span> <span class="word">extra_large_sheet</span> <span class="operator">=></span> <span class="number">1</span> <span class="word">if</span> <span class="symbol">$gift</span><span class="operator">-></span><span class="word">large</span><span class="structure">;</span><br /><span class="structure">});</span></code></pre>
</div>2020-12-19T00:00:00ZMark FowlerChristmas Tunes!http://perladvent.org/2020/2020-12-18.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p><center><img src="noddy.jpg" width="315" height="315" alt="Noddy Meme"></center>
</p>
<p>For some people it's just not Christmas until we hear Noddy Holder shouting "It's Christmas!" at the end of Slade's Merry Xmas Everybody. Heck, it's just not Christmas without our Christmas Music. Be it daft old Christmas number ones, covers of carols by warbling modern day divas, or choir recordings, we've all got our own little playlists that put us in the Christmas mood. Honestly, I've listened to the same playlist as the kids and I decorated the tree for the last three years.</p>
<p>Being an Apple geek, I subscribe to Apple Music and that's where <a href="https://itunes.apple.com/us/playlist/marks-christmas-playlist/pl.bdbdd828fdba47778211ce4d248f8ee9">that playlist lives</a> for any other Apple Music subscribers that have my same eccentric taste to listen to.</p>
<p>The trouble with Apple Music is that, unlike some of its competitors, it doesn't have a free ad-supported web player that anyone can click on and immediately listen to the playlist. If I really want to spread Christmas cheer wide I should port that playlist over to Spotify for sharing purposes. Of course, that sounds like a lot of work...unless I get Perl to do it for me!</p>
<h3 id="Interrogating-iTunes">Interrogating iTunes</h3>
<p>The easiest way to extract the details of my playlist from Apple Music is to use the Mac's <i>Open Scripting Architecture</i> to talk directly to iTunes and ask it for the details we want. Far by the most common way to do this on a Mac is to write some AppleScript which sends the OSA events for you automatically. AppleScript is a very odd bespoke programming language designed to have a shallow learning curve for non-programmers to do simple things. Unfortunately however, this means it has a very steep learning curve for programmers who are used to totally different syntax when they want to do anything moderately complex (like, say, writing a loop or subroutine.) Luckily being an <i>Open</i> Scripting Architecture means that other languages can send these events just as well - you can even do this with Perl using <a href="https://metacpan.org/module/Mac::Glue">Mac::Glue</a>.</p>
<p>Sometimes however - shock, horror - the best programming language for a task always <i>isn't Perl</i>. Apple produce <a href="https://www.macstories.net/tutorials/getting-started-with-javascript-for-automation-on-yosemite/">JavaScript For Automation</a> which is a simple interface to the OSA from JavaScript. And Perl being Perl it's <i>really</i> easy to glue this in the middle of a Perl script:</p>
<pre><code class="code-listing"><span class="comment">#!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">JSON::PP</span> <span class="words">qw( encode_json decode_json )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">IPC::Run3</span> <span class="words">qw( run3 )</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$js</span> <span class="operator">=</span> <span class="heredoc"><<'JAVASCRIPT'</span><span class="structure">;</span><br /><span class="heredoc_content">console.log(<br /> JSON.stringify(<br /> Application('iTunes').currentPlaylist.tracks().map( track => {<br /> return {<br /> artist : track.artist(),<br /> title : track.name()<br /> };<br /> })<br /> )<br />)<br /></span><span class="heredoc_terminator">JAVASCRIPT<br /></span><br /><span class="keyword">my</span> <span class="symbol">$output</span><span class="structure">;</span><br /><span class="word">run3</span><span class="structure">([</span><span class="words">qw( osascript -l JavaScript )</span><span class="structure">]</span><span class="operator">,</span> <span class="cast">\</span><span class="symbol">$js</span><span class="operator">,</span> <span class="core">undef</span><span class="operator">,</span> <span class="cast">\</span><span class="symbol">$output</span> <span class="structure">);</span><br /><span class="keyword">my</span> <span class="symbol">$itunes_tracks</span> <span class="operator">=</span> <span class="word">decode_json</span><span class="structure">(</span><span class="symbol">$output</span><span class="structure">);</span></code></pre>
<p>The technique is simple: Write some JavaScript, have it output JSON. Send that JavaScript on STDIN to <code>osascript</code>, capture the JSON it outputs and decode it in Perl. To give us a data structure that looks something like this:</p>
<pre><code class="code-listing"><span class="structure">[</span><br /> <span class="structure">{</span><br /> <span class="single">'artist'</span> <span class="operator">=></span> <span class="single">'Slade'</span><span class="operator">,</span><br /> <span class="single">'title'</span> <span class="operator">=></span> <span class="single">'Merry Xmas Everybody'</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span><br /> <span class="single">'artist'</span> <span class="operator">=></span> <span class="single">'Vile Richard'</span><span class="operator">,</span><br /> <span class="single">'title'</span> <span class="operator">=></span> <span class="single">'We Wish You a Merry Christmas'</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span><br /> <span class="single">'artist'</span> <span class="operator">=></span> <span class="single">'The Darkness'</span><span class="operator">,</span><br /> <span class="single">'title'</span> <span class="operator">=></span> <span class="single">'Christmas Time (Don\'t Let the Bells End)'</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">{</span><br /> <span class="single">'title'</span> <span class="operator">=></span> <span class="single">'Last Christmas (Single Version)'</span><span class="operator">,</span><br /> <span class="single">'artist'</span> <span class="operator">=></span> <span class="single">'Wham!'</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="operator">...</span></code></pre>
<h3 id="Signing-Up-For-a-Spotify-Developer-Account">Signing Up For a Spotify Developer Account</h3>
<p>I'm going to need to use the Spotify Web API to build a playlist full of these tracks. Before I can do that, I need to sign up with their developer platform and create a new test application.</p>
<p>After logging into Spotify and navigating to the <a href="https://developer.spotify.com/dashboard/applications">Spotify Developer Dashboard</a> I can click on "Create a Client ID"</p>
<p><center><img src="spotify1.jpg" width="514" height="368" alt="Spotify Client Registration Picture"></center>
</p>
<p>And then fill in all the details for my account. Since this is just a bit of fun, I just accepted the non-commercial agreements.</p>
<p><center><img src="spotify2.jpg" width="514" height="368" alt="Spotify Client Registration Picture"></center>
</p>
<p>Once I've clicked through I end up on a screen that contains my client id and my client secret. I'll need these later:</p>
<p><center><img src="spotify3.jpg" width="514" height="368" alt="Spotify Client Registration Picture"></center>
</p>
<p>There's one more thing to do before we're done with the web interface. I need to register a callback URL that my Perl code will use in the OAuth process that I'll be describing later. Clicking on the "Edit Settings" page takes me to a page where I can enter the http://localhost:8082/callback address that the module I'm going to introduce in a minute uses:</p>
<p><center><img src="spotify4.jpg" width="514" height="368" alt="Spotify Client Registration Picture"></center>
</p>
<h3 id="OAuth">OAuth</h3>
<p>So far I've only registered a developer application. Now I need to go through the OAuth process that grants my developer application the contexts (the privileges) it needs to access my account (even though it's only me using this application with my own account, Spotify needs us to go through the same process that we'd use if we were letting many different people use this application with their own accounts.)</p>
<p>A typical OAuth enabled web application bounces you from the application's website to Spotify's website, has you log in, then show you a permissions dialog saying what contexts (privileges) you're prepared to have that application use and then finally bounce you back to the original application's website's callback URL with secrets in the URL parameters. But we're developing a command line application. How is that going to work?</p>
<p>Well, as usual, there's a module for that on the CPAN: <a href="https://metacpan.org/module/OAuth::Cmdline::Spotify">OAuth::Cmdline::Spotify</a>. We're going to use it first in a simple standalone script:</p>
<pre><code class="code-listing"><span class="comment">#!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">OAuth::Cmdline::Spotify</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">OAuth::Cmdline::Mojo</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$oauth</span> <span class="operator">=</span> <span class="word">OAuth::Cmdline::Spotify</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">client_id</span> <span class="operator">=></span> <span class="single">'**REDACTED**'</span><span class="operator">,</span><br /> <span class="word">client_secret</span> <span class="operator">=></span> <span class="single">'**REDACTED**'</span><span class="operator">,</span><br /> <span class="word">login_uri</span> <span class="operator">=></span> <span class="single">'https://accounts.spotify.com/authorize'</span><span class="operator">,</span><br /> <span class="word">token_uri</span> <span class="operator">=></span> <span class="single">'https://accounts.spotify.com/api/token'</span><span class="operator">,</span><br /> <span class="word">scope</span> <span class="operator">=></span> <span class="word">join</span> <span class="single">','</span><span class="operator">,</span> <span class="words">qw(<br /> playlist-read-private<br /> playlist-modify-private<br /> playlist-modify-public<br /> )</span><br /><span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$app</span> <span class="operator">=</span> <span class="word">OAuth::Cmdline::Mojo</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">oauth</span> <span class="operator">=></span> <span class="symbol">$oauth</span><span class="operator">,</span><br /><span class="structure">);</span><br /><span class="symbol">$app</span><span class="operator">-></span><span class="word">start</span><span class="structure">(</span> <span class="single">'daemon'</span><span class="operator">,</span> <span class="single">'-l'</span><span class="operator">,</span> <span class="symbol">$oauth</span><span class="operator">-></span><span class="word">local_uri</span> <span class="structure">);</span></code></pre>
<p>When this script is executed it starts up a webserver running on localhost:</p>
<pre><code> shell$ perl ~/tmp/oath.pl
[2018-12-09 08:58:07.68615] [32423] [info] Listening at "http://localhost:8082"
Server available at http://localhost:8082</code></pre>
<p>Visiting that URL gives us a simple link to Spotify, allowing me to log in if needed, and then display the permissions dialog:</p>
<p><center><img src="spotify5.jpg" width="700" height="636" alt="Spotify OAuth"></center>
</p>
<p>When I click "Okay" I'll be redirected to the callback URL on localhost that'll capture the token and store it in <code>~/.spotify.yml</code> for later use.</p>
<p>Whenever another script now needs that OAuth token we can use OAuth::Cmdline::Spotify to access it from the YAML file:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">OAuth::Cmdline::Spotify</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$oauth</span> <span class="operator">=</span> <span class="word">OAuth::Cmdline::Spotify</span><span class="operator">-></span><span class="word">new</span><span class="structure">();</span><br /><span class="keyword">my</span> <span class="symbol">$token</span> <span class="operator">=</span> <span class="symbol">$oauth</span><span class="operator">-></span><span class="word">access_token</span><span class="structure">;</span></code></pre>
<h3 id="Accessing-the-Spotify-Web-API">Accessing the Spotify Web API</h3>
<p>Now I've got the complicated authentication and authorization out of the way it's now just a simple matter of programming to complete my interface to Spotify:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">LWP::UserAgent</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">HTTP::Request::Common</span><span class="structure">;</span><br /><br /><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">$BASE_URL</span> <span class="operator">=</span> <span class="single">'https://api.spotify.com'</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@STANDARD_HEADERS</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="single">'Accept'</span> <span class="operator">=></span> <span class="single">'application/json'</span><span class="operator">,</span><br /> <span class="single">'Authorization'</span> <span class="operator">=></span> <span class="double">"Bearer $token"</span><span class="operator">,</span><br /> <span class="single">'Content-Type'</span> <span class="operator">=></span> <span class="single">'application/json'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">get</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$path</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$url</span> <span class="operator">=</span> <span class="word">URI</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="double">"$BASE_URL$path"</span><span class="structure">);</span><br /> <span class="symbol">$url</span><span class="operator">-></span><span class="word">query_form</span><span class="structure">(</span> <span class="magic">@_</span> <span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$ua</span><span class="operator">-></span><span class="word">request</span><span class="structure">(</span><br /> <span class="word">GET</span> <span class="symbol">$url</span><span class="operator">,</span><br /> <span class="symbol">@STANDARD_HEADERS</span><span class="operator">,</span><br /> <span class="structure">);</span><br /> <span class="word">die</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">message</span> <span class="word">unless</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">is_success</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="word">decode_json</span><span class="structure">(</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">content</span> <span class="structure">);</span><br /><span class="structure">}</span><br /><br /><span class="keyword">sub</span> <span class="word">post</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$path</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$url</span> <span class="operator">=</span> <span class="word">URI</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><span class="double">"$BASE_URL$path"</span><span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$response</span> <span class="operator">=</span> <span class="symbol">$ua</span><span class="operator">-></span><span class="word">request</span><span class="structure">(</span><br /> <span class="word">POST</span> <span class="symbol">$url</span><span class="operator">,</span><br /> <span class="symbol">@STANDARD_HEADERS</span><span class="operator">,</span><br /> <span class="word">Content</span> <span class="operator">=></span> <span class="word">encode_json</span><span class="structure">(</span> <span class="symbol">$data</span> <span class="structure">)</span><span class="operator">,</span><br /> <span class="structure">);</span><br /> <span class="word">die</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">message</span> <span class="word">unless</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">is_success</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="word">decode_json</span><span class="structure">(</span> <span class="symbol">$response</span><span class="operator">-></span><span class="word">content</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>And finally I can write the code to build my playlist:</p>
<pre><code class="code-listing"><span class="comment"># find the uri of the best matching song for the<br /># track name and artist<br /></span><span class="keyword">my</span> <span class="symbol">@found_tracks</span><span class="structure">;</span><br /><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$itunes_track</span> <span class="structure">(</span><span class="cast">@</span><span class="structure">{</span> <span class="symbol">$itunes_tracks</span> <span class="structure">})</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$title</span> <span class="operator">=</span> <span class="symbol">$itunes_track</span><span class="operator">-></span><span class="structure">{</span><span class="word">title</span><span class="structure">};</span><br /> <span class="symbol">$title</span> <span class="operator">=~</span> <span class="substitute">s/[(][^)]+[)]//g</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$artist</span> <span class="operator">=</span> <span class="symbol">$itunes_track</span><span class="operator">-></span><span class="structure">{</span><span class="word">artist</span><span class="structure">};</span><br /> <span class="symbol">$artist</span> <span class="operator">=~</span> <span class="substitute">s/,.*//g</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$search_string</span> <span class="operator">=</span> <span class="double">"$title $artist"</span><span class="structure">;</span><br /> <span class="word">print</span> <span class="word">STDERR</span> <span class="double">"Matching $search_string\n"</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$search</span> <span class="operator">=</span> <span class="word">get</span><span class="structure">(</span><br /> <span class="single">'/v1/search'</span><span class="operator">,</span><br /> <span class="word">q</span> <span class="operator">=></span> <span class="symbol">$search_string</span><span class="operator">,</span><br /> <span class="word">type</span> <span class="operator">=></span> <span class="single">'track'</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$spotify_track</span> <span class="operator">=</span> <span class="symbol">$search</span><span class="operator">-></span><span class="structure">{</span><span class="word">tracks</span><span class="structure">}{</span><span class="word">items</span><span class="structure">}[</span><span class="number">0</span><span class="structure">];</span><br /> <span class="keyword">unless</span> <span class="structure">(</span><span class="symbol">$spotify_track</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">print</span> <span class="word">STDERR</span> <span class="double">"No match!\n"</span><span class="structure">;</span><br /> <span class="word">next</span><span class="structure">;</span><br /> <span class="structure">}</span><br /> <span class="word">push</span> <span class="symbol">@found_tracks</span><span class="operator">,</span> <span class="symbol">$spotify_track</span><span class="operator">-></span><span class="structure">{</span><span class="word">uri</span><span class="structure">};</span><br /><span class="structure">}</span><br /><br /><span class="comment"># create a new playlist<br /></span><span class="keyword">my</span> <span class="symbol">$playlist_id</span> <span class="operator">=</span> <span class="word">post</span><span class="structure">(</span><br /> <span class="single">'/v1/users/2shortplanks/playlists'</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">name</span> <span class="operator">=></span> <span class="literal">q{Mark's Christmas Playlist}</span> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">)</span><span class="operator">-></span><span class="structure">{</span><span class="word">id</span><span class="structure">};</span><br /><br /><span class="comment"># add the tracks to that playlist<br /></span><span class="word">post</span><span class="structure">(</span><br /> <span class="double">"/v1/playlists/$playlist_id/tracks"</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">uris</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">@found_tracks</span> <span class="structure">}</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<h3 id="And-done">And done</h3>
<p>Running the script produces a best-effort version of the iTunes playlist <a href="https://open.spotify.com/playlist/5hyCf0PuWFknHdmGNjarFZ">on Spotify</a> (hampered not in the least by the fact that Slade doesn't distribute via Spotify).</p>
<p><center><iframe src="https://open.spotify.com/embed/playlist/5hyCf0PuWFknHdmGNjarFZ" width="600" height="380" frameborder="0" allowtransparency="true" allow="encrypted-media"></iframe></center>
</p>
<p>Happy listening!</p>
</div>2020-12-18T00:00:00ZMark FowlerThe Perl Powered Christmas Treehttp://perladvent.org/2020/2020-12-17.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>So, you want to run some Christmas tree lights. Not just any lights, but flashy blinky ones. And while you're at it, give them some nice pretty patterns using a few separate chains of lamps. Maybe Perl can help run those patterns?</p>
<h3 id="The-Software">The Software</h3>
<p>It's simple enough of course to define some blinky patterns, perhaps by naming the light chains A to D, and using a sequence of strings to define the patterns of which ones should be on or off:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@patterns</span> <span class="operator">=</span> <span class="words">qw(<br /> AB CD AB CD AB CD AC BD AC BD AC BD BC AD BC AD BC AD ...<br />)</span><span class="structure">;</span></code></pre>
<p>We could then use this string of patterns to drive the lights in some manner. For example, we could do something simple:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Time::HiRes</span> <span class="single">'sleep'</span><span class="structure">;</span><br /><br /><span class="keyword">while</span><span class="structure">(</span><span class="number">1</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$pattern</span> <span class="structure">(</span> <span class="symbol">@patterns</span> <span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">set_lights</span><span class="structure">(</span> <span class="symbol">$pattern</span> <span class="structure">);</span><br /> <span class="word">sleep</span> <span class="float">0.5</span><span class="structure">;</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p>Here we've got a nice simple repeating pattern that just runs all day long. But how might we implement this <code>set_lights()</code> function? We'll have to actually communicate with the outside world somehow; some actual piece of hardware.</p>
<p>Two specific pieces of hardware that could be useful here are the FTDI FT232H (most conveniently on a breakout board, such as the <a href="https://www.adafruit.com/products/2264">one made by Adafruit</a>) and the Bus Pirate Made by <a href="http://dangerousprototypes.com/docs/Bus_Pirate">Dangerous Prototypes</a>, available from several places</p>
<p>These two devices are somewhat different in many respects, but both of them may be described as a USB-attached board which has several digital logic IO pins on board. They each support a mode of operation whereby several pins on the board (16 in the FTDI's case, 5 in the Bus Pirate) can be controlled directly by the computer, setting them directly high or low as required by the program. In our case we only need 4 for the light patterns described above so either would be sufficient for our purposes.</p>
<p>The <a href="https://metacpan.org/module/Device::Chip">Device::Chip</a> module on CPAN describes an abstraction layer around various mechanisms that might be employed to talk to real hardware. It's still in its early phases yet so it doesn't have too many actual implementations, but it does support these two hardware boards. It exposes in each case an interface called a GPIO adapter (a "General Purpose Input/Output" - the most basic form of digital IO pin control), which allows us to directly control the high or low state of these pins.</p>
<p>Using this module we can obtain a object that represents the GPIO ability of the hardware and use the <code>write_gpios()</code> method on it to set the state of each GPIO pin. As a little technicality, because the <code>Device::Chip</code> distribution uses <a href="https://metacpan.org/module/Future">Future</a> to make it possible to use asynchronously we'll just have to call the <code>get()</code> method on the Future returned by <code>write_gpios()</code> to actually force it to run. We'll also have to make sure to use names of the GPIO pins that the particular device will recognise.</p>
<pre><code class="code-listing"><span class="comment"># Convert names of our strings of lights to GPIO pin names on<br /># the adapter<br /></span><span class="keyword">my</span> <span class="symbol">%CHAIN_TO_GPIO</span> <span class="operator">=</span> <span class="structure">(</span><br /><span class="comment"> # If we're using the FT232H<br /></span> <span class="word">A</span> <span class="operator">=></span> <span class="double">"D0"</span><span class="operator">,</span> <span class="word">B</span> <span class="operator">=></span> <span class="double">"D1"</span><span class="operator">,</span> <span class="word">C</span> <span class="operator">=></span> <span class="double">"D2"</span><span class="operator">,</span> <span class="word">D</span> <span class="operator">=></span> <span class="double">"D3"</span><span class="operator">,</span><br /><br /><span class="comment"> # If we're using the Bus Pirate<br /></span> <span class="word">A</span> <span class="operator">=></span> <span class="double">"MISO"</span><span class="operator">,</span> <span class="word">B</span> <span class="operator">=></span> <span class="double">"CS"</span><span class="operator">,</span> <span class="word">C</span> <span class="operator">=></span> <span class="double">"MOSI"</span><span class="operator">,</span> <span class="word">D</span> <span class="operator">=></span> <span class="double">"CLK"</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">set_lights</span><br /><span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span> <span class="symbol">$pattern</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /><span class="comment"> # $pattern says what light chains to turn on; we'll also<br /> # have to turn the others off<br /></span><br /> <span class="keyword">my</span> <span class="symbol">%want_chains</span> <span class="operator">=</span> <span class="word">map</span> <span class="structure">{</span> <span class="magic">$_</span> <span class="operator">=></span> <span class="number">0</span> <span class="structure">}</span> <span class="words">qw( A B C D )</span><span class="structure">;</span><br /> <span class="symbol">$want_chains</span><span class="structure">{</span><span class="magic">$_</span><span class="structure">}</span> <span class="operator">=</span> <span class="number">1</span> <span class="word">for</span> <span class="word">split</span> <span class="match">//</span><span class="operator">,</span> <span class="symbol">$pattern</span><span class="structure">;</span><br /><br /><span class="comment"> # Now convert to the pin names required by Device::Chip<br /></span> <span class="keyword">my</span> <span class="symbol">%gpios</span> <span class="operator">=</span> <span class="word">map</span> <span class="structure">{</span> <span class="symbol">$CHAIN_TO_GPIO</span><span class="structure">{</span><span class="magic">$_</span><span class="structure">}</span> <span class="operator">=></span> <span class="symbol">$want_chains</span><span class="structure">{</span><span class="magic">$_</span><span class="structure">}</span> <span class="structure">}</span><br /> <span class="word">keys</span> <span class="symbol">%want_chains</span><span class="structure">;</span><br /><br /> <span class="symbol">$gpio</span><span class="operator">-></span><span class="word">write_gpios</span><span class="structure">(</span> <span class="cast">\</span><span class="symbol">%gpios</span> <span class="structure">)</span><span class="operator">-></span><span class="word">get</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>All we need now to make our program complete is to initialise this <code>$gpio</code> object at the beginning by opening the actual hardware object. This too comes from <code>Device::Chip</code> using the handy utility constructor on the <a href="https://metacpan.org/module/Device::Chip::Adapter">Device::Chip::Adapter</a> class called <code>new_from_description()</code> to first obtain an object representing the hardware adapter itself, and then calling its <code>make_protocol()</code> method to switch it into GPIO mode and obtain an object specifically representing that.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Device::Chip::Adapter</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$adapter</span> <span class="operator">=</span> <span class="word">Device::Chip::Adapter</span><span class="operator">-></span><span class="word">new_from_description</span><span class="structure">(</span><br /> <span class="double">"FTDI"</span><span class="operator">,</span> <span class="comment"># Or BusPirate, or whatever...</span><br /><span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$gpio</span> <span class="operator">=</span> <span class="symbol">$adapter</span><span class="operator">-></span><span class="word">make_protocol</span><span class="structure">(</span> <span class="double">"GPIO"</span> <span class="structure">)</span><span class="operator">-></span><span class="word">get</span><span class="structure">;</span></code></pre>
<h3 id="The-Hardware">The Hardware</h3>
<p>Now we've got a method of controlling these digital IO lines from perl we can now consider how to actually attach to the actual light chains to it. These IO lines are only capable of controlling 3.3V or 5V up to about 20mA or so; nowhere near enough for some lights. "Low voltage" lights are likely 12 or 24V, and mains ones will run at either 230V or 110V, depending on local supply.</p>
<p>To do this we'll need some kind of adapting interface between the digital IO line and the light chain. For a low voltage chain of moderate current (such as a string of LEDs) we can probably use a single NPN transistor along with current-limiting resistor on the base:</p>
<center><img src="advent-f1.png" width="284" height="331"/></center>
<p>When the digital IO line is high it drives a current through the transistor (Q1) to ground which allows the transistor to conduct a larger current through the lamp chain, making it light up. When the line is low the base current stops and so the lamp chain goes off.</p>
<p>There's a limit to how much current we can switch using this arrangement though - any transistor acts much like a current multiplier; allowing a collector-emitter current to flow that is some multiple of the base-emitter current (usually of the order of 50 times as much). Because the digital IO line on our controller is probably only capable of 20mA or so, that limits our ability to switch lamps up to about 1A.</p>
<p>To achieve a higher current (perhaps because we have low-voltage incandescent bulbes) we'd likely want to use a pair of transistors in a Darlington arrangement. This arrangement has the effect of multiplying the current up twice - once through each transistor - meaning we could switch a much larger current; maybe up to 10A or so. This should be adequate most low-voltage lamps.</p>
<center><img src="advent-f2.png" width="356" height="347"/></center>
<p>These solutions will only work for low-voltage DC switching, not mains power. For mains-power switching you might consider using a relay, though they tend not to cope so well with faster switching such as required by these kinds of lights. The easiest and safest way to switch a mains-voltage but fairly low-current load is to use an opto-isolated triac. A full discussion of those is probably beyond the scope of this little article, but if you want to read more about that I'd suggest looking up "Arduino isolated triac", or other variants on that theme. Any sort of Arduino-related article is likely to be fairly relevant, being just digital IO switching at 3.3V or 5V; much as you'd get from these control boards presented above.</p>
<h2 id="SEE-ALSO">SEE ALSO</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Device::Chip">Device::Chip</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Device::Chip::Adapter">Device::Chip::Adapter</a></p>
</li>
<li><p><a href="https://www.adafruit.com/products/2264">FT232H on AdaFruit</a></p>
</li>
<li><p><a href="http://dangerousprototypes.com/docs/Bus_Pirate">The Bus Pirate</a></p>
</li>
</ul>
</div>2020-12-17T00:00:00ZPaul "LeoNerd" EvansSleigh Upgradehttp://perladvent.org/2020/2020-12-16.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Santa's little helpers had just completed an upgrade to his fleet of sleighs. Ruldoph was getting tired of lighting the way each night, and wanted a year off, so they'd <i>finally</i> fitted some headlights. They'd also updated their code to turn them on and off again automatically (so the batteries didn't wear out) whenever Santa took off:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">fly_to_next_house</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">1</span><span class="structure">);</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span><span class="operator">-></span><span class="word">set_destination</span><span class="structure">(</span> <span class="core">shift</span><span class="structure">(</span><span class="cast">@</span><span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">nice_list</span> <span class="structure">})</span><span class="operator">-></span><span class="word">address</span> <span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">fly_to_destination</span><span class="structure">(</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span> <span class="structure">);</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">0</span><span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>"I like it," said Santa, "but what happens though if the GPS doesn't know where the address is?"</p>
<p>"Hmmm", said the wise old elf, "well, it is running Apple Maps so I guess there <i>might</i> be a problem". "But", he continued, "not to worry. The set_destination method throws an exception and there's some <i>terribly</i> complicated code that catches it and deals with it in the routine that calls <code>fly_to_next_house</code>."</p>
<p>"Ha! The elves just look it up on Google Maps you mean.", Santa laughed, "Though that's not what I'm on about. Look: If the GPS throws an exception, can't you see the <b>lights never get turned off</b> because the code to do so won't be executed?"</p>
<p>"Oh crumbs", the elf conceded, "well, I guess we could use a localized variable to set the lights. Those are automatically unset at the end of the current scope no matter what - even if you do exit by an exception!"</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">fly_to_next_house</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">local</span> <span class="symbol">$Sliegh::Lights</span> <span class="operator">=</span> <span class="number">1</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span><span class="operator">-></span><span class="word">set_destination</span><span class="structure">(</span> <span class="core">shift</span><span class="structure">(</span><span class="cast">@</span><span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">nice_list</span> <span class="structure">})</span><span class="operator">-></span><span class="word">address</span> <span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">fly_to_destination</span><span class="structure">(</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Santa stroked his beard for a few minutes. Then he shook his head. "No, that's not going to work. For a starters you've mistyped 'Sleigh,' and since there's no error with misspelled fully qualified variables, the sleigh will end up flying me in the dark! Even if you fix that, this isn't going to work with one single variable controlling all the lights on every one of my sleighs."</p>
<p>"Oh, good point, "how about this then?"</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">fly_to_next_house</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">turn_lights_on_till_end_of_scope</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span><span class="operator">-></span><span class="word">set_destination</span><span class="structure">(</span> <span class="core">shift</span><span class="structure">(</span><span class="cast">@</span><span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">nice_list</span> <span class="structure">})</span><span class="operator">-></span><span class="word">address</span> <span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sleigh</span><span class="operator">-></span><span class="word">fly_to_destination</span><span class="structure">(</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">gps</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>"That's great! How did you do that?"</p>
<p>"Well, that's why they call me the <i>Wise</i> Old Elf"</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Sleigh</span><span class="structure">;</span><br /><span class="operator">...</span><br /><br /><span class="word">use</span> <span class="word">Scope::Upper</span> <span class="words">qw(reap UP)</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">turn_lights_on_till_end_of_scope</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /><span class="comment"> # turn on the lights<br /></span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">1</span><span class="structure">);</span><br /><br /><span class="comment"> # and turn them off again we exit our caller's scope<br /></span> <span class="word">reap</span> <span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">lights</span><span class="structure">(</span><span class="number">0</span><span class="structure">)</span> <span class="structure">}</span> <span class="word">UP</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Scope::Upper">Scope::Upper</a></p>
</li>
</ul>
</div>2020-12-16T00:00:00ZMark FowlerA Christmas Memoryhttp://perladvent.org/2020/2020-12-15.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>"I just don't get it!"</p>
<p>An elf raising his voice was unheard of. Normally softly spoken, Cedar Greentrifle was several decibels above where his voice should have been and getting louder.</p>
<p>"Mr Greentrifle", the Wise Old Elf interjected, "May I be of some assistance?"</p>
<p>"It's this baubling code! It keeps eating all the memory. And I can't work out why!"</p>
<p>"Ah, then maybe this might be a good time to show you a tool I learned about at the London Perl Workshop that might be just the ticket!"</p>
<h3 id="Introducing-Devel::MAT">Introducing Devel::MAT</h3>
<p>Devel::MAT is a handy dandy command line tool that can help you work out exactly what is taking up the memory in your Perl program. You can trigger a dump summarizing your program's memory usage at any point in the execution, then load up the <code>pmat</code> console and poke around in that dump to your heart's content until you figure out exactly what went wrong.</p>
<p>Let's see how to use it on a simple example program that's going to allocate a <b>huge</b> string.</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">$elf</span> <span class="operator">=</span> <span class="double">"happy"</span><span class="structure">;</span><br /><span class="symbol">$elf</span> <span class="operator">x=</span> <span class="number">1024</span><span class="operator">*</span><span class="number">1024</span><span class="operator">*</span><span class="number">1024</span><span class="structure">;</span> <span class="comment"># 5 Gigs!</span></code></pre>
<p>In order to analyze the memory usage in our code we need to alter it so that it dumps a summary of the memory to a <i>pmat</i> dump file during the execution of the code. The simplest way to do this is to add a <code>die</code> statement...</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">$elf</span> <span class="operator">=</span> <span class="double">"happy"</span><span class="structure">;</span><br /><span class="symbol">$elf</span> <span class="operator">x=</span> <span class="number">1024</span><span class="operator">*</span><span class="number">1024</span><span class="operator">*</span><span class="number">1024</span><span class="structure">;</span> <span class="comment"># 5 Gigs!</span><br /><br /><span class="word">die</span><span class="structure">;</span></code></pre>
<p>..then run the same code with the Devel::MAT::Dumper module configured on the command line to hook exception handling so that a dump file is written when the die occurs:</p>
<pre><code> shell$ perl -MDevel::MAT::Dumper=-dump_at_DIE script.pl
Dumping to /Users/Cedar/test/script.pl.pmat because of DIE
Died at script.pl line 9.</code></pre>
<p>This creates a <i>pmat</i> dump file on disk named the same as our Perl script with an additional <code>.pmat</code> extension:</p>
<pre><code> shell$ ls
script.pl script.pl.pmat</code></pre>
<p>We can load this into the <code>pmat</code> interactive console</p>
<pre><code> shell$ pmat script.pl.pmat
Perl memory dumpfile from perl 5.22.0
Heap contains 2366 objects
pmat></code></pre>
<p>And away we go. <code>pmat</code> offers a bunch of commands, all of which can be listed with the <code>help</code> option.</p>
<pre><code> pmat> help
callstack - Display the call stack
count - Count the various kinds of SV
elems - List the elements of an ARRAY SV
find - List SVs matching given criteria
help - Display a list of available commands
identify - Identify an SV by its referrers
io - Commands working with IO SVs
largest - Find the largest SVs by size
roots - Display a list of the root SVs
show - Show information about a given SV
sizes - Summarize object and byte counts across different SV types
symbols - Display a list of the symbol table
values - List the values of a HASH-like SV</code></pre>
<h3 id="Tracking-down-the-largest-things-in-your-code">Tracking down the largest things in your code</h3>
<p>The <code>largest</code> command can be very helpful in tracking down what's taking up the most space:</p>
<pre><code> pmat> largest
SCALAR(PV) at 0x7fab7d016a60: 5.0 GiB
HASH(540) at 0x7fab7d002e90=strtab: 33.6 KiB
INVLIST() at 0x7fab7e01bf88: 9.9 KiB
INVLIST() at 0x7fab7e01c018: 9.8 KiB
STASH(84) at 0x7fab7d0030d0=defstash: 3.1 KiB
others: 228.5 KiB</code></pre>
<p>There's our string, right there at the top: <code>0x7fab7d016a60</code>. Because our example code was so simple we already know which scalar that is. But, if we didn't, we could easily ask pmat to identify it for us</p>
<pre><code> pmat> identify 0x7fab7d016a60
SCALAR(PV) at 0x7fab7d016a60 is:
\-the lexical $elf at depth 1 of CODE() at 0x7fab7d003478=main_cv, which is:
\-the main code</code></pre>
<p>Oh, that's obvious. If our code is a little more complex then things are still descriptive enough for us to understand what's happening. For example:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">santas_workshop</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$phrase</span> <span class="operator">=</span> <span class="double">"happy"</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$elf</span> <span class="operator">=</span> <span class="structure">{</span><br /> <span class="word">attributes</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">mood</span> <span class="operator">=></span> <span class="word">scalar</span><span class="structure">(</span><span class="symbol">$phrase</span> <span class="operator">x</span> <span class="structure">(</span><span class="number">1024</span><span class="operator">*</span><span class="number">1024</span><span class="operator">*</span><span class="number">1024</span><span class="structure">))</span><span class="operator">,</span><br /> <span class="word">height</span> <span class="operator">=></span> <span class="single">'short'</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">name</span> <span class="operator">=></span> <span class="single">'Cedar Greentrifle'</span><br /> <span class="structure">};</span><br /><br /> <span class="word">die</span><span class="structure">();</span><br /><span class="structure">}</span></code></pre>
<p>Results in the identification:</p>
<pre><code> pmat> identify 0x7f9f9b011860
SCALAR(PV) at 0x7f9f9b011860 is:
\-value {state} of HASH(1) at 0x7f9f9b003250, which is:
\-(via RV) value {attr} of HASH(1) at 0x7f9f9b011878, which is:
\-(via RV) the lexical $elf at depth 1 of CODE(PP) at 0x7f9f9b016a78, which is:
\-the symbol '&main::santas_workshop'</code></pre>
<p>So, we can easily identify large strings. What about big data structures</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">sub</span> <span class="word">expand</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$count</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">()</span> <span class="operator">-</span> <span class="number">1</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="double">"Merry Christmas"</span> <span class="word">if</span> <span class="symbol">$count</span> <span class="operator">==</span> <span class="number">0</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="structure">{</span><br /> <span class="word">map</span> <span class="structure">{</span> <span class="magic">$_</span> <span class="operator">=></span> <span class="word">expand</span><span class="structure">(</span><span class="symbol">$count</span><span class="structure">)</span> <span class="structure">}</span> <span class="number">1</span><span class="operator">..</span><span class="number">10</span><br /> <span class="structure">};</span><br /><span class="structure">}</span><br /><br /><span class="keyword">my</span> <span class="symbol">$big_data_structure</span> <span class="operator">=</span> <span class="word">expand</span><span class="structure">(</span><span class="number">6</span><span class="structure">);</span><br /><span class="word">die</span><span class="structure">();</span></code></pre>
<p>This creates a tree with a million copies of the string <code>Merry Christmas</code> in it. What does <code>pmat</code> make of this?</p>
<pre><code> Perl memory dumpfile from perl 5.22.0
Heap contains 124628 objects
pmat> largest
HASH(548) at 0x7fb053002e90=strtab: 33.9 KiB
INVLIST() at 0x7fb053085f88: 9.9 KiB
INVLIST() at 0x7fb053086018: 9.8 KiB
STASH(85) at 0x7fb0530030d0=defstash: 3.2 KiB
HASH(70) at 0x7fb0530217c8: 2.7 KiB
others: 10.4 MiB</code></pre>
<p>Not so helpful, the largest thing is the <code>strtab</code> (the cache of constant strings used in our code itself.) Not very helpful.</p>
<p>This is where the <code>--owned</code> option for <code>largest</code> comes in handy. This takes a while to execute, but it can work out cumulative sizes.</p>
<pre><code> pmat> largest --owned
CODE() at 0x7fb053003478=main_cv: 10.2 MiB: of which
| PAD(3) at 0x7fb053003490: 10.2 MiB: of which
| | REF() at 0x7fb053016ad8: 10.2 MiB
| | HASH(10) at 0x7fb053011950: 10.2 MiB
| | others: 10.2 MiB
| SCALAR(UV) at 0x7fb053016a60: 24 bytes
STASH(85) at 0x7fb0530030d0=defstash: 70.4 KiB: of which
| GLOB(%*) at 0x7fb053017918: 22.6 KiB: of which
| | STASH(2) at 0x7fb053021678: 22.4 KiB
| | GLOB(%*) at 0x7fb053034d48: 22.1 KiB
| | others: 22.1 KiB
| GLOB(%*) at 0x7fb053080b20: 14.6 KiB: of which
| | STASH(39) at 0x7fb053080b38: 14.5 KiB
| | GLOB(&*) at 0x7fb055015de0: 2.4 KiB
| | others: 12.7 KiB
| GLOB(%*) at 0x7fb0530809e8: 3.9 KiB: of which
| | STASH(3) at 0x7fb053080a60: 3.8 KiB
| | GLOB(&*) at 0x7fb053080ad8: 3.3 KiB
| | others: 3.3 KiB
| others: 26.1 KiB
HASH(548) at 0x7fb053002e90=strtab: 33.9 KiB
REF() at 0x7fb053085fb8: 10.0 KiB: of which
| ARRAY(5) at 0x7fb053085fd0: 10.0 KiB: of which
| | INVLIST() at 0x7fb053085f88: 9.9 KiB
| | SCALAR(UV) at 0x7fb053085fa0: 24 bytes
REF() at 0x7fb0530f1450: 9.9 KiB: of which
| ARRAY(5) at 0x7fb053085fe8: 9.9 KiB: of which
| | INVLIST() at 0x7fb053086018: 9.8 KiB
| | SCALAR(UV) at 0x7fb0530f1438: 24 bytes
others: 162.8 KiB</code></pre>
<p>So the largest thing is unsurprisingly the main code. It owns a <code>REF()</code> to a data structure at <code>0x7fb053016ad8</code> that is just over ten megabytes in size. And if we identify that:</p>
<pre><code> pmat> identify 0x7fb053016ad8
REF() at 0x7fb053016ad8 is:
\-the lexical $big_data_structure at depth 1 of CODE() at 0x7fb053003478=main_cv, which is:
-\the main code</code></pre>
<p>...we see it's the <code>$big_data_structure</code> we were expecting.</p>
<h3 id="Tracking-Down-Leaks">Tracking Down Leaks</h3>
<p>Perl uses reference counting to keep track of memory. When a data structure has nothing pointing to it anymore (i.e. no variables point to it, no other parts of a data structure point at it) it's unreachable by the program and can be cleared away.</p>
<p>But what happens if we have a data structure point to itself?</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$greeting</span><span class="structure">;</span><br /><span class="symbol">$greeting</span> <span class="operator">=</span> <span class="structure">{</span><br /> <span class="word">data</span> <span class="operator">=></span> <span class="single">'Merry Christmas'</span><span class="operator">,</span><br /> <span class="word">link</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$greeting</span><span class="operator">,</span><br /><span class="structure">};</span></code></pre>
<p>Perl will never be able to reclaim that. The anonymous hash will always be pointed to by the hash value, and the hash value will always be pointed to by the anonymous hash. When <code>$greeting</code> goes out of scope this will leak memory. Do that enough times and this will be the source of the extra memory your program is using.</p>
<p>How can we find these? It's tricky. If the data structure is large enough we can use the <code>largest</code> technique above. Otherwise, we can search for things in the data structure to see if we've got more of these still hanging around than we might expect. For example:</p>
<pre><code> pmat> find pv --eq 'Merry Christmas'
SCALAR(PV) at 0x7fa2d56e3330: "Merry Christmas"
SCALAR(PV) at 0x7fa2d54fa2d0: "Merry Christmas"
SCALAR(PV) at 0x7fa2d57a0588: "Merry Christmas"
SCALAR(PV) at 0x7fa2d5052890: "Merry Christmas"
SCALAR(PV) at 0x7fa2d3901790: "Merry Christmas"
SCALAR(PV) at 0x7fa2d29b26a0: "Merry Christmas"
SCALAR(PV) at 0x7fa2d518f440: "Merry Christmas"
SCALAR(PV) at 0x7fa2d579dae0: "Merry Christmas"
SCALAR(PV) at 0x7fa2d391f868: "Merry Christmas"
SCALAR(PV) at 0x7fa2d2c7a2a8: "Merry Christmas"
SCALAR(PV) at 0x7fa2d5259f48: "Merry Christmas"
SCALAR(PV) at 0x7fa2d2c7b1a8: "Merry Christmas"
SCALAR(PV) at 0x7fa2d297ae00: "Merry Christmas"
SCALAR(PV) at 0x7fa2d2a53528: "Merry Christmas"
SCALAR(PV) at 0x7fa2d510f6a0: "Merry Christmas"
SCALAR(PV) at 0x7fa2d55ce980: "Merry Christmas"
SCALAR(PV) at 0x7fa2d401d0d8: "Merry Christmas"
...</code></pre>
<p><code>identify</code> can tell us a little about each of these scalars (including that it has a loop), but obviously not which variable holds them (because none does):</p>
<pre><code> pmat> identify 0x7fa2d56e3330
SCALAR(PV) at 0x7fa2d56e3330 is:
\-value {data} of HASH(2) at 0x7fa2d56e3300, which is (*A):
\-(via RV) the referrant of REF() at 0x7fa2d56e3348, which is:
\-value {link} of HASH(2) at 0x7fa2d56e3300, which is:
\-already found as *A</code></pre>
<p>You might be tempted to search for a hash key. This won't go as well:</p>
<pre><code> pmat> find pv --eq 'data'
SCALAR(PV) at 0x7fa2d2003340: "data"
pmat> identify 0x7fa2d2003340
SCALAR(PV) at 0x7fa2d2003340 is:
\-a constant of CODE() at 0x7fa2d2003478=main_cv, which is:
\-the main code</code></pre>
<p>That's because internally perl doesn't keep a copy of the hash key inside each hash - the one and only scalar containing <code>data</code> is the one perl created for the constant string used in the code itself.</p>
<h3 id="A-Happy-Elf">A Happy Elf</h3>
<p>"I GOT IT I GOT IT I GOT IT"</p>
<p>"Mr Greentrifle! Please keep the noise down..."</p>
</div>2020-12-15T00:00:00ZMark FowlerTie::Filehttp://perladvent.org/2020/2020-12-14.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Have you ever wanted to use Perl to change a line in the middle of a data file? While this may sound like a trivial thing for a human to do (or for a text editor) it's actually quite hard to do programmatically.</p>
<p>While you and I think of a text file as many separate lines of data, as far as the computer is concerned the file is just a big collection of characters, one after the other. Perl can read in lines at a time by scanning for the special delimiting return characters, but changing it another story - one that involves much copying of data to make space for the data you're adding in or to remove the space the data you took out was taking up.</p>
<p>What we need is a module that takes away the pain of dealing with a file and understands that if we want to insert a line, then it should silently do all the copying and manipulating and all the other complex stuff we don't want to think of ourselves for us.</p>
<p>This is where <b>Tie::File</b> is useful. It lets us treat a file just as if it was a big array of lines that we can manipulate at will. Suddenly, editing files becomes trivial and we don't have to worry about all the things that suddenly seemed so hard before. Isn't this what Perl modules are all about?</p>
<p><b>Tie::File</b> uses Perl's tie interface. This means that we 'tie' an object to a data structure - in this case an array. Every time we do something to the array rather than manipulating a real array it calls methods on the object. In the case of <b>Tie::File</b> this object manipulates the underlying file that we're editing.</p>
<p>Each entry in the array represents a single line of the file, so removing or adding lines removes or adds lines to the file, and changing lines changes the corresponding line in the file.</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><br /><span class="comment"># turn on Perl's safety features<br /></span><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><span class="readline"></pre></span><br /><br /><span class="comment"># tie the file 'file' to the array '@file'. From this point<br /># on the lines of 'file' are the entries in @file and vice versa<br /></span><span class="word">use</span> <span class="word">Tie::File</span><span class="structure">;</span><br /><span class="word">tie</span> <span class="word">my</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="double">"Tie::File"</span><span class="operator">,</span> <span class="double">"file"</span><span class="structure">;</span><br /><br /><span class="comment"># add a line to the end of the file<br /></span><span class="word">push</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="double">"Program starting at: "</span><span class="operator">.</span><span class="word">time</span></code></pre>
<p>Note how we don't bother ending the string we're pushing onto the array with a new line character - there's no need, each line is a new line in itself. However having said that, ending the line with a 'superfluous' newline is also perfectly acceptable - it'll just be silently removed. So:></p>
<pre><code class="code-listing"><span class="comment"># add a line to the end of the file<br /></span><span class="word">push</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="double">"Program starting at: "</span><span class="operator">.</span> <span class="word">time</span> <span class="operator">.</span> <span class="double">"\n"</span><span class="structure">;</span></code></pre>
<p>Would have be equally okay. We can also read in lines as you might expect:</p>
<pre><code class="code-listing"><span class="word">print</span> <span class="double">"The last line of the file is: $file[-1]\n"</span><span class="structure">;</span></code></pre>
<p>While adding a line to the end of a file isn't that complicated consider adding data to the start of a file. With <b>Tie::File</b> it's this simple:</p>
<pre><code class="code-listing"><span class="comment"># add a line to the start of the file<br /></span><span class="word">unshift</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="double">"Program Log"</span><span class="structure">;</span></code></pre>
<p>This is a much harder operation to code in straight Perl. If you want to add data to the start of the file the simplest way to do this is to create a new file, write the line to it, copy the whole contents of the old file onto the end of the new file, then rename it to be the same name as the original file. The code to do that is:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">IO::AtomicFile</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">IO::File</span><span class="structure">;</span><span class="readline"></pre></span><br /><br /><span class="comment"># open the files one for reading and one for writing<br /></span><span class="word">my</span> <span class="symbol">$original</span> <span class="operator">=</span> <span class="word">IO::File</span><span class="operator">-></span><span class="structure">;</span><span class="word">new</span><span class="structure">(</span><span class="double">"file"</span><span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"Can't write to 'file': $!"</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$changed</span> <span class="operator">=</span> <span class="word">IO::AtomicFile</span><span class="operator">-></span><span class="structure">;</span><span class="word">new</span><span class="structure">(</span><span class="double">"file"</span><span class="operator">,</span><span class="double">">"</span><span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"Can't write to 'file.TMP': $!"</span><span class="structure">;</span><br /><br /><span class="comment"># add the line<br /></span><span class="word">print</span> <span class="structure">{</span><span class="symbol">$changed</span><span class="structure">}</span> <span class="double">"Program Log\n"</span><span class="structure">;</span><br /><br /><span class="comment"># copy the rest of the data<br /></span><span class="word">print</span> <span class="structure">{</span><span class="symbol">$changed</span><span class="structure">}</span> <span class="magic">$_</span> <span class="word">while</span> <span class="structure">(</span><span class="symbol">&lt</span><span class="structure">;</span><span class="symbol">$original&gt</span><span class="structure">;);</span></code></pre>
<p>And that's with <b>IO::AtomicFile</b> doing the renaming of the file when we're done writing it for us! You can can see how much easier <b>Tie::File</b> is making our life already. Changing lines in the middle of files can be even more problematic, however with <b>Tie::File</b> we can simply rewrite individual lines by changing the contents of the array for that line:</p>
<pre><code class="code-listing"><span class="comment"># change the 13th line to say it's unlucky<br /></span><span class="symbol">$file</span><span class="structure">[</span><span class="number">12</span><span class="structure">]</span> <span class="operator">=</span> <span class="double">"I'm unlucky, oh woe is me"</span><span class="structure">;</span><br /><br /><span class="comment"># change every mention of Christmas to Xmas in the 10th line<br /></span><span class="symbol">$file</span><span class="structure">[</span><span class="number">9</span><span class="structure">]</span> <span class="operator">=~</span> <span class="substitute">s/Christmas/Xmas/gi</span><span class="structure">;</span></code></pre>
<p>In the last line of the above example we see a substitution showing that we can read data in and write new data out and <b>Tie::File</b> deals with all the complexities for us. Even better that this, we can make use of some little known but very useful feature of Perl's <code>foreach</code> loop to do the same kind of substitution over the entire file:</p>
<pre><code class="code-listing"><span class="comment"># run over '@file' making '$line' the current line each loop<br /></span><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$line</span> <span class="structure">(</span><span class="symbol">@file</span><span class="structure">)</span><br /><span class="structure">{</span><br /> <span class="word">print</span> <span class="double">"Old line was: $line\n"</span><span class="structure">;</span><br /> <br /><span class="comment"> # change the line<br /></span> <span class="symbol">$line</span> <span class="operator">=~</span> <span class="substitute">s/Christmas/Xmas/gi</span><span class="structure">;</span><span class="readline"></pre></span><br /><br /> <span class="word">print</span> <span class="double">"New line is: $line\n"</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>Because <code>$line</code> isn't assigned the value of the element of <code>@file</code> we're dealing with - it <i>is</i> the line - it's an <i>implicit alias</i>, changing <code>$line</code> will actually change the original element in <code>@file</code> which in reality will change the line in the file.</p>
<p>Adding lines and deleting lines in the middle of the file with <b>Tie::File</b> is a little harder than simply editing them - mostly because we get to use the oft misunderstood <code>splice</code> operator on the array (though it's a lot easier than trying to read it in and write it out again.) To remove lines with splice we simply need to state the array, the index of what we want to remove and how many lines we want to remove.</p>
<pre><code class="code-listing"><span class="comment"># remove the 10th line from the file<br /></span><span class="word">splice</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="number">9</span><span class="operator">,</span> <span class="number">1</span><span class="structure">;</span><br /><br /><span class="comment"># remove the 12th, 13th and 14th line from the file<br /></span><span class="word">splice</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="number">11</span><span class="operator">,</span> <span class="number">3</span><span class="structure">;</span></code></pre>
<p>To replace lines from the file we simply add in replacement lines at the end of the splice operation.</p>
<pre><code class="code-listing"><span class="comment"># remove the 12th, 13th and 13th line from the file<br /># and replace the three of them with two new lines<br /></span><span class="word">splice</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="number">11</span><span class="operator">,</span> <span class="number">3</span><span class="operator">,</span> <span class="double">"First Replacement Line"</span><span class="operator">,</span><br /> <span class="double">"Second Replacement Line"</span><span class="structure">;</span></code></pre>
<p>To just insert lines instead of replacing them all we need to do is set the third argument to <code>splice</code> - the number of lines to be removed - to zero.</p>
<pre><code class="code-listing"><span class="comment"># insert two lines after the 11th line before the 12th<br /></span><span class="word">splice</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="number">11</span><span class="operator">,</span> <span class="number">0</span><span class="operator">,</span> <span class="double">"First Replacement Line"</span><span class="operator">,</span><br /> <span class="double">"Second Replacement Line"</span><span class="structure">;</span></code></pre>
<h3 id="Under-The-Hood">Under The Hood</h3>
<p>Of course, <b>Tie::File</b> actually has to manipulate the file itself somewhat like we described in the long winded example above. In order to do this with some semblance of efficiency it will attempt to cache a little (but not too much) of the file in memory. You can control how much memory it will use when you tie the file:</p>
<pre><code class="code-listing"><span class="comment"># use lots and lots of memory<br /></span><span class="word">tie</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="single">'Tie::File'</span><span class="operator">,</span> <span class="symbol">$file</span><span class="operator">,</span> <span class="word">memory</span> <span class="operator">=></span> <span class="number">20_000_000</span><span class="structure">;</span></code></pre>
<p>One trick that you might want to employ if you've got multiple programs running at the same time is to turn off all this caching. This will cause the program to read the file every time you read from the array - vital if another program may have written to it and cached data might be wrong by now.</p>
<pre><code class="code-listing"><span class="comment"># don't cache - other programs may be writing to <br /># the file so our cached data might be wrong!<br /></span><span class="word">tie</span> <span class="symbol">@file</span><span class="operator">,</span> <span class="single">'Tie::File'</span><span class="operator">,</span> <span class="symbol">$file</span><span class="operator">,</span> <span class="word">memory</span> <span class="operator">=></span> <span class="number">0</span><span class="structure">;</span></code></pre>
<p>If you're interested in having multiple files access the file you should take a look at <b>Tie::File</b>'s <code>flock</code> method.</p>
<p>There's lots of other good features that <b>Tie::File</b> offers. One wonderful feature is deferred writing, where changes aren't written to disk immediately. This is useful if you're editing the same parts of the file over and over (so the changes only have to be written once) but of course raises issues like what happens if your program crashes before the write cache is flushed. More details on this and other features are in the wonderful manual page.</p>
<p><ul> <li><a href="https://metacpan.org/pod/Tie::File">Tie::File</a></li> <li><a href="http://perl.plover.com/yak/tiefile/">MJD's Tie::File Talk Slides</a></li> <li><a href="http://www.perldoc.com/perl5.8.0/pod/perltie.html">perltie documentation</a></li></p> </ul>
</p>
</div>2020-12-14T00:00:00ZMark FowlerGrowing Christmas Treeshttp://perladvent.org/2020/2020-12-13.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Twinkly the elf was in a bit of a panic. She had been given the job of producing a series of designs for this year's North Pole Christmas cards. So far she had made no progress. And the print deadline was approaching fast.</p>
<p>The problem was just too complex. It wasn't just a case of taking a mildly embarrassing photo of the Clauses and then printing that on hundreds of cards. No, Santa had decided that he didn't want a photo this year. He wanted cute graphics of Christmas trees. Also (and this was the hard part), he wanted dozens of different designs with different numbers of tree and tree of many different sizes. There just wasn't time to create that many designs.</p>
<p>Twinkly was having coffee with the Wise Old Elf in the North Pole Canteen when she mentioned her problem to him. He suggested that she used SVG to produce the images. Twinkly had never heard of SVG, so she did some research.</p>
<h3 id="Two-Types-of-Graphics">Two Types of Graphics</h3>
<p>Most image files that we come across every day are <b>raster</b> images. Basically, the image is made up of a two-dimensional grid of points (called <b>picture elements</b> or <b>pixels</b>). Each pixel is set to be a particular colour and when we look at the complete set of coloured pixels, we see it as an image.</p>
<p>Raster images are great for many uses. All of the JPG and PNG and GIF images that you come across every say on the internet are raster images. But they have a couple of downsides - one of which is that they don't scale very well. When you view a raster image at the intended size, you don't see the individual pixels. But as you scale up the image, there will come a point where each pixel becomes large enough to be seen. Initially, you might notice that a straight edge starts to look a bit jagged. Eventually, you'll see every pixel and the image turns into an unrecognisable pile of squares.</p>
<p>Vector images are different. Vector images don't contain instructions saying that "this pixel is red" or "that pixel is blue". They contain higher level instructions like "draw a red circle with this radius, centred on this point". And as you scale up the drawing area, those instructions remain just as valid. You'll get a bigger circle, but one that is still drawn with sharp edges.</p>
<p>SVG (for "Scalable Vector Graphics") is an XML format for describing vector graphics. It has become very popular on the web and many browsers now have build-in support for displaying SVG images.</p>
<p>Not all images are suitable for being represented in the SVG format. As an SVG image is made up of lots (possibly hundreds) of shapes, something like a photo doesn't really work in this format. But if you can describe your image in terms of the shapes that make it up, then it would be a good candidate for being turned into an SVG document.</p>
<p>For example, a cartoon representation of a Christmas tree.</p>
<h3 id="Varying-the-Design">Varying the Design</h3>
<p>But that only gets us part of the way there. Twinkly needs to produce many different designs of her Christmas tree. How does SVG help us there?</p>
<p>An SVG document isn't so much a description of an image. It's more of a recipe that tells you how to produce the image. And when you have a recipe, it's easy to vary parts of the recipe in order to vary the results we get out at the end. So we need to write a program which generates various different Christmas trees, depending on its input parameters. And, luckily, there is a CPAN module called SVG which we can use to output SVG documents.</p>
<p>Let's think a little about what we need to draw a Christmas tree. I'm planning on something like this:</p>
<center><img src="shapes.jpg" width="332" height="500" border="1"></center>
<p>The main tree is four triangles. There's a brown rectangle at the bottom for the trunk and, below that, a red trapezium for the pot and, finally, a few circular baubles hanging from the branches. All of these can be described in terms of simple shapes and, therefore, can represented in SVG.</p>
<p>What variables might we want to alter.</p>
<ul>
<li>The number of triangles in the body of the tree.</li>
<li>The colour of the body of the tree</li>
<li>The length of the trunk.</li>
<li>The colour of the bauble..</li>
</ul>
<p>(There are probably more that you can think of, but these will be enough to solve Twinkly's current problem.)</p>
<p>Twinkly set to on this task and quickly managed to write code to draw some shapes that looked like a tree. And then, she bundled the code up into a Moose class, called <a href="https://metacpan.org/module/SVG::ChristmasTree">SVG::ChristmasTree</a>, which she uploaded to CPAN. Like most classes, this class starts by loading Moose and defining some attributes. The most important attribute is the one that contains the SVG object itself.</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">svg</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="single">'SVG'</span><span class="operator">,</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="single">'ro'</span><span class="operator">,</span><br /> <span class="word">lazy_build</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">_build_svg</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="word">SVG</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">width</span> <span class="operator">=></span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">width</span><span class="operator">,</span><br /> <span class="word">height</span> <span class="operator">=></span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">height</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Then there are a number of attributes that define the various characteristics of the tree that we might want to change. Here are some examples:</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">layers</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="single">'Int'</span><span class="operator">,</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="single">'ro'</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="number">4</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">trunk_length</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="single">'Str'</span><span class="operator">,</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="single">'ro'</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">leaf_colour</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">isa</span> <span class="operator">=></span> <span class="single">'Str'</span><span class="operator">,</span><br /> <span class="word">is</span> <span class="operator">=></span> <span class="single">'ro'</span><span class="operator">,</span><br /> <span class="word">default</span> <span class="operator">=></span> <span class="single">'rgb(0,127,0)'</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>There's a main driver method that actually draws the tree.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">as_xml</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$self</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">pot</span><span class="structure">;</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">trunk</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$width</span> <span class="operator">=</span> <span class="number">600</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$tri_bottom</span> <span class="operator">=</span> <span class="number">700</span><span class="structure">;</span><br /> <span class="keyword">for</span> <span class="structure">(</span><span class="number">1</span> <span class="operator">..</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">layers</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$h</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">triangle</span><span class="structure">(</span><span class="number">90</span><span class="operator">,</span> <span class="symbol">$width</span><span class="operator">,</span> <span class="symbol">$tri_bottom</span><span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">bauble</span><span class="structure">(</span><span class="number">500</span> <span class="operator">-</span> <span class="structure">(</span><span class="symbol">$width</span><span class="operator">/</span><span class="number">2</span><span class="structure">)</span><span class="operator">,</span> <span class="symbol">$tri_bottom</span><span class="structure">);</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">bauble</span><span class="structure">(</span><span class="number">500</span> <span class="operator">+</span> <span class="structure">(</span><span class="symbol">$width</span><span class="operator">/</span><span class="number">2</span><span class="structure">)</span><span class="operator">,</span> <span class="symbol">$tri_bottom</span><span class="structure">);</span><br /> <span class="symbol">$width</span> <span class="operator">*=</span> <span class="number">5</span><span class="operator">/</span><span class="number">6</span><span class="structure">;</span><br /> <span class="symbol">$tri_bottom</span> <span class="operator">-=</span> <span class="structure">(</span><span class="symbol">$h</span> <span class="operator">*</span> <span class="float">.5</span><span class="structure">)</span><br /> <span class="structure">}</span><br /><br /> <span class="keyword">return</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">svg</span><span class="operator">-></span><span class="word">xmlify</span><span class="structure">;</span><br /> <span class="structure">}</span></code></pre>
<p>This just calls various lower-level methods which draw the individual shapes that make up the tree before, finally, calling <code>xmlify</code> on the SVG attribute which actually produces the XML output that describes the tree.</p>
<p>As most of the parts of the tree are just coloured shapes, there's a method called <code>coloured_shape</code> which does most of that work.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">coloured_shape</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="structure">(</span><span class="symbol">$x</span><span class="operator">,</span> <span class="symbol">$y</span><span class="operator">,</span> <span class="symbol">$colour</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$path</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">svg</span><span class="operator">-></span><span class="word">get_path</span><span class="structure">(</span><br /> <span class="word">x</span> <span class="operator">=></span> <span class="symbol">$x</span><span class="operator">,</span><br /> <span class="word">y</span> <span class="operator">=></span> <span class="symbol">$y</span><span class="operator">,</span><br /> <span class="word">-type</span> <span class="operator">=></span> <span class="single">'polyline'</span><span class="operator">,</span><br /> <span class="word">-closed</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">svg</span><span class="operator">-></span><span class="word">polyline</span><span class="structure">(</span><br /> <span class="cast">%</span><span class="symbol">$path</span><span class="operator">,</span><br /> <span class="word">style</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">fill</span> <span class="operator">=></span> <span class="symbol">$colour</span><span class="operator">,</span><br /> <span class="word">stroke</span> <span class="operator">=></span> <span class="symbol">$colour</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">);</span><br /> <span class="structure">}</span></code></pre>
<p>This takes three arguments: an array of X points, an array of Y points and a colour. It uses the <a href="https://metacpan.org/module/SVG">SVG</a> modules, <code>get_path</code> and <code>polyline</code> methods to turn the X and Y co-ordinates into an SVG polyline element which it then adds to the SVG image.</p>
<p>Finally, one of the methods that uses <code>coloured_shape</code> looks like this. This is the <code>pot</code> method (so notice that, currently, the co-ordinates are all fixed values).</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">pot</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">coloured_shape</span><span class="structure">(</span><br /> <span class="structure">[</span> <span class="number">400</span><span class="operator">,</span> <span class="number">350</span><span class="operator">,</span> <span class="number">650</span><span class="operator">,</span> <span class="number">600</span> <span class="structure">]</span><span class="operator">,</span><br /> <span class="structure">[</span> <span class="number">1000</span><span class="operator">,</span> <span class="number">800</span><span class="operator">,</span> <span class="number">800</span><span class="operator">,</span> <span class="number">1000</span> <span class="structure">]</span><span class="operator">,</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">pot_colour</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>To create a Christmas tree you just need to create an object and call its <code>as_xml</code> method:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">SVG::ChristmasTree</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$tree</span> <span class="operator">=</span> <span class="word">SVG::ChristmasTree</span><span class="structure">;</span><br /><span class="word">print</span> <span class="symbol">$tree</span><span class="operator">-></span><span class="word">as_xml</span><span class="operator">.</span></code></pre>
<p>Which renders in the browser like so:</p>
<center><img src="tree.svg" width="500" height="436"></center>
<p>If you want to vary the attributes, you do that as you create the object.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$tree</span> <span class="operator">=</span> <span class="word">SVG::ChristmasTree</span><span class="operator">-></span><span class="word">new</span><span class="structure">({</span><br /> <span class="word">layers</span> <span class="operator">=></span> <span class="number">6</span><span class="operator">,</span><br /> <span class="word">leaf_colour</span> <span class="operator">=></span> <span class="single">'rgb(0,255,0)'</span><span class="operator">,</span><br /><span class="structure">})</span></code></pre>
<p>(Notice that the colour attributes are defined using SVG's standard RGB notation.)</p>
<p>Twinkly wanted to make her life as easy as possible, so she decided to write a <code>tree</code> program that did all this for her. She was about to write a pile of command-line parsing code in order to handle all of the attributes when she remembered the existence of <code>MooseX::Getopt</code> which did all of that for her. She simple had to add the following line to her class:</p>
<pre><code class="code-listing"><span class="word">with</span> <span class="word">MooseX::Getopt</span><span class="structure">;</span></code></pre>
<p>And, then, in her <code>tree</code> program, she replaced the call to <code>new()</code> with one to <code>new_with_options()</code>. Her code now looks like this.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">SVG::ChristmasTree</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$tree</span> <span class="operator">=</span> <span class="word">SVG::ChristmasTree</span><span class="operator">-></span><span class="word">new_with_options</span><span class="structure">;</span><br /><span class="word">say</span> <span class="symbol">$tree</span><span class="operator">-></span><span class="word">as_xml</span><span class="structure">;</span></code></pre>
<p>And she can call her program like this:</p>
<pre><code> $ ./tree --layers=6 --leaf_colour='rgb(0,255,0)'</code></pre>
<p>The Moose extension handles passing the command line options on to the object constructors. It even knows what the valid options are and displays a helpful message if you try to use an invalid one.</p>
<p>Now, Twinkly just needs to call her <code>tree</code> program with various combinations of command-line options to produce dozens of different trees. And Santa's Christmas cards will be at the printers in time to meet the deadline.</p>
</div>2020-12-13T00:00:00ZDave CrossGenerate static web sites using your favorite Perl frameworkhttp://perladvent.org/2020/2020-12-12.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<h2 id="The-best-of-two-worlds">The best of two worlds</h2>
<h3 id="Static-web-sites">Static web sites</h3>
<p>Have you noticed the recent trend of static blogging?</p>
<p>The idea behind static blogging is to use a tool to <i>generate</i> the HTML pages that constitute the blog from a set of simple text files, and to publish these generated pages using a basic web server.</p>
<p>Some would argue that a blog without comments is not really a blog. And how do you comment without <code>POST</code>? One way would be to delegate the <code>POST</code>ing to someone else (like <a href="http://disqus.com/">Disqus</a>).</p>
<p>Also, static web sites don't have to be frozen. Nothing prevents you from generating the site content regularly (especially if it depends on an external source) or from hooking it to your VCS repository, so that every update to the source triggers a regeneration.</p>
<p>Going back to static web sites, here are a few reasons why people like them:</p>
<ul>
<li><p>Speed:</p>
<p>It would be really hard to beat a webserver serving a static file from disk.</p>
</li>
<li><p>Security:</p>
<p>No user input means no SQL injection. If no code is run to produce the response, then no bugs can interfere in the process.</p>
<p>Of course, you're still vulnerable to your webserver's own security issues when it serves static files, but that should be a pretty limited set.</p>
</li>
<li><p>Simplicity:</p>
<p>A static web site is a bunch of files. You can commit them in a VCS and push them to their final destination, or you can use FTP. It's the easiest deployment procedure ever.</p>
</li>
<li><p>Economy:</p>
<p>Generate once, request any time!</p>
</li>
</ul>
<p>Static blogging tools like <a href="http://jekyllrb.com/">Jekyll</a>, <a href="http://pypi.python.org/pypi/pelican">Pelican</a>, <a href="http://middlemanapp.com/">Middleman</a> keep popping up, and new ones are invented almost daily.</p>
<p>(I have myself been using <a href="http://template-toolkit.org/docs/tools/ttree.html">ttree</a> for years, but writing code using <a href="http://template-toolkit.org/">Template Toolkit</a>'s DSL can be limiting.)</p>
<p>The setup is always the same: take a bunch of files in <i>some format</i> (usually <a href="http://daringfireball.net/projects/markdown/">Markdown</a>, <a href="http://docutils.sourceforge.net/rst.html">reStructuredText</a> or <a href="http://www.txstyle.org/">Textile</a>), plus some configuration, and run the tool. The problem with that is always the same: the model fits the original author's needs, and you have to follow <i>their</i> rules. Personalisation not included.</p>
<h3 id="Web-frameworks">Web frameworks</h3>
<p>Perl has plenty of awesome web frameworks, such as <a href="http://www.catalystframework.org/">Catalyst</a>, <a href="http://www.perldancer.org/">Dancer</a>, <a href="http://mojolicio.us/">Mojolicious</a>, and many others, to let you write your web application the way you want. Each has its own set of advantages and disadvantages, but that is not the point of this article.</p>
<p>The point is that using those to run a blog or the framework's marketing^Whome page may seem wasteful, as there's probably little need to regenerate a page for each request, no matter if the content has changed or not.</p>
<h3 id="Static-web-sites-made-with-web-frameworks">Static web sites made with web frameworks</h3>
<p>PSGI is an interface between web servers and applications written in Perl. The Plack implementation of PSGI is supported by most Perl web frameworks. It's also possible to write your own application (a PSGI application is just a subroutine) and connect it to any supported web server — and most web servers are supported.</p>
<p>After having tried to write my own static site generator, and having failed at making it as flexible as I would have liked (which in retrospect would probably have made it a web framework in itself), it seemed wiser to start building a site with one of those nice web frameworks and to use Plack as my entry point to get the to the content.</p>
<p><a href="https://metacpan.org/module/wallflower">wallflower</a> is a command-line tool that takes a PSGI application, and uses Plack to access to the content and save it to local files, ready to be uploaded to your static web server.</p>
<p>After obtaining the coderef for your application, it repeatedly creates the PSGI environment for the URL you want to process and runs your app on it (using <code>Plack::Util::run_app</code>), saving the response content to a local file. If the response content type is <code>text/html</code> or <code>text/css</code>, it will automatically look for embedded links and add them to its queue, thus enabling auto-discovery of the entire web site.</p>
<p>The point of <a href="https://metacpan.org/module/Wallflower">Wallflower</a> is to let you write any static website using all the power of your favorite web framework. It also follows links inside your Plack application, so if your site is properly organized, you only need to point it to <code>/</code>.</p>
<h3 id="Blogging-statically-with-your-favorite-framework">Blogging statically with your favorite framework</h3>
<p>The obvious example for this would be to write a blog. I'll use Dancer, because it's the only web framework I know, but keep in mind that this will work with any PSGI-compliant framework. You could actually write your own PSGI application, if no existing framework suited you.</p>
<p>Since our target is a <i>static</i> web site, the main thing to keep in mind is that the target web server will determine the content type by looking at the extension, each all of our URLs <b>must</b> have an extension.</p>
<p>The sources for our basic blog will be a set of text files in the <i>public/</i> subdirectory, with the content written in Markdown. URL will simply be mapped to those files.</p>
<p>So, we start by writing a route to handle all URL ending with <i>.html</i>:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">ShyBlog</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Dancer</span> <span class="single">':syntax'</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Text::Markdown</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Class</span> <span class="words">qw( file )</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$m</span> <span class="operator">=</span> <span class="word">Text::Markdown</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><br /><span class="word">get</span> <span class="regexp">qr{/(.*)\.html}</span> <span class="operator">=></span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$file</span><span class="structure">)</span> <span class="operator">=</span> <span class="word">splat</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$text</span> <span class="operator">=</span> <span class="word">file</span><span class="structure">(</span> <span class="word">setting</span><span class="structure">(</span><span class="single">'public'</span><span class="structure">)</span> <span class="operator">=></span> <span class="double">"$file.txt"</span> <span class="structure">)</span><span class="operator">-></span><span class="word">slurp</span><span class="structure">;</span><br /> <span class="word">template</span> <span class="single">'blog'</span><span class="operator">,</span> <span class="structure">{</span> <span class="word">content</span> <span class="operator">=></span> <span class="symbol">$m</span><span class="operator">-></span><span class="word">markdown</span><span class="structure">(</span><span class="symbol">$text</span><span class="structure">)</span> <span class="structure">};</span><br /><span class="structure">};</span><br /><br /><span class="number">1</span><span class="structure">;</span></code></pre>
<p>Since we put our blog entries in the <i>public/</i> directory, Dancer will automatically serve the source when we end the URL in <i>.txt</i>! And we didn't even need to write a route for that!</p>
<p>Now, we want to get any further than a single blog post, to showing a main page with the latest post, some side bars on every page pointing to the archives by month, and maybe a JSON file with all our tags for making a nice tag cloud in JavaScript, we have a bit of a problem: we need to know about all our blog's posts when generating any individual one.</p>
<p>Remember that our PSGI application is ultimately a subroutine that will be called repeatedly by wallflower, so we just have to make the needed data available to the subroutine by building the list of all posts, once and for all, during the initialisation phase of the application.</p>
<p>A simple call to <a href="https://metacpan.org/module/File::Find">File::Find</a> will help us generate the list of all posts, from which we can create a data structure. In this example it's an array:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">File::Find</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Path::Class</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">@entries</span><span class="structure">;</span><br /><br /><span class="word">find</span><span class="structure">(</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /><br /><span class="comment"> # we only care about blog entries<br /></span> <span class="keyword">return</span> <span class="word">if</span> <span class="operator">!</span><span class="match">/\.txt$/</span><span class="structure">;</span><br /><br /><span class="comment"> # get a Path::Class::File for it<br /></span> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="operator">=</span> <span class="word">file</span><span class="structure">(</span><span class="symbol">$File::Find::name</span><span class="structure">);</span><br /> <span class="keyword">my</span> <span class="symbol">$fh</span> <span class="operator">=</span> <span class="symbol">$file</span><span class="operator">-></span><span class="word">openr</span><span class="structure">;</span><br /><br /><span class="comment"> # parse a simple header using the kite secret operator<br /></span> <span class="word">chomp</span><span class="structure">(</span> <span class="keyword">my</span> <span class="structure">(</span> <span class="symbol">$title</span><span class="operator">,</span> <span class="symbol">$date</span><span class="operator">,</span> <span class="symbol">$tags</span> <span class="structure">)</span> <span class="operator">=</span> <span class="structure">(</span> <span class="operator">~~<</span><span class="symbol">$fh</span><span class="operator">>,</span> <span class="operator">~~<</span><span class="symbol">$fh</span><span class="operator">>,</span> <span class="operator">~~<</span><span class="symbol">$fh</span><span class="operator">></span> <span class="structure">)</span> <span class="structure">);</span><br /><br /><span class="comment"> # update the structure will all relevant information<br /></span> <span class="keyword">my</span> <span class="symbol">$source</span> <span class="operator">=</span> <span class="word">substr</span><span class="structure">(</span> <span class="symbol">$File::Find::name</span><span class="operator">,</span> <span class="word">length</span><span class="structure">(</span> <span class="word">setting</span><span class="structure">(</span><span class="single">'public'</span><span class="structure">)</span> <span class="structure">)</span> <span class="structure">);</span><br /> <span class="structure">(</span> <span class="keyword">my</span> <span class="symbol">$url</span> <span class="operator">=</span> <span class="symbol">$source</span> <span class="structure">)</span> <span class="operator">=~</span> <span class="substitute">s/\.txt$/.html;<br /><br /> push @entries, {<br /> url => '/</span><span class="single">' .<br /> title => $title,<br /> date => $date,<br /> tags => [ split /\s*,\s*/, $tags ],<br /> source => "/$year/$month/$_.txt",<br /> };<br /> },<br /> setting( '</span><span class="word">public</span><span class="single">' )<br />);</span></code></pre>
<p>Actually, for simplicity, and integration with the framework, it would make sense to create a temporary SQLite database, with a few tables for blog entries meta-information, tags, etc. The code in the templates and some special routes (like the main page) can then use that database to fetch all the information they need.</p>
<p>Generating the website is now simply a matter of running:</p>
<pre><code> $ wallflower -a bin/app.pl -d /path/to/the/output/</code></pre>
<p><i>wallflower</i> will start browsing the application from <code>/</code> and will follow all links (from HTML and CSS files) to generate your site content.</p>
<p>You can then copy the content of <i>output/</i> to the proper location on the target web server, and you're done!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/App::Wallflower">App::Wallflower</a></p>
</li>
<li><p><a href="https://metacpan.org/module/wallflower">wallflower</a></p>
</li>
<li><p><a href="https://metacpan.org/module/PSGI">PSGI</a></p>
</li>
<li><p><a href="https://metacpan.org/module/Dancer">Dancer</a></p>
</li>
<li><p><a href="https://metacpan.org/module/perlsecret#Kite">~~<></a></p>
</li>
</ul>
</div>2020-12-12T00:00:00ZPhilippe BruhatCPAN::Minihttp://perladvent.org/2020/2020-12-11.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>As you can probably guess, I like CPAN. I've come to rely on the fact that I have thousands of modules at my fingertips that enable me to do a wide range of stuff using other people tools. Which is a bit of a problem when I'm working offline. There's nothing more frustrating when you're coding Perl than hacking on a quick script and thinking something like "It'd be nice to use DBD::SQLite to store this data" then discovering it's not installed, and you're offline so you can't download it.</p>
<p>What I actually want is a copy of CPAN on my laptop so that I can always install modules whenever I want. Of course, CPAN is big - several gigabytes - and I don't really have the patience to download the whole thing using rsync. Rather than the whole thing, I just need the latest version of each module - on the odd occasion I want an older version of a module I can wait till I'm back online.</p>
<p>Enter the <code>minicpan</code> script, part of <b>CPAN::Mini</b>. This script creates (and update) a small - but perfectly usable - local copy of CPAN. I'm never going to be stuck up the proverbial creek without a Perl module to paddle with again.</p>
<p>Creating a mirror of CPAN couldn't be easier. First you need to install CPAN::Mini with the <code>cpan</code> shell (or use cpanplus if you prefer)</p>
<pre><code> travis:~ mark$ sudo cpan
cpan shell -- CPAN exploration and modules installation (v1.76)
ReadLine support enabled
cpan> install CPAN::Mini</code></pre>
<p>Then you need to work out which CPAN you're going to mirror from and where you're going to store it locally. The former is easy - you can either go to the list of mirrors on cpan.org, or you can just set it to be whatever you set the <code>cpan</code> shell to use:</p>
<pre><code> bash$ sudo cpan
cpan shell -- CPAN exploration and modules installation (v1.76)
ReadLine support enabled</pre>
cpan> o conf urllist
urllist
ftp://ftp.demon.co.uk/pub/CPAN/</code></pre>
<p>Where you put your local mirror isn't really important - anywhere that's got half a gigabyte of free space will do. I put mine in my webserver's document root (<code>/Library/WebServer/Documents/CPAN</code>) so it can be accessed from a webbrowser if I need to.</p>
<p>All that's left for us to do now is run the <code>minicpan</code> command passing the remote server with <code>-r</code> and the local location with <code>-l</code>.</p>
<pre><code> bash$ minicpan -r ftp://ftp.demon.co.uk/pub/CPAN/ \
-l /Library/WebServer/Documents/CPAN</code></pre>
<p>This'll then chug away for a fair old time downloading the CPAN indexes and every file pointed to in the indices (with the exception of new versions of Perl or Ponie). A few days later when you want to update your mirror you just need to run the same command again:</p>
<pre><code> bash$ minicpan -r ftp://ftp.demon.co.uk/pub/CPAN/ \
-l /Library/WebServer/Documents/CPAN</pre></code></pre>
<p>And it'll redownload these indices, download any new files and delete any files that it's previously downloaded that aren't needed anymore. It'll be much much quicker this time as probably only a few modules will have been released for the first time or updated in that time period.</p>
<h3 id="Using-Your-New-Mirror">Using Your New Mirror</h3>
<p>If you want to quickly configure the cpan shell to use the mirror (if for example you're offline at the time) then you can tell it to use your mirror for the rest of the session</p>
<pre><code> bash$ sudo cpan
cpan shell -- CPAN exploration and modules installation (v1.76)
ReadLine support enabled</pre>
cpan> o conf urllist unshift file:///Library/WebServer/Documents/CPAN/</code></pre>
<p>If you want to always use your mirror (which will be much much quicker but you'll have to remember to keep it up to date) you can then save that new configuration:</p>
<pre><code> cpan> o conf commit</code></pre>
<p>And that's it! You now have a fast copy of CPAN that you can use wherever you are.</p>
</div>2020-12-11T00:00:00ZMark FowlerRegexp::Commonhttp://perladvent.org/2020/2020-12-10.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Are you fed up writing the same regexes over and over again? Even though someone's bound to have written (and debugged) them a hundred times already.</p>
<p>Someone should put a module of a collection of them up on the CPAN. Oh, wait, someone did.</p>
<p>Suppose you want to make sure a scalar has something that looks like a number in it. It's a fairly simple regex to write, right?</p>
<pre><code class="code-listing"><span class="symbol">$scalar</span> <span class="operator">=~</span> <span class="match">/^\d+$/</span><span class="structure">;</span></code></pre>
<p>That's</p>
<pre><code class="code-listing"><span class="symbol">$scalar</span> <span class="operator">=~</span> <span class="match">/^ # start of line <br /> \d # digit<br /> + # one or more times<br /> $ # till the end of line<br /> /x</span><span class="structure">;</span> <span class="comment"># allow me to split the line up like this</pre></span></code></pre>
<p>Of course, that falls over as soon as someone puts in a floating point number.</p>
<pre><code class="code-listing"><span class="float">3.14159265</span> <span class="comment"># the dot doesn't match \d</span></code></pre>
<p>So we need to expand that to cover situations where there might optionally be extra bits on the end</p>
<pre><code class="code-listing"><span class="symbol">$scalar</span> <span class="operator">=~</span> <span class="match">/^ # start of line <br /> \d # digit<br /> + # one or more times<br /> ( # group for floating point part<br /> \. # literal dot<br /> \d # digit<br /> + # one or more times<br /> ) # end group for floating point type<br /> ? # group may or may not exist (is optional)<br /> $ # till the end of line<br /> /x</span><span class="structure">;</span> <span class="comment"># allow me to split the line up like this</pre></span></code></pre>
<p>Which works fine until someone does this:</p>
<pre><code class="code-listing"><span class="float">-2.71828183</span><span class="operator"><</span><span class="match">/pre></span></code></pre>
<p>So we have to modify it to have an optional plus or minus sign at the start:</p>
<pre><code class="code-listing"><span class="symbol">$scalar</span> <span class="operator">=~</span> <span class="match">/^ # start of line <br /> [+-] # plus or minus<br /> ? # which is optional<br /> \d # digit<br /> + # one or more times<br /> ( # group for floating point part<br /> \. # literal dot<br /> \d # digit<br /> + # one or more times<br /> ) # end group for floating point type<br /> ? # group may or may not exist (is optional)<br /> $ # till the end of line<br /> /x</span><span class="structure">;</span> <span class="comment"># allow me to split the line up like this</pre></span></code></pre>
<p>And guess what...then someone writes this:</p>
<pre><code class="code-listing"><span class="exp">6.626068e10</span><span class="number">-34</span></code></pre>
<p>And we get really annoyed. At this point I'm writing so much code that I have the distinct urge to write some tests. But more than this I get to thinking...wouldn't it be <i>nice</i> if someone had written this already. It's a fairly common occurrence - it's not like we're the first people ever to want to match a number.</p>
<p>And then we look in Regexp::Common. Lo and behold! There's one there to do it! Remind me again why I'm writing my own code?</p>
<p>Using <b>Regexp::Common</b> exports a hash <code>%RE</code> into our namespace. This hash contains many compiled regexes which we an use in our regular expressions. For example:</p>
<pre><code class="code-listing"><span class="symbol">$scalar</span> <span class="operator">=~</span> <span class="match">/$RE{num}{real}/</span><span class="structure">;</span></code></pre>
<p><b>Regexp::Common</b> also provides a subroutine method to get at the regexes, if you prefer to use it like that:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Regexp::Common</span> <span class="single">'RE_ALL'</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$regex</span> <span class="operator">=</span> <span class="word">RE_num_real</span><span class="structure">();</span><br /><span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$scalar</span> <span class="operator">=~</span> <span class="symbol">$regex</span><span class="structure">)</span><br /> <span class="structure">{</span> <span class="word">print</span> <span class="double">"It matched!"</span> <span class="structure">}</span></code></pre>
<p>In either case the regexes are blessed, meaning you can call methods on them and treat them just like they're objects.</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$num_regex</span> <span class="operator">=</span> <span class="symbol">$RE</span><span class="structure">{</span><span class="word">num</span><span class="structure">}{</span><span class="word">real</span><span class="structure">};</span><br /><span class="keyword">if</span> <span class="structure">(</span><span class="symbol">$num_regex</span><span class="operator">-</span><span class="symbol">&gt</span><span class="structure">;</span><span class="word">match</span><span class="structure">(</span><span class="symbol">$scalar</span><span class="structure">))</span><br /> <span class="structure">{</span> <span class="word">print</span> <span class="double">"It matched!"</span> <span class="structure">}</span></code></pre>
<p>One thing you can say about <b>Regexp::Common</b>, it provides a lot of syntactic sugar.</p>
<h3 id="What-Regexp::Common-can-match">What Regexp::Common can match</h3>
<p>I'm not going to provide examples of everything that <b>Regexp::Common</b> can match - that would take forever and a day. I'm just going to touch on some of the things that I've found most useful.</p>
<p>Aside from number matching, the one regular expression set I've found the most useful is the profanity matching. This is impossible to do properly without really annoying the residents of Middlesex and Scunthorpe by blocking out the inappropriate words in their place names, and you can only provide basic checking that's 'good enough'. <b>Regexp::Common</b> provides a collection that's 'good enough' from the outset, and means I no longer have to worry about constructing such things.</p>
<p>There's one or two regexes in the collection that I could easily write but are really tiresome to do each time and - as always when you write code rather than reusing existing known good code - you run the risk of making a mistake or typo; The ones that spring particularly to mind are the code for removing whitespace from the start or end of strings, and the code for removing comments from text.</p>
<p>Straying onto more advanced territory there's even code for matching balanced brackets, something that strictly in a mathematical sense a regular expression shouldn't be able to do (but Perl can because it's regular expressions aren't that regular.)</p>
<p>Then there's some clever stuff in there to match lists, where you can have things like "rod, jane, and freddy" and get the results back carefully dumping things like "and".</p>
<p>I could go on all day like this...have a look around in the list of modules yourself: http://search.cpan.org/dist/Regexp-Common/</p>
</div>2020-12-10T00:00:00ZMark FowlerSpeedy Validationhttp://perladvent.org/2020/2020-12-09.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Cheerful Candytree had just pulled an all-nighter trying to track down an elusive bug in the code. For some reason the code that loaded the sled was getting stuck, not returning anything.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">load_sled</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">$present_name</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$qty</span> <span class="operator">=</span> <span class="core">shift</span> <span class="operator">//</span> <span class="number">1</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$present</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">get_present</span><span class="structure">(</span> <span class="symbol">$present_name</span> <span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"Unknown present: $present_name"</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$sled</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">sled</span><span class="structure">;</span><br /><br /> <span class="keyword">while</span> <span class="structure">(</span><span class="symbol">$qty</span> <span class="operator">!=</span> <span class="number">0</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="symbol">$qty</span><span class="operator">--</span><span class="structure">;</span><br /> <span class="symbol">$present</span><span class="operator">-></span><span class="word">add_to_sled</span><span class="structure">(</span> <span class="symbol">$sled</span> <span class="structure">);</span><br /> <span class="structure">}</span><br /><span class="structure">}</span></code></pre>
<p>Looks good, doesn't it? So why did it never terminate? After much much head scratching Cheerful tracked it down to a little addition some cheeky little elves had snuck in:</p>
<pre><code class="code-listing"><span class="comment"># Load inflight movies!<br /></span><span class="symbol">$loader</span><span class="operator">-></span><span class="word">load</span><span class="structure">(</span><span class="number">22</span><span class="operator">,</span> <span class="symbol">$movie</span><span class="structure">);</span></code></pre>
<p>Apparently the couple of dozen elves that accompanied Santa on his trip get bored during the long flight over the Atlantic and had decided to load twenty-two copies of a movie to put in their portable DVD players (presumably a couple were still helping steer.)</p>
<p>Since they'd snuck this in without code review, they'd somehow managed to mix up the argument orders. And the movie they'd picked? The 2006 Milla Jovovich film <a href="http://www.imdb.com/title/tt0259822/">.45</a>. Not being an integer number, and therefore never reaching zero when it was decremented, the sleigh loader had tried to load an infinite number of copies of Taylor Swift's hit single <a href="https://www.youtube.com/watch?v=AgFeZr5ptV8">22</a> instead. Ooops.</p>
<p>The problem was quickly solved with (a) Swapping the order of the parameters in the code and (b) Giving the offending elves a severe talking to.</p>
<h3 id="Parameter-Validation">Parameter Validation</h3>
<p>Cheerful knew that once this bug had occurred once, it was likely to happen again. The first step was to switch to named parameters throughout the codebase:</p>
<pre><code class="code-listing"><span class="symbol">$loader</span><span class="operator">-></span><span class="word">load</span><span class="structure">(</span> <span class="word">qty</span> <span class="operator">=></span> <span class="number">22</span><span class="operator">,</span> <span class="word">present_name</span> <span class="operator">=></span> <span class="symbol">$movie</span> <span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">load_sled</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">%p</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$present_name</span> <span class="operator">=</span> <span class="symbol">$p</span><span class="structure">{</span><span class="word">present_name</span><span class="structure">}</span> <span class="operator">or</span> <span class="word">die</span> <span class="double">"No present name"</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$qty</span> <span class="operator">=</span> <span class="symbol">$p</span><span class="structure">{</span><span class="word">qty</span><span class="structure">}</span> <span class="operator">//</span> <span class="number">1</span><span class="structure">;</span><br /><br /> <span class="operator">...</span></code></pre>
<p>Now at least the parameters can't get mixed up! But there's still the chance that <code>$qty</code> would contain an non-integer. Cheerful would really like an exception to be thrown rather than going into a never ending loop.</p>
<p>Maybe we could validate those parameters? The old venerable module for doing this is <a href="https://metacpan.org/module/Params::Validate">Params::Validate</a>, which we <a href="http://www.perladvent.org/2002/10th/">originally covered</a> in the Perl Advent Calendar over fifteen years ago.</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Params::Validate</span> <span class="words">qw( validate )</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">load_sled</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">%p</span> <span class="operator">=</span> <span class="word">validate</span><span class="structure">(</span> <span class="magic">@_</span><span class="operator">,</span> <span class="structure">{</span><br /> <span class="word">present_name</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">regex</span> <span class="operator">=></span> <span class="regexp">qr/./</span><span class="operator">,</span><br /> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">qty</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">regex</span> <span class="operator">=></span> <span class="regexp">qr/\A[1-9][0-9]*$/</span><span class="operator">,</span><br /> <span class="word">optional</span> <span class="operator">=></span> <span class="number">1</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="keyword">my</span> <span class="symbol">$present_name</span> <span class="operator">=</span> <span class="symbol">$p</span><span class="structure">{</span><span class="word">present_name</span><span class="structure">};</span><br /> <span class="keyword">my</span> <span class="symbol">$qty</span> <span class="operator">=</span> <span class="symbol">$p</span><span class="structure">{</span><span class="word">qty</span><span class="structure">}</span> <span class="operator">//</span> <span class="number">1</span><span class="structure">;</span><br /><br /> <span class="operator">...</span></code></pre>
<h3 id="Speed-Concerns">Speed Concerns</h3>
<p>There's a couple of key problems with using Params::Validate:</p>
<ul>
<li><p><b>Slow to run</b>. Params::Validate can be pretty slow. Not only does it have to validate the arguments each time <code>load_sled</code> is called, it also has to parse the arguments to <code>validate</code> and work out exactly how it has to validate the arguments. Every. Single. Time.</p>
</li>
<li><p><b>Slow to write</b>. There's a lot of code inside the parameters to <code>validate</code>, none of which is particularly easy to independently test, or after it's written, easy to understand without having to re-read all the code. Our Moose and Moo attributes support a rich reusable type system for validating values, it would be awesome if we could re-use that code to avoid re-writing anything and provide clarity of intent on what the validation system is doing.</p>
</li>
</ul>
<p>In order to address these issues Dave Rolsky wrote a new module called <a href="https://metacpan.org/module/Params::ValidationCompiler">Params::ValidationCompiler</a>. Let's see it in action in Candytree's codebase:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Params::ValidationCompiler</span> <span class="words">qw( validation_for )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MooseX::Types::Common::String</span> <span class="words">qw( NonEmptySimpleStr )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MooseX::Types::Common::Numeric</span> <span class="words">qw( PositiveInt )</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$validator</span> <span class="operator">=</span> <span class="word">validation_for</span><span class="structure">(</span><br /> <span class="word">params</span> <span class="operator">=></span> <span class="structure">{</span><br /> <span class="word">present_name</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">type</span> <span class="operator">=></span> <span class="word">NonEmptySimpleStr</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">qty</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">type</span> <span class="operator">=></span> <span class="word">PositiveInt</span><span class="operator">,</span> <span class="word">default</span> <span class="operator">=></span> <span class="number">1</span> <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="keyword">sub</span> <span class="word">load_sled</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">%p</span> <span class="operator">=</span> <span class="symbol">$validator</span><span class="operator">-></span><span class="structure">(</span><span class="magic">@_</span><span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$present_name</span> <span class="operator">=</span> <span class="symbol">$p</span><span class="structure">{</span><span class="word">present_name</span><span class="structure">};</span><br /> <span class="keyword">my</span> <span class="symbol">$qty</span> <span class="operator">=</span> <span class="symbol">$p</span><span class="structure">{</span><span class="word">qty</span><span class="structure">};</span></code></pre>
<p>Firstly, you'll notice that Params::ValidationCompiler is using Moose types for it's validation routines (though it'll accept Type::Tiny or Specio types as well if you're using those in your codebase instead.) This means that the code is significantly more readable than it was before, and Cheerful has a lot less code to write, maintain, and edge cases to test.</p>
<p>Secondly, you'll note that assigning default values has moved within the realm of the validation routine, meaning we don't have to mess around with that stuff when we're extracting our values from the hash. While we could have also done similar default handling with Params::Validate, the reason this becomes really useful with Params::ValidationCompiler is when we use the <code>named_to_list</code> option to skip the intermediate hash altogether:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$validator</span> <span class="operator">=</span> <span class="word">validation_for</span><span class="structure">(</span><br /> <span class="word">params</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="word">present_name</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">type</span> <span class="operator">=></span> <span class="word">NonEmptySimpleStr</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">qty</span> <span class="operator">=></span> <span class="structure">{</span> <span class="word">type</span> <span class="operator">=></span> <span class="word">PositiveInt</span><span class="operator">,</span> <span class="word">default</span> <span class="operator">=></span> <span class="number">1</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">]</span><span class="operator">,</span><br /> <span class="word">named_to_list</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">load_sled</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="structure">(</span><span class="symbol">$present_name</span><span class="operator">,</span> <span class="symbol">$qty</span><span class="structure">)</span> <span class="operator">=</span> <span class="symbol">$validator</span><span class="operator">-></span><span class="structure">(</span><span class="magic">@_</span><span class="structure">);</span></code></pre>
<p>The validator now returns the extracted values in the order in which they were specified in <code>validation_for</code>.</p>
<p>The third and most striking change is that we've split the validation <i>compiling</i> out from the actual call for validation. It's now a two step process - first compile a validator when we first load our code up, once and only once, and then execute it when the subroutine is called. This is significantly quicker.</p>
<p>One of the reasons that this is much quicker is because Params::ValidationCompiler actually <i>compiles</i> a validator, not just builds one. Under the hood it uses <a href="https://metacpan.org/module/Eval::Closure">Eval::Closure</a> (as we discussed <a href="http://www.perladvent.org/2017/2017-12-10.html">earlier in the month</a>) to build Perl source code to make the fastest possible validator that validates the configuration that it was called with without introducing any extranious logic or subroutine calls. It's even able to take advantage of the inlinable Moose types - Moose types that can themselves return Perl source code to implement their type checking - to bake-in that type checking directly inside that subroutine. This essentially means that Params::ValidationCompiler is as fast as if you'd hand-coded a subroutine with logic to explicitly check the arguments.</p>
<h3 id="To-Bed-Perchance-to-Dream">To Bed, Perchance to Dream</h3>
<p>Now the code was protected from crazy elves, Cherry Candytree was going to take a well earned kip. Hopefully by the time he awoke they wouldn't have found another creative way to break things.</p>
</div>2020-12-09T00:00:00ZMark FowlerCute Christmas Animalshttp://perladvent.org/2020/2020-12-08.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>State sponsored hacking. Influencing foreign elections. Crypto currency ponzi schemes. Have we forgotten what the Internet is really for? <i>Looking at cute pictures of cats</i>.</p>
<p><center><img src="https://i.imgur.com/XgJetkM.jpg" width="500"></center>
</p>
<p>With all the craziness that's going on online, it feels good to take a break from it all and just look at pictures of cats for a bit. And you know what can help with that? Yep...Perl!</p>
<p>Let's write a quick Perl script to get us some <i>Christmas</i> cat pictures to look at by accessing Imgur's REST API.</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">Mojo::UserAgent</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Mojo::Template</span><span class="structure">;</span><br /><br /><span class="comment"># get your own client id at https://api.imgur.com/oauth2/addclient<br /></span><span class="keyword">my</span> <span class="symbol">$CLIENT_ID</span> <span class="operator">=</span> <span class="single">'<<REDACTED>>'</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$results</span> <span class="operator">=</span> <span class="word">Mojo::UserAgent</span><span class="operator">-></span><span class="word">new</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><br /> <span class="word">Mojo::URL</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="single">'https://api.imgur.com'</span> <span class="structure">)</span><br /> <span class="operator">-></span><span class="word">path</span><span class="structure">(</span><span class="single">'/3/gallery/search'</span><span class="structure">)</span><br /> <span class="operator">-></span><span class="word">query</span><span class="structure">(</span><br /> <span class="word">q_all</span> <span class="operator">=></span> <span class="single">'christmas cat'</span><span class="operator">,</span><br /> <span class="word">q_not</span> <span class="operator">=></span> <span class="single">'tag:"secret santa"'</span><span class="operator">,</span><br /> <span class="structure">)</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">Authorization</span> <span class="operator">=></span> <span class="double">"Client-ID $CLIENT_ID"</span><span class="structure">}</span><span class="operator">,</span><br /><span class="structure">)</span><span class="operator">-></span><span class="word">result</span><span class="operator">-></span><span class="word">json</span><span class="structure">(</span><span class="single">'/data'</span><span class="structure">);</span><br /><br /><span class="keyword">my</span> <span class="symbol">$mt</span> <span class="operator">=</span> <span class="word">Mojo::Template</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><span class="word">print</span> <span class="symbol">$mt</span><span class="operator">-></span><span class="word">vars</span><span class="structure">(</span><span class="number">1</span><span class="structure">)</span><span class="operator">-></span><span class="word">render</span><span class="structure">(</span><span class="heredoc"><<'HTML'</span><span class="operator">,</span> <span class="structure">{</span> <span class="word">data</span> <span class="operator">=></span> <span class="symbol">$results</span> <span class="structure">});</span><br /><span class="heredoc_content"><html><br /><body><br />% for my $post (@{ $data }) {<br /><h2><%= $post->{title} %></h2><br />% for my $image (@{ $post->{images} }) {<br /><img src="<%= $image->{link} %>" width="400"><br /><p><%= $image->{description} || ""%></p><br />% }<br />% }<br /></body><br /></html><br /></span><span class="heredoc_terminator">HTML<br /></span></code></pre>
<p>Rather than using LWP::UserAgent and URI (like in <a href="http://perladvent.org/2018/2018-12-17.html">the Spotify REST API example</a>) we're using Mojolicious's <a href="https://metacpan.org/module/Mojo::UserAgent">Mojo::UserAgent</a> and <a href="https://metacpan.org/module/Mojo::URL">Mojo::URL</a> to make the request and build the URL. Mojolicious's interface is a little more compact, allowing us to easily do things like chain method calls as we're building the URL object (with each mutating call returning the object itself again) so we can construct it directly inside our user agent method call. With Mojolicious there's no need to explicitly create a request object in order to simply set a header. The JSON parsing is also handled as part of the Mojolicious framework with a call to the <code>json</code> method rather than needing to make use of a separate <code>decode_json</code> function call - in addition, we're passing it a <a href="https://tools.ietf.org/html/rfc6901">JSON Pointer</a> to indicate which <i>bit</i> of the JSON data structure it should return.</p>
<p>All in all, it's pretty neat having to write less code. But the real advantages in using Mojo to do this comes when you want to start doing concurrency...</p>
<h3 id="What-about-the-Dogs">What about the Dogs?</h3>
<p>What you say? You're a <i>Dog</i> person? Well, me too. Our house is blessed by not only two cute cats but a wonderful basset hound (who fight each other like cats and dogs...but I digress.) So, yep, I like looking at pictures of dogs too. Maybe we can adjust our script to show pictures of Christmas dogs as well?</p>
<p><center><img src="https://i.imgur.com/gGiXuyv.jpg" width="500"></center>
</p>
<p>What I really want to do is alternate posts from the cat search with posts from the dog search. But to do that I need to make two API calls, and I'm an <i>incredibly</i> impatient person when it comes to getting my cute animal fix. I don't want to wait for my cute Christmas cats API call to return before making my cute Christmas dogs API call. What I want to do is make them at <i>the same time</i>.</p>
<p>Instead of returning a result we could have Mojo::UserAgent use the Mojo IO loop to fire a callback when it's complete. This is achieved by passing an anonymous subroutine as an argument:</p>
<pre><code class="code-listing"><span class="symbol">$ua</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><br /> <span class="word">Mojo::URL</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="single">'https://api.imgur.com'</span> <span class="structure">)</span><br /> <span class="operator">-></span><span class="word">path</span><span class="structure">(</span><span class="single">'/3/gallery/search'</span><span class="structure">)</span><br /> <span class="operator">-></span><span class="word">query</span><span class="structure">(</span><br /> <span class="word">q_all</span> <span class="operator">=></span> <span class="single">'christmas $animal'</span><span class="operator">,</span><br /> <span class="word">q_not</span> <span class="operator">=></span> <span class="single">'tag:"secret santa"'</span><span class="operator">,</span><br /> <span class="structure">)</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">Authorization</span> <span class="operator">=></span> <span class="double">"Client-ID $CLIENT_ID"</span><span class="structure">}</span><span class="operator">,</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$ua</span><span class="operator">,</span> <span class="symbol">$tx</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="word">print</span> <span class="word">STDERR</span> <span class="double">"Got data back for $animal...\n"</span><span class="structure">;</span><br /><br /> <span class="operator">...</span><br /> <span class="structure">}</span><br /><span class="structure">);</span></code></pre>
<p>But what are we going to replace the <code>...</code> with? What we need is some way to await the content of both of the REST API calls we're fetching and <i>then</i> do something. The easiest way to do this is to use Mojolicious' implementation of promises: <a href="https://metacpan.org/module/Mojo::Promise">Mojo::Promise</a>.</p>
<p>When we write our <code>perform_search</code> function rather than waiting on the API call and only then returning from the function we instead immediately return a new <i>promise</i> object, a promise to later return the API data.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">perform_search</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$animal</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /><span class="comment"> # create a new promise to return<br /></span> <span class="keyword">my</span> <span class="symbol">$promise</span> <span class="operator">=</span> <span class="word">Mojo::Promise</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><br /> <span class="symbol">$ua</span><span class="operator">-></span><span class="word">get</span><span class="structure">(</span><br /> <span class="word">Mojo::URL</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="single">'https://api.imgur.com'</span> <span class="structure">)</span><br /> <span class="operator">-></span><span class="word">path</span><span class="structure">(</span><span class="single">'/3/gallery/search'</span><span class="structure">)</span><br /> <span class="operator">-></span><span class="word">query</span><span class="structure">(</span><br /> <span class="word">q_all</span> <span class="operator">=></span> <span class="double">"christmas $animal"</span><span class="operator">,</span><br /> <span class="word">q_not</span> <span class="operator">=></span> <span class="single">'tag:"secret santa"'</span><span class="operator">,</span><br /> <span class="structure">)</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">Authorization</span> <span class="operator">=></span> <span class="double">"Client-ID $CLIENT_ID"</span><span class="structure">}</span><span class="operator">,</span><br /> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$ua</span><span class="operator">,</span> <span class="symbol">$tx</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="word">print</span> <span class="word">STDERR</span> <span class="double">"Got data back for $animal...\n"</span><span class="structure">;</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="symbol">$tx</span><span class="operator">-></span><span class="word">result</span><span class="operator">-></span><span class="word">json</span><span class="structure">(</span><span class="single">'/data'</span><span class="structure">);</span><br /><br /><span class="comment"> # resolve the promise with the data now we have it<br /></span> <span class="symbol">$promise</span><span class="operator">-></span><span class="word">resolve</span><span class="structure">(</span> <span class="symbol">$data</span> <span class="structure">);</span><br /> <span class="structure">}</span><br /> <span class="structure">);</span><br /><br /><span class="comment"> # immediately return the promise object<br /></span> <span class="keyword">return</span> <span class="symbol">$promise</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>When the callback is executed it calls the <code>resolve</code> method on the promise meaning anything waiting on that promise will be allowed to continue. For example:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$promise</span> <span class="operator">=</span> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'cat'</span><span class="structure">);</span><br /><span class="symbol">$promise</span><span class="operator">-></span><span class="word">wait</span><span class="structure">;</span></code></pre>
<p><code>wait</code> runs the Mojolicious IO loop and halts the current execution flow until the promise is fulfilled or fails. In our example this happens when <code>resolve</code> is called by the <code>get</code> method's callback when the REST API response arrives - meaning <code>wait</code> in this example effectively stops the program until the API result has been downloaded.</p>
<p>Great! So how do we collect the promised result? The easiest way to do this is to use the <code>then</code> method on the promise. You can pass an anonymous subroutine to <code>then</code> which will be executed when that promise is resolved with whatever value was used to resolve it. Here's the really clever bit though: when called <code>then</code> itself immediately returns a new promise. This new promise will only get itself resolved when whatever happens in the anonymous subroutine is done.</p>
<p>If we want to capture our cat data structure we could use a <code>then</code>/<code>wait</code> pair like so:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cat_results</span><span class="structure">;</span><br /><span class="word">perform_search</span><span class="structure">(</span><span class="single">'cat'</span><span class="structure">)</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="structure">(</span><span class="symbol">$cat_results</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="structure">;</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">wait</span><span class="structure">;</span></code></pre>
<p>The anonymous subroutine is called when the promise that <code>perform_search</code> created is resolved (when the API request has returned). When that anonymous subroutine returns the promise that <code>then</code> created which we're waiting on is resolved. By creating this chain we're able to control the program flow.</p>
<p>Above I mentioned that the promise that <code>then</code> returns is resolved when the subroutine is done...but what did I mean by that? It's not <i>just</i> whenever the subroutine returns a value. The really really clever bit is that this occurs <i>either</i> when the anonymous subroutine returns a non promise value <i>or</i> it returns a promise that itself resolves! For example, we could return a promise for the dog API call in the first <code>then</code> subroutine and then the promise created will only allow us to move onto the next <code>then</code> when the dog search API promise is resolved. This sounds complicated, but actually is very readable in code:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cat_results</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dog_results</span><span class="structure">;</span><br /><br /><span class="word">perform_search</span><span class="structure">(</span><span class="single">'cat'</span><span class="structure">)</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="structure">(</span><span class="symbol">$cat_results</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'dog'</span><span class="structure">);</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="structure">(</span><span class="symbol">$dog_results</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><br /><span class="structure">})</span><span class="operator">-></span><span class="word">wait</span><span class="structure">;</span></code></pre>
<p>Before we continue onto running these requests in parallel we should do a little housekeeping. Mojo::UserAgent is actually able to create promises directly with the <code>get_p</code> convenience method. Now we know how to use <code>then</code> we can simplify our <code>perform_search</code> function greatly by chaining our promises within <code>perform_search</code>:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">perform_search</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$animal</span> <span class="operator">=</span> <span class="core">shift</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="symbol">$ua</span><span class="operator">-></span><span class="word">get_p</span><span class="structure">(</span><br /> <span class="word">Mojo::URL</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="single">'https://api.imgur.com'</span> <span class="structure">)</span><br /> <span class="operator">-></span><span class="word">path</span><span class="structure">(</span><span class="single">'/3/gallery/search'</span><span class="structure">)</span><br /> <span class="operator">-></span><span class="word">query</span><span class="structure">(</span><br /> <span class="word">q_all</span> <span class="operator">=></span> <span class="double">"christmas $animal"</span><span class="operator">,</span><br /> <span class="word">q_not</span> <span class="operator">=></span> <span class="single">'tag:"secret santa"'</span><span class="operator">,</span><br /> <span class="structure">)</span><span class="operator">,</span><br /> <span class="structure">{</span> <span class="word">Authorization</span> <span class="operator">=></span> <span class="double">"Client-ID $CLIENT_ID"</span><span class="structure">}</span><span class="operator">,</span><br /> <span class="structure">)</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span> <span class="keyword">sub</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$tx</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="symbol">$tx</span><span class="operator">-></span><span class="word">result</span><span class="operator">-></span><span class="word">json</span><span class="structure">(</span><span class="single">'/data'</span><span class="structure">);</span><br /> <span class="structure">});</span><br /><span class="structure">}</span></code></pre>
<p>We're almost there! Now can we finally run these in parallel? You bet! There's no reason we have to pause for the cat promise to complete before retrieving the dog promise:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cat_results</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dog_results</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$promise1</span> <span class="operator">=</span> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'cat'</span><span class="structure">)</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="symbol">$cat_results</span> <span class="operator">=</span> <span class="core">shift</span> <span class="structure">});</span><br /><span class="keyword">my</span> <span class="symbol">$promise2</span> <span class="operator">=</span> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'dog'</span><span class="structure">)</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="symbol">$dog_results</span> <span class="operator">=</span> <span class="core">shift</span> <span class="structure">});</span><br /><span class="symbol">$promise1</span><span class="operator">-></span><span class="word">wait</span><span class="structure">;</span><br /><span class="symbol">$promise2</span><span class="operator">-></span><span class="word">wait</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Data::Dumper</span><span class="structure">;</span><br /><span class="word">print</span> <span class="word">Dumper</span> <span class="structure">[</span><span class="symbol">$cat_results</span><span class="operator">,</span> <span class="symbol">$dog_results</span><span class="structure">];</span></code></pre>
<p>Looking good! Mojo::Promise's <code>all</code> method makes this even easier, allowing us to quickly create a single promise that will resolve when all the promises we pass to it themselves resolve:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cat_results</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dog_results</span><span class="structure">;</span><br /><span class="word">Mojo::Promise</span><span class="operator">-></span><span class="word">all</span><span class="structure">(</span><br /> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'cat'</span><span class="structure">)</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="symbol">$cat_results</span> <span class="operator">=</span> <span class="core">shift</span> <span class="structure">})</span><span class="operator">,</span><br /> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'dog'</span><span class="structure">)</span><span class="operator">-></span><span class="word">then</span><span class="structure">(</span><span class="keyword">sub</span> <span class="structure">{</span> <span class="symbol">$dog_results</span> <span class="operator">=</span> <span class="core">shift</span> <span class="structure">})</span><span class="operator">,</span><br /><span class="structure">)</span><span class="operator">-></span><span class="word">wait</span><span class="structure">;</span></code></pre>
<p>Or, even more simply necessitating only writing one <code>then</code> call:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$cat_results</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$dog_results</span><span class="structure">;</span><br /><span class="word">Mojo::Promise</span><br /> <span class="operator">-></span><span class="word">all</span><span class="structure">(</span> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'cat'</span><span class="structure">)</span><span class="operator">,</span> <span class="word">perform_search</span><span class="structure">(</span><span class="single">'dog'</span><span class="structure">)</span> <span class="structure">)</span><br /> <span class="operator">-></span><span class="word">then</span><span class="structure">(</span> <span class="keyword">sub</span> <span class="structure">{</span> <span class="structure">(</span><span class="symbol">$cat_results</span><span class="operator">,</span> <span class="symbol">$dog_results</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span> <span class="structure">}</span> <span class="structure">)</span><br /> <span class="operator">-></span><span class="word">wait</span><span class="structure">;</span></code></pre>
<p>Now all that's left to do is zip the results together so we get alternating cat and dog posts (we can even use the same template code we had before):</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">List::MoreUtils</span> <span class="words">qw(zip)</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$results</span> <span class="operator">=</span> <span class="structure">[</span> <span class="word">zip</span> <span class="cast">@</span><span class="structure">{</span> <span class="symbol">$cat_results</span> <span class="structure">}</span><span class="operator">,</span> <span class="cast">@</span><span class="structure">{</span> <span class="symbol">$dog_results</span> <span class="structure">}</span> <span class="structure">];</span><br /><br /><span class="keyword">my</span> <span class="symbol">$mt</span> <span class="operator">=</span> <span class="word">Mojo::Template</span><span class="operator">-></span><span class="word">new</span><span class="structure">;</span><br /><span class="word">print</span> <span class="symbol">$mt</span><span class="operator">-></span><span class="word">vars</span><span class="structure">(</span><span class="number">1</span><span class="structure">)</span><span class="operator">-></span><span class="word">render</span><span class="structure">(</span><span class="heredoc"><<'HTML'</span><span class="operator">,</span> <span class="structure">{</span> <span class="word">data</span> <span class="operator">=></span> <span class="symbol">$results</span> <span class="structure">});</span><br /><span class="heredoc_content"><html><br /><body><br />% for my $post (@{ $data }) {<br /><h2><%= $post->{title} %></h2><br />% for my $image (@{ $post->{images} }) {<br /><img src="<%= $image->{link} %>" width="400"><br /><p><%= $image->{description} || ""%></p><br />% }<br />% }<br /></body><br /></html><br /></span><span class="heredoc_terminator">HTML<br /></span></code></pre>
<p>And there, as promised (groan) is our Christmas Cat and Dog Extravaganza.</p>
</div>2020-12-08T00:00:00ZMark FowlerConstantly Merryhttp://perladvent.org/2020/2020-12-07.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>One of the marks of a good code is that you're aware of what can change and what will not.</p>
<p>For example some things are destined to change:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$mince_pies_eaten</span> <span class="operator">=</span> <span class="number">0</span><span class="structure">;</span><br /><span class="symbol">$mince_pies_eaten</span><span class="operator">++</span><span class="structure">;</span> <span class="comment"># yum!</span><br /><span class="symbol">$mince_pies_eaten</span><span class="operator">++</span><span class="structure">;</span> <span class="comment"># yum! yum!</span></code></pre>
<p>And some things are not:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$WISE_MEN</span> <span class="operator">=</span> <span class="number">3</span><span class="structure">;</span></code></pre>
<p>It's good practice for your language to prevent you altering constants. Ideally if you accidentally did:</p>
<pre><code class="code-listing"><span class="symbol">$WISE_MEN</span><span class="operator">++</span><span class="structure">;</span></code></pre>
<p>You'd want Perl to throw an exception. And you can easily make Perl do that with a little help from a module on the CPAN:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Const::Fast</span><span class="structure">;</span><br /><br /><span class="word">const</span> <span class="word">my</span> <span class="symbol">$WISE_MEN</span> <span class="operator">=></span> <span class="number">3</span><span class="structure">;</span><br /><br /><span class="word">say</span> <span class="double">"There are $WISE_MEN wise men"</span><span class="structure">;</span><br /><br /><span class="symbol">$WISE_MEN</span><span class="operator">++</span><span class="structure">;</span></code></pre>
<p>Results in:</p>
<pre><code> There are 3 wise men
Modification of a read-only value attempted at - line 7.</code></pre>
<p>The <code>const</code> keyword preceding the <code>my</code> causes the <i>variable</i> that <code>my</code> refers to to be marked read-only and causes perl to throw a run-time exception if anything tries to alter it.</p>
<h2 id="Other-constant-techniques-that-dont-work-as-well">Other constant techniques that don't work as well</h2>
<p>There have been several techniques for constants in Perl that you might have heard of, and it's probably best to understand why we shouldn't use them in modern, well maintained code.</p>
<h3 id="The-Inlined-Subroutine-Trick">The Inlined Subroutine Trick</h3>
<p>If you write a subroutine that returns a simple value:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">WISE_MEN</span><span class="prototype">()</span> <span class="structure">{</span> <span class="keyword">return</span> <span class="number">3</span> <span class="structure">}</span></code></pre>
<p>Then that subroutine will be <i>inlined</i> when perl compiles your code. This means that:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Lingua::EN::Numbers::Ordinate</span> <span class="words">qw( ordinate )</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">WISE_MEN</span><span class="prototype">()</span> <span class="structure">{</span> <span class="number">3</span> <span class="structure">}</span><br /><br /><span class="keyword">for</span> <span class="structure">(</span><span class="number">1</span><span class="operator">..</span><span class="word">WISE_MEN</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="word">say</span> <span class="double">"Getting gift from "</span><span class="operator">.</span><span class="word">ordinate</span><span class="structure">(</span><span class="magic">$_</span><span class="structure">)</span><span class="operator">.</span><span class="double">" wise man"</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>Doesn't end up calling <code>WISE_MEN</code> from the Perl statement at all - perl is clever enough to substitute a scalar for <code>3</code> directly into the compiled op code removing the subroutine call at all. Let's run it through the compiler/decompiler to see the code equivalent to what perl sees once everything has been compiled:</p>
<pre><code> shell$ perl -Mfeature=say -MO=Deparse script.pl
sub WISE_MEN () {
3;
}
use Lingua::EN::Numbers::Ordinate ('ordinate');
use feature 'say';
foreach $_ (1 .. 3) {
say 'Getting gift from ' . &ordinate($_) . ' wise man';
}</code></pre>
<p>Note the <code>WISE_MEN</code> in the for loop has gone!</p>
<p>This <i>seems</i> ideal, but there are some big problems:</p>
<h4 id="Prototypes">Prototypes</h4>
<p>In order that I can write <code>WISE_MEN</code> not <code>WISE_MEN()</code> I need to declare the subroutine with a prototype, i.e. I need to write:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">WISE_MEN</span><span class="prototype">()</span> <span class="structure">{</span> <span class="number">3</span> <span class="structure">}</span></code></pre>
<p>The <code>()</code> indicates that no arguments are needed and the call to the subroutine can be written without brackets. However, this syntax is incompatible with the new experimental subroutine signatures feature recent versions of perl offer. Once enabled the same syntax would introduce run-time parameter checking and would result in a bare call to <code>WISE_MEN</code> without the trailing brackets causing an exception. Our subroutine instead would have to be written as:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">WISE_MEN</span><span class="prototype">()</span> <span class="operator">:</span><span class="attribute">prototype()</span> <span class="structure">{</span> <span class="number">3</span> <span class="structure">}</span></code></pre>
<p>Which is even less readable than before.</p>
<h4 id="Only-Simple-Things">Only Simple Things</h4>
<p>Consider this misguided attempt to create <i>constants</i>:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Lingua::EN::Numbers::Ordinate</span> <span class="structure">(</span><span class="single">'ordinate'</span><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">MONTH_OF_XMAS</span><span class="prototype">()</span> <span class="structure">{</span> <span class="word">ordinate</span><span class="structure">(</span><span class="number">25</span><span class="structure">)</span> <span class="structure">};</span> <span class="comment"># 25th</span><br /><span class="keyword">sub</span> <span class="word">DATE_OF_XMAS</span><span class="prototype">()</span> <span class="structure">{</span> <span class="word">ordinate</span><span class="structure">(</span><span class="number">12</span><span class="structure">)</span> <span class="structure">};</span> <span class="comment"># 12th</span><br /><br /><span class="word">print</span> <span class="single">'On the '</span><span class="operator">.</span><span class="word">DATE_OF_XMAS</span><span class="operator">.</span><span class="single">' day of the '</span><span class="operator">.</span><span class="word">MONTH_OF_XMAS</span><span class="operator">.</span><span class="single">' month...'</span><span class="structure">;</span></code></pre>
<p>The value isn't simple enough and perl won't inline it, meaning that not only does our constant result in a subroutine call each time it's called, but it also that results in a call to <code>ordinate</code> each time.</p>
<h3 id="Using-use-constant">Using <code>use constant</code>;</h3>
<p>The solution to each of these is to use a core module called <code>constant</code></p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Lingua::EN::Numbers::Ordinate</span> <span class="structure">(</span><span class="single">'ordinate'</span><span class="structure">);</span><br /><br /><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">MONTH_OF_XMAS</span> <span class="operator">=></span> <span class="word">ordinate</span><span class="structure">(</span><span class="number">25</span><span class="structure">);</span><br /><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">DATE_OF_XMAS</span> <span class="operator">=></span> <span class="word">ordinate</span><span class="structure">(</span><span class="number">12</span><span class="structure">);</span><br /><br /><span class="word">print</span> <span class="single">'On the '</span><span class="operator">.</span><span class="word">DATE_OF_XMAS</span><span class="operator">.</span><span class="single">' day of the '</span><span class="operator">.</span><span class="word">MONTH_OF_XMAS</span><span class="operator">.</span><span class="single">' month...'</span><span class="structure">;</span></code></pre>
<p>This declaration creates a simple subroutine that returns whatever value you passed to the call to <code>use constant</code>. Running this through the parser/deparser shows us that things have been helpfully simplified:</p>
<pre><code> shell$ perl -MO=Deparse script.pl
use Lingua::EN::Numbers::Ordinate ('ordinate');
use constant ('MONTH_OF_XMAS', &ordinate(25));
use constant ('DATE_OF_XMAS', &ordinate(12));
print 'On the 12th day of the 25th month...';</code></pre>
<p>However, there's a couple of problems with this technique</p>
<h4 id="No-interpolation">No interpolation</h4>
<p>Ideally instead of writing:</p>
<pre><code class="code-listing"><span class="word">print</span> <span class="single">'On the '</span><span class="operator">.</span><span class="word">DATE_OF_XMAS</span><span class="operator">.</span><span class="single">' day of the '</span><span class="operator">.</span><span class="word">MONTH_OF_XMAS</span><span class="operator">.</span><span class="single">' month...'</span><span class="structure">;</span></code></pre>
<p>We'd love it if we could just write:</p>
<pre><code class="code-listing"><span class="word">print</span> <span class="double">"On the $DATE_OF_XMAS day of the $MONTH_OF_XMAS month...';</span></code></pre>
<h4 id="Doesnt-Play-Nice-With-Hash-Keys">Doesn't Play Nice With Hash Keys</h4>
<p>Worse, these constants can't be used in situations where Perl would normally automatically quote values for you.</p>
<p>Consider this code:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">WISE1</span> <span class="operator">=></span> <span class="single">'Melchior'</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">WISE2</span> <span class="operator">=></span> <span class="single">'Caspar'</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">WISE3</span> <span class="operator">=></span> <span class="single">'Balthazar'</span><br /><br /><span class="word">my</span> <span class="symbol">%gifts</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="word">WISE1</span> <span class="operator">=></span> <span class="single">'Gold'</span><span class="operator">,</span><br /> <span class="word">WISE2</span> <span class="operator">=></span> <span class="single">'Frankenstein'</span><span class="operator">,</span><br /> <span class="word">WISE3</span> <span class="operator">=></span> <span class="single">'Muwhur?'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">print</span> <span class="symbol">$gifts</span><span class="structure">{</span><span class="word">Balthazar</span><span class="structure">};</span> <span class="comment"># doesn't work as we'd expect</span></code></pre>
<p>The fat comma (aka the <code>=></code>) causes WISE1 to be the literal string <code>WISE1</code> not <code>Melchior</code> as we'd expected. We need to write this as:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">%gifts</span> <span class="operator">=</span> <span class="structure">(</span><br /> <span class="word">WISE1</span><span class="structure">()</span> <span class="operator">=></span> <span class="single">'Gold'</span><span class="operator">,</span><br /> <span class="word">WISE2</span><span class="structure">()</span> <span class="operator">=></span> <span class="single">'Frankenstein'</span><span class="operator">,</span><br /> <span class="word">WISE3</span><span class="structure">()</span> <span class="operator">=></span> <span class="single">'Muwhur?'</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>The same is true for the hash keys.</p>
<pre><code class="code-listing"><span class="comment"># WRONG<br /></span><span class="keyword">my</span> <span class="symbol">$ag</span> <span class="operator">=</span> <span class="symbol">$gifts</span><span class="structure">{</span><span class="word">WISE1</span><span class="structure">};</span><br /><br /><span class="comment"># RIGHT<br /></span><span class="keyword">my</span> <span class="symbol">$shelly</span> <span class="operator">=</span> <span class="symbol">$gifts</span><span class="structure">{</span><span class="word">WISE2</span><span class="structure">()};</span></code></pre>
<h2 id="Const::Fast-is...fast">Const::Fast is...fast.</h2>
<p>Const::Fast relies on perl's in-build internal read-only support to make normal variables read-only. This means a variable that Const::Fast has marked as a constant can still be used just like any other variable - interpolated into strings, used as hash keys - except it cannot be altered because it has the read-only flag set.</p>
<p>This read-only functionality isn't provided by Const::Fast - it's just using the same mechanism perl uses internally to stop you altering literals in your source code. For example consider what happens if you write a subroutine that alters its arguments but instead of passing in a variable you pass in a literal string:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">shorten</span> <span class="structure">{</span><br /> <span class="magic">$_</span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span> <span class="operator">=~</span> <span class="substitute">s/Christmas/Xmas/</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="comment"># this works fine<br /></span><span class="keyword">my</span> <span class="symbol">$string</span> <span class="operator">=</span> <span class="single">'Merry Christmas'</span><span class="structure">;</span><br /><span class="word">shorten</span><span class="structure">(</span><span class="symbol">$string</span><span class="structure">);</span><br /><br /><span class="comment"># this gives the error<br /># Modification of a read-only value attempted at - line 4.<br /></span><span class="word">shorten</span><span class="structure">(</span><span class="single">'Merry Christmas'</span><span class="structure">);</span></code></pre>
<p>Internally perl uses the same sort of representation for the variable <code>$string</code> and the literal string we're passing to <code>shorten</code>, but the latter has a flag set on it to mark it as read only. Const::Fast enables the same flag on variables that you create with <code>const</code> meaning this acts in the same way:</p>
<pre><code class="code-listing"><span class="comment"># this also gives the error<br /># Modification of a read-only value attempted at - line 4.<br /></span><span class="word">const</span> <span class="word">my</span> <span class="symbol">$string</span> <span class="operator">=></span> <span class="single">'Merry Christmas'</span><span class="structure">;</span><br /><span class="word">shorten</span><span class="structure">(</span><span class="symbol">$string</span><span class="structure">);</span></code></pre>
<p>This means that constants defined by Const::Fast have no run-time penalty and are as fast as hard-coding the value in all the places you use the constant. Awesome!</p>
</div>2020-12-07T00:00:00ZMark FowlerJingle Refs, Jingle Refs, Jingle all the wayhttp://perladvent.org/2020/2020-12-06.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Santa's organization has two essential problems with their code; It has to work 100% of the time (you don't get a second chance at Christmas) and it has to be really efficient and fast (since there's a <i>lot</i> of children in the world and hence the code has to crunch a heck of a lot of data).</p>
<p>Often these goals can be at odds with each other. Abstractions, while inherently safer than writing the same small snippet of code over and over (each with a chance to make a small mistake) can lead to slower code, introducing extra subroutine calls or data processing that simply wasn't there before.</p>
<p>But not always. Tonight we'll tell you of the wondrous day that a Christmas miracle occurred in the most unlikely of places...the annual code review.</p>
<h3 id="A-Worrying-Pattern">A Worrying Pattern</h3>
<p>During the annual code-review, the Wise Old Elf had noticed a common pattern we all maintain: Checking the validity of references using the <code>ref</code> function:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Carp</span> <span class="words">qw<croak></span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">create_sled</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">$args</span> <span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /><br /> <span class="word">ref</span> <span class="symbol">$args</span> <span class="operator">eq</span> <span class="single">'HASH'</span><br /> <span class="operator">or</span> <span class="word">croak</span><span class="structure">(</span><span class="single">'Sled expects arguments as a hashref'</span><span class="structure">);</span><br /><br /> <span class="operator">...</span><br /><span class="structure">}</span></code></pre>
<p>There were two problems with this ref checking pattern. Sometimes some elf would get it subtly wrong:</p>
<pre><code class="code-listing"><span class="word">ref</span> <span class="symbol">$plate_contents</span> <span class="operator">eq</span> <span class="single">'HSAH'</span><br /> <span class="operator">or</span> <span class="word">croak</span><span class="structure">(</span><span class="single">'Plate contents not passed as a hashref'</span><span class="structure">);</span></code></pre>
<p>So subtle was that error that it often slipped through into production! Perl isn't smart enough to know that <code>HSAH</code> probably is a typo for <code>HASH</code> and not a class name the reference had been blessed into. And since error checking code is notoriously hard to test, the automated test suites that Santa insisted on frequently didn't always catch this problem.</p>
<p>If the elves were worried only about correctness alone the code could be replaced by something like this:</p>
<pre><code class="code-listing"><span class="comment"># In a module, and tested<br /></span><span class="keyword">sub</span> <span class="word">is_plain_hash</span> <span class="structure">{</span><br /> <span class="keyword">return</span> <span class="word">ref</span> <span class="magic">$_</span><span class="structure">[</span><span class="number">0</span><span class="structure">]</span> <span class="operator">eq</span> <span class="single">'HASH'</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /> <span class="word">is_plain_hash</span><span class="structure">(</span><span class="symbol">$plate_contents</span><span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">croak</span><span class="structure">(</span><span class="single">'Plate contents not passed as a hashref'</span><span class="structure">);</span></code></pre>
<p>Since under strict a typo in <code>is_plain_hash</code> would cause a compile time error any fat-fingered elf problems would be caught. However, that's just introduced another subroutine call, and since these ref checks are used all over Santa's code base, the cost of doing that adds up!</p>
<p>The second problem with the pattern was the fact that it was strictly doing more work that it needed to. Consider what the following was actually doing:</p>
<pre><code class="code-listing"><span class="word">ref</span> <span class="symbol">$args</span> <span class="operator">eq</span> <span class="single">'HASH'</span></code></pre>
<p>Under the hood perl is inspecting bits on the reference to see if it's a <code>HV</code> (a <code>hash value</code>), then building a standard SV string containing the four characters <code>HASH</code>, then in a separate operation comparing that string character by character with the <code>HASH</code> string which was passed in in the code. That, of course, all happens really quickly, but it's more work (and more Perl virtual ops) than need to happen just to tell if this was a hashref or not!</p>
<p>So the code review had found two problems: One, an abstraction was needed to make it more reliable. Two, the code needed to involve less stuff to make it faster.</p>
<h3 id="The-Voice-of-an-Angel">The Voice of an Angel</h3>
<p>Thank goodness the Wise Old Elf read a <a href="http://cpan-weekly.org/">CPAN Weekly</a> email about this very pattern! Because of this he decided to try out a new module, <a href="https://metacpan.org/module/Ref::Util">Ref::Util</a>.</p>
<p><a href="https://metacpan.org/module/Ref::Util">Ref::Util</a> provides a set of helpful functions to determine what kind of reference a variable is. It abstracts several awkward ref checking patterns into new function. So, as our above example:</p>
<pre><code class="code-listing"><span class="word">ref</span> <span class="symbol">$args</span> <span class="operator">eq</span> <span class="single">'HASH'</span><br /> <span class="operator">or</span> <span class="word">croak</span><span class="structure">(</span><span class="single">'Sled expects arguments as a hashref'</span><span class="structure">);</span></code></pre>
<p>Can be written as:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Ref::Util</span> <span class="words">qw<is_plain_hash></span><span class="structure">;</span><br /><br /><span class="word">is_plain_hash</span><span class="structure">(</span><span class="symbol">$args</span><span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">croak</span><span class="structure">(</span><span class="single">'Sled expects arguments as a hashref'</span><span class="structure">);</span></code></pre>
<p>Or maybe we want to check for a blessed array reference, making sure it isn't accidentally blessed? The following:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Scalar::Util</span> <span class="words">qw<blessed reftype></span><span class="structure">;</span><br /><br /><span class="word">blessed</span> <span class="symbol">$args</span> <span class="operator">&&</span> <span class="word">ref</span> <span class="symbol">$args</span> <span class="operator">&&</span> <span class="word">reftype</span><span class="structure">(</span><span class="symbol">$args</span><span class="structure">)</span> <span class="operator">eq</span> <span class="single">'ARRAY'</span><br /> <span class="operator">or</span> <span class="word">Carp::croak</span><span class="structure">(</span><span class="single">'Uh oh, we require a blessed reference'</span><span class="structure">);</span></code></pre>
<p>Can much more succinctly be written with the new <code>is_blessed_arrayref</code> function:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Ref::Util</span> <span class="words">qw<is_blessed_arrayref></span><span class="structure">;</span><br /><br /><span class="word">is_blessed_arrayref</span><span class="structure">(</span><span class="symbol">$args</span><span class="structure">)</span><br /> <span class="operator">or</span> <span class="word">Carp::croak</span><span class="structure">(</span><span class="single">'Uh oh, we require a blessed reference'</span><span class="structure">);</span></code></pre>
<p>Not writing a lot of code but still being accurate is something Santa appreciates, but that's not the best part....the best part is the speed increase.</p>
<p>Remember when the Elves were worried about the overhead of introducing a new function call? Well, Ref::Util doesn't do that. It introduces a set of new custom ops to do the hard work instead which is much much faster than any kind of function call.</p>
<p>To understand what that means requires an understanding of the internals of perl. When Perl code is run the code is first compiled into a series of "ops" - operations like "add these values", "push to list", or even as complicated as "run this regular expression". These ops are somewhat like the machine code that runs on your actual processor, but much higher level and more complicated. When perl actually runs your code it runs a sort of virtual machine that basically looks at each of these operations in turn and does whatever operation they tell it to do. At a low level what can make perl slow is the number of ops it has to process (since running each op has an overhead) and the complexity of the ops it runs (for example function calls and regular expressions are expensive compared to other more simple ops like add and subtract).</p>
<p>When you call <code>ref $foo eq 'HASH'</code> there are actually several ops that come into play:</p>
<pre><code> ...
6 <2> seq vK/2 ->7
4 <1> ref[t2] sK/1 ->5
3 <#> gvsv[*foo] s ->4
5 <$> const[PV "HASH"] s ->6</code></pre>
<p>Each of these is an operation that perl has to do (create a list, get the value, call ref, etc.). However, when you use Ref::Util, when <code>is_hashref</code> gets encountered, it is then replaced with the following custom op:</p>
<pre><code> 4 <1> is_hashref vK/1 ->5
3 <#> gvsv[*foo] s ->4</code></pre>
<p>While Santa is not exactly sure what all these crazy looking "op-trees" mean, an elf helpfully explained that "it makes the sled go faster". And we don't even need to put racing stripes on the sled!</p>
<p>Less error prone <i>and</i> faster too. Just what the man in red ordered.</p>
</div>2020-12-06T00:00:00ZxsawyerxDevel::Sizehttp://perladvent.org/2020/2020-12-05.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>Have you ever wondered exactly how much memory your data structure are taking up? Normally this isn't the kind of thing that you need to worry about in Perl (Perl is optimised to use more memory so that it can use less CPU time where possible) and Perl handles all the nastiness of allocating and using memory but occasionally, just occasionally, you find yourself in a situation where you need to know this kind of thing.</p>
<p>The thing about memory is that when you run out, well, you run out. As soon as you start having to swap to disk with virtual memory, everything gets extremely slow. Even before you get to this point, it's worth noting the less memory your code has to deal with that for many subtle reasons the faster your code will run.</p>
<p>One situation that's really critical to keep track of memory usage is when you're using mod_perl. mod_perl, the system of embedding perl directly into a webserver, speeds things up a lot by amongst other things keeping a copy of global variables between requests for pages. This means that your scripts don't have to start from scratch each time at the cost of more memory usage. One of the major drawbacks is that if you're not careful then this memory usage can be multiplied over each separate Apache process - typically thirty-fold or so. <b>Devel::Size</b> can help identify situations where this might be a problem, and where you should take steps to ensure this data is placed in memory shared between the processes.</p>
<h3 id="Introducing-Devel::Size">Introducing Devel::Size</h3>
<p>Okay, as an example, let's have a look at some data structures and see how much space they take up. Bear in mind that these figures are valid for my machine only (Debian Linux i386 unstable, with Debian's 5.8.0 threaded perl built with gcc 2.95.4) and the results will vary with your hardware and architecture.</p>
<p>Okay, let's get a list of all the files in the current directory and store it in a data structure:</p>
<pre><code class="code-listing"><span class="comment">#!/usr/bin/perl<br /></span><br /><span class="comment"># turn on perl's safety features<br /></span><span class="keyword">use</span> <span class="pragma">strict</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">warnings</span><span class="structure">;</span><br /><br /><span class="comment"># use Devel::Size, and import the total_size function<br /></span><span class="keyword">use</span> <span class="word">Devel::Size</span> <span class="words">qw(total_size)</span><span class="structure">;</span><br /><br /><span class="comment"># use the cwd function to get the current working directory<br /></span><span class="keyword">use</span> <span class="word">Cwd</span><span class="structure">;</span><br /><br /><span class="comment"># open the current directory list<br /></span><span class="word">opendir</span> <span class="word">DIR</span><span class="operator">,</span> <span class="word">cwd</span><br /> <span class="operator">or</span> <span class="word">die</span> <span class="double">"Couldn't open the current directory"</span><span class="structure">;</span><br /><br /><span class="comment"># get all the files<br /></span><span class="keyword">my</span> <span class="symbol">@files</span><span class="structure">;</span><br /><span class="word">push</span> <span class="symbol">@files</span><span class="operator">,</span> <span class="magic">$_</span> <span class="word">while</span> <span class="structure">(</span><span class="word">readdir</span> <span class="word">DIR</span><span class="structure">);</span><br /><span class="word">closedir</span> <span class="word">DIR</span><span class="structure">;</span><br /><br /><span class="word">print</span> <span class="double">"There are "</span><span class="operator">.</span><span class="symbol">@files</span><span class="operator">.</span><span class="double">" files in your current dir\n"</span><span class="structure">;</span><br /><span class="word">print</span> <span class="double">"Storing this array took up "</span><span class="operator">.</span><br /> <span class="word">total_size</span><span class="structure">(</span><span class="cast">\</span><span class="symbol">@files</span><span class="structure">)</span><span class="operator">.</span><span class="double">" bytes\n"</span><span class="structure">;</span></code></pre>
<p>If I run this script from within my <code>/etc</code> dir I get the following printed out on screen.</p>
<pre><code> There are 240 files in your current dir
Storing this array took up 9055 bytes</code></pre>
<p>Let's try storing some information on the data. Let's pretend I want to know the modification time, the size and the filemode of each of these files.</p>
<p>One approach, the first that comes to mind, is to create a big hash that contains for each file in the directory a smaller hash that has the keys "mtime", "size" and "mode" which have the values for the modification time, size and filemode of the file stored in the values respectively.</p>
<pre><code class="code-listing"><span class="comment"># load File::stat so that 'stat()' will now return a "File::stat"<br /># object that methods like '$st->mode' can be called on<br /></span><span class="keyword">use</span> <span class="word">File::stat</span><span class="structure">;</span><br /><br /><span class="comment"># build a big hash that is keyed by the name of the file and in<br /># which each entry points to another hash that has the size, mtime<br /># and mode stored in it<br /></span><br /><span class="keyword">my</span> <span class="symbol">%stats</span><span class="structure">;</span><br /><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="structure">(</span><span class="symbol">@files</span><span class="structure">)</span><br /><span class="structure">{</span><br /><span class="comment"> # stat the file working out when it was last modified, etc<br /></span> <span class="keyword">my</span> <span class="symbol">$stat</span> <span class="operator">=</span> <span class="word">stat</span><span class="structure">(</span><span class="symbol">$file</span><span class="structure">);</span><br /><br /><span class="comment"> # store the mode, modification time and size of the file<br /> # in a hash so we can access it later<br /></span> <span class="symbol">$stats</span><span class="structure">{</span> <span class="symbol">$file</span> <span class="structure">}{</span><span class="word">size</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">size</span><span class="structure">;</span><br /> <span class="symbol">$stats</span><span class="structure">{</span> <span class="symbol">$file</span> <span class="structure">}{</span><span class="word">mtime</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">mtime</span><span class="structure">;</span><br /> <span class="symbol">$stats</span><span class="structure">{</span> <span class="symbol">$file</span> <span class="structure">}{</span><span class="word">mode</span><span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">mtime</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="word">print</span> <span class="double">"Storing the the hash takes "</span><span class="operator">.</span><br /> <span class="word">total_size</span><span class="structure">(</span><span class="cast">\</span><span class="symbol">%stats</span><span class="structure">)</span><span class="operator">.</span><span class="double">" bytes\n"</span><span class="structure">;</span></code></pre>
<p>Which then prints</p>
<pre><code> Storing the the hash takes 66679 bytes</code></pre>
<p>Wow! That's 65KB. Now that doesn't actually sound like a lot, but if I do that kind of thing in each of my mod_perl children after they've forked, and I'm running twenty servers, then that memory usage is potentially multiplied twenty-fold. that's over a megabyte of memory right there. Let's have a look at storing it in another format...How about if I use a small array for each file instead of each of the small hashes?</p>
<pre><code class="code-listing"><span class="comment"># define constants that refer to the index the elements<br /># are in the array<br /></span><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">FILE_SIZE</span> <span class="operator">=></span> <span class="number">0</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">FILE_MTIME</span> <span class="operator">=></span> <span class="number">1</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">constant</span> <span class="word">FILE_MODE</span> <span class="operator">=></span> <span class="number">2</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">%stats2</span><span class="structure">;</span><br /><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="structure">(</span><span class="symbol">@files</span><span class="structure">)</span><br /><span class="structure">{</span><br /><span class="comment"> # stat the file working out when it was last modified, etc<br /></span> <span class="keyword">my</span> <span class="symbol">$stat</span> <span class="operator">=</span> <span class="word">stat</span><span class="structure">(</span><span class="symbol">$file</span><span class="structure">);</span><br /><br /><span class="comment"> # store the mode, modification time and size of the file<br /> # in an array so we can access it later<br /></span> <span class="symbol">$stats2</span><span class="structure">{</span> <span class="symbol">$file</span> <span class="structure">}[</span><span class="word">FILE_SIZE</span><span class="structure">]</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">size</span><span class="structure">;</span><br /> <span class="symbol">$stats2</span><span class="structure">{</span> <span class="symbol">$file</span> <span class="structure">}[</span><span class="word">FILE_MTIME</span><span class="structure">]</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">mtime</span><span class="structure">;</span><br /> <span class="symbol">$stats2</span><span class="structure">{</span> <span class="symbol">$file</span> <span class="structure">}[</span><span class="word">FILE_MODE</span><span class="structure">]</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">mtime</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="word">print</span> <span class="double">"Storing the the hash takes "</span><span class="operator">.</span><br /> <span class="word">total_size</span><span class="structure">(</span><span class="cast">\</span><span class="symbol">%stats2</span><span class="structure">)</span><span class="operator">.</span><span class="double">" bytes\n"</span><span class="structure">;</span></code></pre>
<p>Which on my system now prints out:</p>
<pre><code> Storing the the hash takes 41239 bytes</code></pre>
<p>Which is a lot better. How about if instead of a hash of lists I use a list of hashes?</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">@stats3</span><span class="structure">;</span><br /><span class="keyword">foreach</span> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="structure">(</span><span class="symbol">@files</span><span class="structure">)</span><br /><span class="structure">{</span><br /><span class="comment"> # stat the file working out when it was last modified, etc<br /></span> <span class="keyword">my</span> <span class="symbol">$stat</span> <span class="operator">=</span> <span class="word">stat</span><span class="structure">(</span><span class="symbol">$file</span><span class="structure">);</span><br /><br /><span class="comment"> # store the mode, modification time and size of the file<br /> # in an array so we can access it later<br /></span> <span class="symbol">$stats3</span><span class="structure">[</span><span class="word">FILE_SIZE</span><span class="structure">]{</span> <span class="symbol">$file</span> <span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">size</span><span class="structure">;</span><br /> <span class="symbol">$stats3</span><span class="structure">[</span><span class="word">FILE_MTIME</span><span class="structure">]{</span> <span class="symbol">$file</span> <span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">mtime</span><span class="structure">;</span><br /> <span class="symbol">$stats3</span><span class="structure">[</span><span class="word">FILE_MODE</span><span class="structure">]{</span> <span class="symbol">$file</span> <span class="structure">}</span> <span class="operator">=</span> <span class="symbol">$stat</span><span class="operator">-></span><span class="word">mtime</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="word">print</span> <span class="double">"Storing the the array takes "</span><span class="operator">.</span><br /> <span class="word">total_size</span><span class="structure">(</span><span class="cast">\</span><span class="symbol">@stats3</span><span class="structure">)</span><span class="operator">.</span><span class="double">" bytes\n"</span><span class="structure">;</span></code></pre>
<p>Which now prints:</p>
<pre><code> Storing the the array takes 38393 bytes</code></pre>
<p>What's interesting here is essentially as we're saving more and more memory we're making our code less and less readable (and hence, less and less maintainable,) or to put it another way <b>The more we try to save memory the less maintainable our code becomes</b> in this example.</p>
<p>So we see we can play games with Perl data structures which reduces our overall memory usage, but to do so we have to sacrifice something else - programmer time - by producing less maintainable code. Which is more important in any particular example is a hard choice to make, but one you can make from a much more informed position with <b>Devel::Size</b> to help you.</p>
</div>2020-12-05T00:00:00ZMark FowlerBuilding Santa's Naughty and Nice List with Stepfordhttp://perladvent.org/2020/2020-12-04.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>It's a little known fact that Santa's elves are the ones responsible for producing his yearly naughty and nice list. But working on the list has been taking up time that they'd rather use for drinking pine juice and playing Dark Souls. They have a crufty <code>Makefile</code> but it doesn't do a great job of rebuilding things when dependencies change, so they're constantly finding output errors and having to delete old files. It also doesn't play all that nicely with the Perl code they wrote to do the real work.</p>
<p>So the elves pooled their money and hired me to automate building the list. Looking at how they'd built the list before, I realized that <a href="https://metacpan.org/release/Stepford">Stepford</a> was the perfect tool for the job!</p>
<h3 id="What-is-Stepford">What is Stepford?</h3>
<p><a href="https://metacpan.org/release/Stepford">Stepford</a> is a tool that takes a set of steps (tasks), figures out their dependencies, and then runs them in the right order to get the result that you ask for. The result itself is just another step that you specify when creating the <a href="https://metacpan.org/pod/Stepford::Runner"><code>Stepford::Runner</code></a> object. Steps are Perl classes built using <a href="https://metacpan.org/release/Moose"><code>Moose</code></a>.</p>
<h4 id="Dependencies-and-Productions">Dependencies and Productions</h4>
<p>The "big thing" that Stepford does for you is to figure out the dependencies needed to get to the final step. It does this by looking at the dependencies and productions of all your steps and then running those steps in the necessary order.</p>
<p>Both dependencies and productions are declared as Moose attributes with a special <code>trait</code>. Here's an example:</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">geolite2_database_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepDependency'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">required</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">ip_scores_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepProduction'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">lazy</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">builder</span> <span class="operator">=></span> <span class="single">'_build_ip_scores_file'</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>You'll see how to actually populate the <code>ip_scores_file</code> later.</p>
<p>Stepford matches a production to a dependency solely by name, which means that attribute names for productions and dependencies must be unique to a given set of steps.</p>
<h4 id="Step-Classes">Step Classes</h4>
<p>A "Step class" is any Moose class which consumes the <a href="https://metacpan.org/pod/Stepford::Role::Step"><code>Stepford::Role::Step</code></a> role (or another role which in turn consumes that role). This role in turn requires that a step class implement a few specific methods named <code>run</code> and <code>last_run_time</code>. You'll see examples of both of these methods as we go further.</p>
<h3 id="What-Goes-Into-the-Naughty-and-Nice-List">What Goes Into the Naughty and Nice List?</h3>
<p>The elves gave me a long list of requirements, but honestly it all seemed like too much trouble. And since these elves are not very technically savvy, I'm going to take the easy route instead and just make some stuff up.</p>
<p>Here's what I'm going to do:</p>
<ul>
<li><p>Get the names and IP addresses for all the children in the world, or at least a few of them.</p>
</li>
<li><p>Assign each child a UUID so I can track them easily.</p>
</li>
<li><p>Download the <a href="http://dev.maxmind.com/geoip/geoip2/geolite2/">free GeoLite2 database</a> from MaxMind.</p>
</li>
<li><p>Use the GeoLite2 database to look at each child's geographical location and use that to give their IP a naughty/nice score. This will be very scientific.</p>
</li>
<li><p>Look at each child's name and use that to give their name a naughty/nice score. Again, this will be very scientific.</p>
</li>
<li><p>Combine the IP and name scores into a single score per child and generate a text file with the naughty/nice list.</p>
</li>
</ul>
<p>Here's a graph of each step showing each steps' dependencies:</p>
<center><a href="step-graph.svg"><img src="step-graph.svg" height="450" width="450"></a></center>
<p>Looking at this graph, you can see a couple interesting things. First, there are two steps, "Get list of children" and "Download GeoLite2 databases", with no dependencies. Next, there are steps that are dependencies for more than one other steps, "Assign UUIDs" and "Get list of children". Finally, the "Combine scores" step has three dependencies but is not a dependency of any other step.</p>
<p>Figuring all this stuff out is what Stepford is for. In fact, it calculates a graph just like this internally.</p>
<h3 id="Building-our-First-Step">Building our First Step</h3>
<p>Let's start by building the step to "Get list of children". All the step classes for a single set of steps should live under the same namespace. I'm going to use <code>NN::Step</code> as our namespace prefix.</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">NN::Step::Children</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 /><span class="keyword">use</span> <span class="pragma">autodie</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">experimental</span> <span class="single">'signatures'</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Data::GUID</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">MooseX::Types::Path::Class</span> <span class="words">qw( Dir File )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Text::CSV_XS</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moose</span><span class="structure">;</span><br /><br /><span class="word">with</span> <span class="single">'Stepford::Role::Step::FileGenerator'</span><span class="structure">;</span><br /><br /><span class="keyword">no</span> <span class="pragma">warnings</span> <span class="single">'experimental::signatures'</span><span class="structure">;</span><br /><br /><span class="word">has</span> <span class="word">root_dir</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">Dir</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="word">default</span> <span class="operator">=></span> <span class="single">'.'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">children_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepProduction'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">lazy</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">builder</span> <span class="operator">=></span> <span class="single">'_build_children_file'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="keyword">sub</span> <span class="word">run</span> <span class="prototype">($self)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">children_file</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">logger</span><span class="operator">-></span><span class="word">info</span><span class="structure">(</span><span class="double">"Writing names and IPs to $file"</span><span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="word">do</span> <span class="structure">{</span><br /> <span class="keyword">local</span> <span class="magic">$/</span><span class="structure">;</span><br /> <span class="readline"><DATA></span><span class="structure">;</span><br /> <span class="structure">};</span><br /><br /><span class="comment"> # CSV line ending per http://tools.ietf.org/html/rfc4180<br /></span> <span class="symbol">$data</span> <span class="operator">=~</span> <span class="substitute">s/\n/\r\n/g</span><span class="structure">;</span><br /> <span class="symbol">$file</span><span class="operator">-></span><span class="word">spew</span><span class="structure">(</span><span class="symbol">$data</span><span class="structure">);</span><br /><span class="structure">}</span><br /><br /><span class="keyword">sub</span> <span class="word">_build_children_file</span> <span class="prototype">($self)</span> <span class="structure">{</span><br /> <span class="keyword">return</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">root_dir</span><span class="operator">-></span><span class="word">file</span><span class="structure">(</span><span class="single">'children.csv'</span><span class="structure">);</span><br /><span class="structure">}</span><br /><br /><span class="word">__PACKAGE__</span><span class="operator">-></span><span class="word">meta</span><span class="operator">-></span><span class="word">make_immutable</span><span class="structure">;</span><br /><br /><span class="number">1</span><span class="structure">;</span><br /><br /><span class="separator">__DATA__</span><br /><span class="data">"Alexander Marer",42.235.92.147<br />"Andrew Bernard Cray",205.145.143.62<br />...</span></code></pre>
<p>Let's look at the interesting bits more closely.</p>
<pre><code class="code-listing"><span class="word">with</span> <span class="single">'Stepford::Role::Step::FileGenerator'</span><span class="structure">;</span></code></pre>
<p>All Stepford classes must consume one of the Step roles provided by Stepford. This particular role tells Stepford that all of this step's outputs are in the form of files. This lets Stepford calculate the step's last run time by looking at the file's modification time. For non-file steps, you have to provide a <code>last_run_time</code> method of your own.</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">root_dir</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">Dir</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="word">default</span> <span class="operator">=></span> <span class="single">'.'</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">children_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepProduction'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">lazy</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">builder</span> <span class="operator">=></span> <span class="single">'_build_children_file'</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>This class has two attributes. The <code>root_dir</code> attribute is neither a dependency nor a production. You'll see how to set this attribute later on. The <code>children_file</code> attribute is a production. Some other steps will depend on this production.</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">run</span> <span class="prototype">($self)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">children_file</span><span class="structure">;</span><br /><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">logger</span><span class="operator">-></span><span class="word">info</span><span class="structure">(</span><span class="double">"Writing names and IPs to $file"</span><span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$data</span> <span class="operator">=</span> <span class="word">do</span> <span class="structure">{</span><br /> <span class="keyword">local</span> <span class="magic">$/</span><span class="structure">;</span><br /> <span class="readline"><DATA></span><span class="structure">;</span><br /> <span class="structure">};</span><br /><br /><span class="comment"> # CSV line ending per http://tools.ietf.org/html/rfc4180<br /></span> <span class="symbol">$data</span> <span class="operator">=~</span> <span class="substitute">s/\n/\r\n/g</span><span class="structure">;</span><br /> <span class="symbol">$file</span><span class="operator">-></span><span class="word">spew</span><span class="structure">(</span><span class="symbol">$data</span><span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>Every Step class must provide a <code>run</code> method. This method is expected to do whatever work the step does. In this case I take the list of children in <code>DATA</code> and turn it into a CSV file.</p>
<p>The <code>logger</code> attribute is provided to each step by the <a href="https://metacpan.org/pod/Stepford::Runner"><code>Stepford::Runner</code></a> class. You'll learn more about that class later.</p>
<h4 id="Atomic-File-Steps">Atomic File Steps</h4>
<p>I could have used <a href="https://metacpan.org/pod/Stepford::Role::Step::FileGenerator::Atomic"><code>Stepford::Role::Step::FileGenerator::Atomic</code></a> instead. If your step is writing a file, using this role will prevent you from leaving behind a half-finished file if the step dies. I didn't use it in my example code just to keep the code simpler, but I highly recommend it for production code.</p>
<h3 id="More-Steps">More Steps</h3>
<p>The other steps are pretty similar. They take some data and spit something new out. Let's take a look at some of the code from the step that adds the UUIDs:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">NN::Step::AssignUUIDs</span><span class="structure">;</span><br /><br /><span class="operator">...</span><br /><br /><span class="word">has</span> <span class="word">children_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepDependency'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">required</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">children_with_uuids_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepProduction'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">lazy</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">builder</span> <span class="operator">=></span> <span class="single">'_build_children_with_uuids_file'</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>This step depends on the <code>children_file</code> created by the <code>Children</code> step. Stepford will figure this out and make sure that the steps are run in the correct order.</p>
<p>The <code>AssignUUIDs</code> step in turn has its own <code>StepProduction</code> which future steps will depend on.</p>
<p>The remaining steps follow a similar pattern. They take an input file and produce an output file. The last step, <code>WriteList</code>, is a little different, so let's see how:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">NN::Step::WriteList</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Moose</span><span class="structure">;</span><br /><br /><span class="word">with</span> <span class="single">'Stepford::Role::Step'</span><span class="structure">;</span></code></pre>
<p>The first difference is that I'm consuming the <a href="https://metacpan.org/pod/Stepford::Role::Step"><code>Stepford::Role::Step</code></a> role instead of <a href="https://metacpan.org/pod/Stepford::Role::Step::FileGenerator"><code>Stepford::Role::Step::FileGenerator</code></a>.</p>
<p>This is mostly so I can demonstrate how to write a <code>last_run_time</code> method.</p>
<pre><code class="code-listing"><span class="word">has</span> <span class="word">children_with_uuids_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepDependency'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">required</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">ip_scores_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepDependency'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">required</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span><br /><br /><span class="word">has</span> <span class="word">name_scores_file</span> <span class="operator">=></span> <span class="structure">(</span><br /> <span class="word">traits</span> <span class="operator">=></span> <span class="structure">[</span><span class="single">'StepDependency'</span><span class="structure">]</span><span class="operator">,</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">File</span><span class="operator">,</span><br /> <span class="word">required</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /><span class="structure">);</span></code></pre>
<p>This step has three dependencies, unlike the previous steps you've seen. Each of these dependencies comes from a separate step. Stepford will figure all that out for us and run those steps before this one.</p>
<p>And here's the <code>last_run_time</code> method:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">last_run_time</span> <span class="prototype">($self)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$file</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">_naughty_nice_list</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="core">undef</span> <span class="word">unless</span> <span class="operator">-e</span> <span class="symbol">$file</span><span class="structure">;</span><br /><br /> <span class="keyword">return</span> <span class="symbol">$file</span><span class="operator">-></span><span class="word">stat</span><span class="operator">-></span><span class="word">mtime</span><span class="structure">;</span><br /><span class="structure">}</span></code></pre>
<p>This is pretty straightforward. If the file exists, I return its last modification time. If not, I return <code>undef</code>.</p>
<p>Stepford uses the value of each step's <code>last_run_time</code> to determine whether or not a given step needs to be run at all. If the data in a dependency is newer than the data in the step that depends on that data, there's no point in regenerating the dependency's data.</p>
<p>(By the way, the <code>last_run_time</code> method above is essentially the same as the one in <code>Stepford::Role::Step::FileGenerator</code>.)</p>
<h3 id="Running-Your-Steps">Running Your Steps</h3>
<p>Now that I've written my steps, how do I run them? Here's the script I wrote:</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">FindBin</span> <span class="words">qw( $Bin )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">lib</span> <span class="double">"$Bin/../lib"</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Getopt::Long</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Log::Dispatch</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="word">Stepford::Runner</span><span class="structure">;</span><br /><br /><span class="keyword">sub</span> <span class="word">main</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$debug</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$jobs</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$root</span><span class="structure">;</span><br /><br /> <span class="word">GetOptions</span><span class="structure">(</span><br /> <span class="single">'debug'</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$debug</span><span class="operator">,</span><br /> <span class="single">'jobs:i'</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$jobs</span><span class="operator">,</span><br /> <span class="single">'root:s'</span> <span class="operator">=></span> <span class="cast">\</span><span class="symbol">$root</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">$logger</span> <span class="operator">=</span> <span class="word">Log::Dispatch</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">outputs</span> <span class="operator">=></span> <span class="structure">[</span><br /> <span class="structure">[</span><br /> <span class="single">'Screen'</span><span class="operator">,</span><br /> <span class="word">newline</span> <span class="operator">=></span> <span class="number">1</span><span class="operator">,</span><br /> <span class="word">min_level</span> <span class="operator">=></span> <span class="symbol">$debug</span> <span class="operator">?</span> <span class="single">'debug'</span> <span class="operator">:</span> <span class="single">'warning'</span><span class="operator">,</span><br /> <span class="structure">]</span><br /> <span class="structure">]</span><br /> <span class="structure">);</span><br /><br /> <span class="word">Stepford::Runner</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">step_namespaces</span> <span class="operator">=></span> <span class="single">'NN::Step'</span><span class="operator">,</span><br /> <span class="word">logger</span> <span class="operator">=></span> <span class="symbol">$logger</span><span class="operator">,</span><br /> <span class="structure">)</span><span class="operator">-></span><span class="word">run</span><span class="structure">(</span><br /> <span class="word">config</span> <span class="operator">=></span> <span class="structure">{</span> <span class="symbol">$root</span> <span class="operator">?</span> <span class="structure">(</span> <span class="word">root_dir</span> <span class="operator">=></span> <span class="symbol">$root</span> <span class="structure">)</span> <span class="operator">:</span> <span class="structure">()</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">final_steps</span> <span class="operator">=></span> <span class="single">'NN::Step::WriteList'</span><span class="operator">,</span><br /> <span class="structure">);</span><br /><br /> <span class="word">exit</span> <span class="number">0</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="word">main</span><span class="structure">();</span></code></pre>
<p>The only interesting piece is my use of <a href="https://metacpan.org/pod/Stepford::Runner"><code>Stepford::Runner</code></a>.</p>
<pre><code class="code-listing"><span class="word">Stepford::Runner</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span><br /> <span class="word">step_namespaces</span> <span class="operator">=></span> <span class="single">'NN::Step'</span><span class="operator">,</span><br /> <span class="word">logger</span> <span class="operator">=></span> <span class="symbol">$logger</span><span class="operator">,</span><br /> <span class="word">jobs</span> <span class="operator">=></span> <span class="symbol">$jobs</span> <span class="operator">//</span> <span class="number">1</span><span class="operator">,</span><br /> <span class="structure">)</span><span class="operator">-></span><span class="word">run</span><span class="structure">(</span><br /> <span class="word">config</span> <span class="operator">=></span> <span class="structure">{</span> <span class="symbol">$root</span> <span class="operator">?</span> <span class="structure">(</span> <span class="word">root_dir</span> <span class="operator">=></span> <span class="symbol">$root</span> <span class="structure">)</span> <span class="operator">:</span> <span class="structure">()</span> <span class="structure">}</span><span class="operator">,</span><br /> <span class="word">final_steps</span> <span class="operator">=></span> <span class="single">'NN::Step::WriteList'</span><span class="operator">,</span><br /> <span class="structure">);</span></code></pre>
<p>The <code>Stepford::Runner</code> constructor takes several named arguments. The <code>step_namespaces</code> argument tells Stepford under what namespace it should look for steps. It will load all the classes that it finds under this namespace.</p>
<p>You can pass multiple namespaces as an array reference. When two steps have a production of the same name, then the step that comes first in the list of namespaces wins. This is useful for testing, as it lets you mock as many steps as you need to.</p>
<p>The <code>logger</code> can be any object that provides a certain set of methods (<code>debug</code>, <code>info</code>, etc.).</p>
<p>Finally, if you set <code>jobs</code> to a value greater than one, Stepford will run steps in parallel, running up to <code>$jobs</code> steps at once whenever possible.</p>
<p>The call to the <code>run</code> method also accepts named arguments. Keys in the <code>config</code> argument which match constructor arguments for a step will be passed to that step class as the step is constructed. Remember way back up above when I mentioned that I'd show you how to set the <code>root_dir</code> attribute of the <code>NN::Step::Children</code> class. This is how you do that.</p>
<p>The <code>final_steps</code> argument can be a single step class name or an array reference of names. This is how you specify the result you're asking Stepford for.</p>
<h3 id="Why-Stepford">Why Stepford?</h3>
<p>Stepford is lot like <code>make</code>, <code>rake</code>, and many other tools. Stepford was originally created to help improve our automation around building <a href="https://www.maxmind.com/en/geoip2-databases">GeoIP databases</a> at <a href="https://www.maxmind.com/">MaxMind</a>.</p>
<p>I investigated <code>make</code> and <code>rake</code>, which are both great tools. However, what makes them shine is how they integrate with certain environments. The <code>make</code> tool is great if you're interacting with a lot of existing command line tools like compilers, linkers, etc. And of course <code>rake</code> is great if you're dealing with existing Ruby code.</p>
<p>But our database building code was is written in Perl, so it made sense to write a tool in Perl.</p>
<p>If you're in a similar situation, with a Perl code base that executes a series of steps towards one or more final products, then Stepford might be a good choice for you as well.</p>
<p>It certainly worked well for those elves. Sure, the naughty and nice list they get is complete and utter nonsense, but it's a lot quicker to generate, giving them more time for their pine juice-fueled Dark Souls speedruns.</p>
<h3 id="The-Code">The Code</h3>
<p>If you want to see all the step code for this article, check out <a href="https://github.com/autarch/perl-advent-calendar-2015-stepford">this article's GitHub repo</a>.</p>
<h3 id="See-Also">See Also</h3>
<ul>
<li><p><a href="https://metacpan.org/release/Stepford">Stepford</a></p>
</li>
<li><p><a href="https://www.gnu.org/software/make/">make</a></p>
</li>
<li><p><a href="http://docs.seattlerb.org/rake/">rake</a></p>
</li>
</ul>
</div>2020-12-04T00:00:00ZDave RolskyThere is No Tryhttp://perladvent.org/2020/2020-12-03.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<h2 id="eval-Stinks"><code>eval</code> Stinks</h2>
<p>This is a pretty common pattern of code:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="word">eval</span> <span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">computation_helper</span><span class="operator">-></span><span class="word">compute_stuff</span> <span class="structure">};</span><br /><br /><span class="keyword">if</span> <span class="structure">(</span><span class="magic">$@</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">set_last_error</span><span class="structure">(</span> <span class="double">"couldn't get stuff computed: $@"</span> <span class="structure">);</span><br /> <span class="keyword">return</span> <span class="core">undef</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="keyword">return</span> <span class="symbol">$result</span><span class="structure">;</span></code></pre>
<p>In other words, try to call some method on <code>$self</code>'s helper object. If it fails, set an error and return <code>undef</code>. Otherwise, return the result we got. You can find code like this all over the place, and unfortunately, it's got problems.</p>
<p>The most horrible, and possibly well known, is that <code>$@</code> being set isn't the right way to check for <code>eval</code> failing. (Let's not worry about the pathological case of someone throwing a false exception object. That's just sick.)</p>
<p>The real reason is that until recently, <code>$@</code> could get easily clobbered by action at a distance. For example, look at the code again:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="word">eval</span> <span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">computation_helper</span><span class="operator">-></span><span class="word">compute_stuff</span> <span class="structure">};</span></code></pre>
<p>It's calling <code>computation_helper</code> which might look like this:</p>
<pre><code class="code-listing"><span class="keyword">sub</span> <span class="word">computation_helper</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$self</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="keyword">return</span> <span class="word">Computation::Helper</span><span class="operator">-></span><span class="word">new</span><span class="structure">(</span> <span class="word">helper_for</span> <span class="operator">=></span> <span class="symbol">$self</span> <span class="structure">);</span><br /><span class="structure">}</span></code></pre>
<p>It sets up some helper object that we can throw away when we're done. We call its <code>compute_stuff</code> method, which dies. At this point, <code>eval</code> starts to return false, with <code>$@</code> set to that exception message. Unfortunately, little known to us, this code exists:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">Computation::Helper</span><span class="structure">;</span><br /><span class="keyword">sub</span> <span class="word">DESTROY</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$self</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="word">eval</span> <span class="structure">{</span> <span class="operator">...</span> <span class="structure">};</span><br /><span class="structure">}</span></code></pre>
<p>...and it's going to clobber our <code>$@</code> when the helper object gets destroyed – and that's going to happen once the <code>eval</code> block is done and the helper object is no longer referenced by anything. Instead of testing for <code>$@</code>, we should test for a false return from <code>eval</code>:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="word">eval</span> <span class="structure">{</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">computation_helper</span><span class="operator">-></span><span class="word">compute_stuff</span> <span class="structure">};</span><br /><br /><span class="keyword">if</span> <span class="structure">(</span><span class="operator">!</span> <span class="symbol">$result</span><span class="structure">)</span> <span class="structure">{</span><br /><span class="comment"> # we died! set last_error, etc.<br /></span><span class="structure">}</span></code></pre>
<p>This isn't any good, either, though. What if <code>compute_stuff</code> can actually return false, or more specifically the empty string? We need to rewrite to force <code>eval</code>'s hand:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$result</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$ok</span> <span class="operator">=</span> <span class="word">eval</span> <span class="structure">{</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">computation_helper</span><span class="operator">-></span><span class="word">compute_stuff</span><span class="structure">;</span> <span class="number">1</span> <span class="structure">};</span><br /><br /><span class="keyword">if</span> <span class="structure">(</span><span class="operator">!</span> <span class="symbol">$ok</span><span class="structure">)</span> <span class="structure">{</span><br /><span class="comment"> # we died! set last_error, etc.<br /></span><span class="structure">}</span></code></pre>
<p>Now we know that <code>eval</code> will always return <code>1</code> unless it fails. This means we need to move the assignment to <code>$result</code> inside the eval, and we need to move the declaration to an new, earlier statement.</p>
<p>Finally, to keep our eval from clobbering anybody else's <code>$@</code> in the future, we need to localize. In the end, our code ends up as:</p>
<pre><code class="code-listing"><span class="keyword">my</span> <span class="symbol">$result</span><span class="structure">;</span><br /><span class="keyword">my</span> <span class="symbol">$ok</span> <span class="operator">=</span> <span class="word">do</span> <span class="structure">{</span><br /> <span class="keyword">local</span> <span class="magic">$@</span><span class="structure">;</span><br /> <span class="word">eval</span> <span class="structure">{</span> <span class="symbol">$result</span> <span class="operator">=</span> <span class="symbol">$self</span><span class="operator">-></span><span class="word">computation_helper</span><span class="operator">-></span><span class="word">compute_stuff</span><span class="structure">;</span> <span class="number">1</span> <span class="structure">};</span><br /><span class="structure">};</span><br /><br /><span class="keyword">if</span> <span class="structure">(</span><span class="operator">!</span> <span class="symbol">$ok</span><span class="structure">)</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$error</span> <span class="operator">=</span> <span class="magic">$@</span> <span class="operator">eq</span> <span class="single">''</span> <span class="operator">?</span> <span class="single">'unknown error'</span> <span class="operator">:</span> <span class="double">"$@"</span><span class="structure">;</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">set_last_error</span><span class="structure">(</span> <span class="double">"couldn't get stuff computed: $error"</span> <span class="structure">);</span><br /> <span class="keyword">return</span> <span class="core">undef</span><span class="structure">;</span><br /><span class="structure">}</span><br /><br /><span class="keyword">return</span> <span class="symbol">$result</span><span class="structure">;</span></code></pre>
<p>Even if not a <i>huge</i> increase in the code needed for the operation, it's a bunch of magic to remember every time. If you don't do this sort of thing, though, you've got a big opening for horrible error-handling problems.</p>
<h2 id="Two-Solutions">Two Solutions</h2>
<p>It's worth noting that these problems are greatly lessened in perl 5.14, where our hypothetical <code>DESTROY</code> method would not have clobbered the outer <code>$@</code>. If you can use 5.14, you should, and this is one very good reason.</p>
<p>That still leaves a bunch of boilerplate, though. This is why <a href="https://metacpan.org/module/Try::Tiny">Try::Tiny</a> has become so popular. Unlike many of the other, more feature-rich try/catch systems on the CPAN, Try::Tiny focuses on doing just the minimum needed to avoid the boilerplate above. For example, we'd write the code above as:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Try::Tiny</span><span class="structure">;</span><br /><br /><span class="keyword">return</span> <span class="word">try</span> <span class="structure">{</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">computation_helper</span><span class="operator">-></span><span class="word">compute_stuff</span><span class="structure">;</span><br /><span class="structure">}</span> <span class="word">catch</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$error</span> <span class="operator">=</span> <span class="magic">$_</span> <span class="operator">eq</span> <span class="single">''</span> <span class="operator">?</span> <span class="single">'unknown error'</span> <span class="operator">:</span> <span class="double">"$_"</span><span class="structure">;</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">set_last_error</span><span class="structure">(</span> <span class="double">"couldn't get stuff computed: $error"</span> <span class="structure">);</span><br /> <span class="keyword">return</span> <span class="core">undef</span><span class="structure">;</span><br /><span class="structure">};</span></code></pre>
<p>It encapsulates the localization of the error variable and the addition of the constant true value to check for. The <code>catch</code> block is only entered if the <code>try</code> block died, and the exception thrown is in <code>$_</code> (and <code>$_[0]</code>). Simple!</p>
<h2 id="Extra-Sugar">Extra Sugar</h2>
<p>Try::Tiny also provides one more helper: <code>finally</code>. It lets you provide a block (or many blocks) of code to be run after the <code>try</code> and <code>catch</code>, no matter whether there was an error:</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">Try::Tiny</span><span class="structure">;</span><br /><br /><span class="keyword">my</span> <span class="symbol">$start</span> <span class="operator">=</span> <span class="word">Time::HiRes::time</span><span class="structure">;</span><br /><br /><span class="keyword">return</span> <span class="word">try</span> <span class="structure">{</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">computation_helper</span><span class="operator">-></span><span class="word">compute_stuff</span><span class="structure">;</span><br /><span class="structure">}</span> <span class="word">catch</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$error</span> <span class="operator">=</span> <span class="magic">$_</span> <span class="operator">eq</span> <span class="single">''</span> <span class="operator">?</span> <span class="single">'unknown error'</span> <span class="operator">:</span> <span class="double">"$_"</span><span class="structure">;</span><br /> <span class="symbol">$self</span><span class="operator">-></span><span class="word">set_last_error</span><span class="structure">(</span> <span class="double">"couldn't get stuff computed: $error"</span> <span class="structure">);</span><br /> <span class="keyword">return</span> <span class="core">undef</span><span class="structure">;</span><br /><span class="structure">}</span> <span class="word">finally</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$failed</span> <span class="operator">=</span> <span class="magic">@_</span><span class="structure">;</span><br /> <span class="keyword">my</span> <span class="symbol">$end</span> <span class="operator">=</span> <span class="word">Time::HiRes::time</span><span class="structure">;</span><br /> <span class="word">warn</span> <span class="word">sprintf</span> <span class="double">"took %f seconds to %s"</span><span class="operator">,</span><br /> <span class="symbol">$end</span> <span class="operator">-</span> <span class="symbol">$start</span><span class="operator">,</span><br /> <span class="symbol">$failed</span> <span class="operator">?</span> <span class="single">'fail'</span> <span class="operator">:</span> <span class="single">'succeed'</span><span class="structure">;</span><br /><span class="structure">};</span></code></pre>
<p>You can tell whether the <code>try</code> block failed by whether there are any elements in <code>@_</code>. Even if somehow the contents of <code>$@</code> couldn't be preserved, you'll find an undef in the argument list if the try failed. Otherwise, it will be empty. You can supply as many try blocks as you want.</p>
<p>Try::Tiny doesn't do much, but it nicely packages up a pattern that's important to use and really boring to type out every time. Not only does it save you from having to remember the details each time, but it gives you an interface that's easier to write and skim, too. Use it!</p>
<h2 id="See-Also">See Also</h2>
<ul>
<li><p><a href="https://metacpan.org/module/Try::Tiny">Try::Tiny</a></p>
</li>
</ul>
</div>2020-12-03T00:00:00ZMark FowlerNorth Pole Safety Precautionshttp://perladvent.org/2020/2020-12-02.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<p>The Wise Old Elf was pair programming with Noel Cuddlecrackers, one of the newer elves to join Santa's merry little band of programmers.</p>
<p>Noel and he had agreed to start work on a really simple script. Noel opened a new file, and the Wise Old Elf watched patiently as Noel typed:</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></code></pre>
<p>"Pretty good", the Wise Old Elf thought to himself, "at least he's enabling strictures to help catch mistakes". Noel kept typing though...</p>
<pre><code class="code-listing"><span class="keyword">no</span> <span class="pragma">indirect</span><span class="structure">;</span></code></pre>
<p>"Excellent, Noel's not allowing calls of the form <code>new Foo</code>" the elder Elf thought to himself. But Noel wasn't done typing...</p>
<pre><code class="code-listing"><span class="keyword">no</span> <span class="pragma">multidimensional</span><span class="structure">;</span></code></pre>
<p>"Okay, so Noel's disabling Perl's problematic multi-dimensional array syntax that no-one uses since we use arrays containing references to arrays these days" the Wise old Elf considered. But Noel still was typing more things...</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">autodie</span> <span class="words">qw(:all)</span><span class="structure">;</span></code></pre>
<p>"Now he's avoiding to have to manually check each time if one of Perl's IO routines succeeded, and just have them automatically throw an exception". Noel was <b>still</b> typing...</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="pragma">utf8</span><span class="structure">;</span></code></pre>
<p>"So he's allowing utf-8 encoding in the document so he can type non-ascii characters directly into the source" the Wise Old Elf mused.</p>
<p>Noel was still typing. The Wise Old Elf had to stop him before he became the Wise Much Older Elf.</p>
<p>"Noel", he asked, "exactly how much more boilerplate stuff are you going to type before we get to work?"</p>
<p>"Not much", the young faced worker replied, with a big grin on his face, "I just have to enable a few experimental features, monkey around with the method resolution order, and..."</p>
<p>"STOP", the Wise Old Elf firmly interrupted. "You do realize that we have a standard module that we use for our in house stuff that does all of this for us, don't you?" Indeed, it was true. A few years back the Wise Old Elf had monkeyed around with a Perl module called <code>Import::Into</code> that allowed a module to import modules into whoever used that module. This allowed the Wise Old Elf to create a standard boilerplate module that they now imported at the start of every Perl source file. Near the top of each file there simply was the line</p>
<pre><code class="code-listing"><span class="keyword">use</span> <span class="word">NorthPole::Ourperl</span><span class="structure">;</span></code></pre>
<p>And all the source code that Cuddlecrackers wrote (and was going to add) could be replaced. <code>Import::Into</code> is simple to use - you simply call the fully qualified method <code>import::into</code> on the package name you want to import into whoever uses your module inside the <code>import</code> method:</p>
<pre><code class="code-listing"><span class="keyword">package</span> <span class="word">NorthPole::Ourperl</span><span class="structure">;</span><br /><span class="operator">...</span><br /><br /><span class="keyword">sub</span> <span class="word">import</span> <span class="structure">{</span><br /><span class="comment"> # turn on 'use strict' in whoever does 'use NorthPole::Ourperl'<br /></span> <span class="word">strict</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="number">1</span><span class="structure">);</span><br /> <span class="operator">...</span><br /><span class="structure">}</span></code></pre>
<p>The full package that the North Pole is currently using looks like this:</p>
<pre><code class="code-listing"><span class="comment">## no critic (NamingConventions::Capitalization)<br /></span><span class="keyword">package</span> <span class="word">NorthPole::Ourperl</span><span class="structure">;</span><br /><span class="comment">## use critic (NamingConventions::Capitalization)<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">our</span> <span class="symbol">$VERSION</span> <span class="operator">=</span> <span class="single">'1.000000'</span><span class="structure">;</span><br /><br /><span class="keyword">use</span> <span class="word">Import::Into</span><span class="structure">;</span><br /><br /><span class="comment"># XXX - it'd be nice to include bareword::filehandles but this conflicts with<br /># autodie - see https://rt.cpan.org/Ticket/Display.html?id=93591<br /></span><span class="keyword">use</span> <span class="pragma">autodie</span> <span class="float">2.25</span> <span class="structure">();</span><br /><span class="keyword">use</span> <span class="word">IPC::System::Simple</span><span class="structure">;</span> <span class="comment"># to fatalize system</span><br /><span class="keyword">use</span> <span class="pragma">experimental</span> <span class="structure">();</span><br /><span class="keyword">use</span> <span class="pragma">feature</span> <span class="structure">();</span><br /><span class="keyword">use</span> <span class="pragma">indirect</span> <span class="structure">();</span><br /><span class="keyword">use</span> <span class="pragma">mro</span> <span class="structure">();</span><br /><span class="keyword">use</span> <span class="pragma">multidimensional</span> <span class="structure">();</span><br /><br /><span class="comment"># This adds the UTF-8 layer on STDIN, STDOUT, STDERR for _everyone_<br /></span><span class="keyword">use</span> <span class="pragma">open</span> <span class="words">qw( :encoding(UTF-8) :std )</span><span class="structure">;</span><br /><span class="keyword">use</span> <span class="pragma">utf8</span> <span class="structure">();</span><br /><br /><span class="keyword">sub</span> <span class="word">import</span> <span class="structure">{</span><br /> <span class="keyword">my</span> <span class="symbol">$caller_level</span> <span class="operator">=</span> <span class="number">1</span><span class="structure">;</span><br /><br /> <span class="word">strict</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller_level</span><span class="structure">);</span><br /> <span class="word">warnings</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller_level</span><span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="symbol">@experiments</span> <span class="operator">=</span> <span class="words">qw(<br /> lexical_subs<br /> postderef<br /> signatures<br /> )</span><span class="structure">;</span><br /> <span class="word">experimental</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span> <span class="symbol">$caller_level</span><span class="operator">,</span> <span class="symbol">@experiments</span> <span class="structure">);</span><br /><br /> <span class="keyword">my</span> <span class="structure">(</span><span class="symbol">$version</span><span class="structure">)</span> <span class="operator">=</span> <span class="magic">$^V</span> <span class="operator">=~</span> <span class="match">/^v(5\.\d+)/</span><span class="structure">;</span><br /> <span class="word">feature</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span> <span class="symbol">$caller_level</span><span class="operator">,</span> <span class="single">':'</span> <span class="operator">.</span> <span class="symbol">$version</span> <span class="structure">);</span><br /><span class="comment"> ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)<br /></span> <span class="word">mro::set_mro</span><span class="structure">(</span> <span class="word">scalar</span> <span class="word">caller</span><span class="structure">()</span><span class="operator">,</span> <span class="single">'c3'</span> <span class="structure">);</span><br /><span class="comment"> ## use critic<br /></span> <span class="word">utf8</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span><span class="symbol">$caller_level</span><span class="structure">);</span><br /><br /> <span class="word">indirect</span><span class="operator">-></span><span class="word">unimport::out_of</span><span class="structure">(</span> <span class="symbol">$caller_level</span><span class="operator">,</span> <span class="single">':fatal'</span> <span class="structure">);</span><br /> <span class="word">multidimensional</span><span class="operator">-></span><span class="word">unimport::out_of</span><span class="structure">(</span><span class="symbol">$caller_level</span><span class="structure">);</span><br /> <span class="single">'open'</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span> <span class="symbol">$caller_level</span><span class="operator">,</span> <span class="single">':encoding(UTF-8)'</span> <span class="structure">);</span><br /> <span class="word">autodie</span><span class="operator">-></span><span class="word">import::into</span><span class="structure">(</span> <span class="symbol">$caller_level</span><span class="operator">,</span> <span class="single">':all'</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:</p>
<ul>
<li>Enables <code>strict</code></li>
<li>Enables <code>warnings</code></li>
<li>Turns on the experimental lexical subs feature</li>
<li>Turns on the experimental postfix dereferencing feature</li>
<li>Turns on the experimental signature feature</li>
<li>Turns on whatever standard features this version of Perl supports (e.g. say, etc)</li>
<li>Sets the method resolution in the module to be <code>c3</code></li>
<li>Disables indirect method calls</li>
<li>Disables old-style multidimensional array simulation</li>
<li>Configures the filehandles to be UTF-8 everywhere</li>
<li>Enables autodie for all system calls</li>
</ul>
<p>In one line!</p>
<small>Above source code example adapted from <a href="https://metacpan.org/pod/App::GHPT::Wrapper::Ourperl">App::GHPT::Wrapper::Ourperl</a>, Copyright (c) 2017 by MaxMind, Inc, licensed under the The Artistic License 2.0.</small>
</div>2020-12-02T00:00:00ZMark FowlerHow Santa's Elves Keep their Workshop Tidyhttp://perladvent.org/2020/2020-12-01.html<div class='pod'><p><div class="bestof"> 2020 has been time consuming - a global pandemic, giant fires, horrific floods and political unrest - which has left us little time for side projects. This year we're looking back to happier times into the 20+ year archive with the Best of the Perl Advent Calendar. </div>
</p>
<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>2020-12-01T00:00:00ZOlaf Alders