The Phoenix Trap

Code, music, philosophy, etc.

Tag: Perl

  • How much is that BLÅHAJ in the (terminal) window?

    How much is that BLÅHAJ in the (terminal) window?

    IKEA’s toy BLÅHAJ sharkhas become a beloved Internet iconover the past sev­er­al years. I thought it might be cute to write a lit­tle Perl to get info about it and even dis­play a cud­dly pic­ture right in the ter­mi­nal where I’m run­ning the code. Maybe this will give you some ideas for your own quick web clients. Of course, you could accom­plish all of these things using a pipeline of indi­vid­ual command-​line util­i­ties like curl, jq, and GNU core­uti­ls’ base64. These exam­ples focus on Perl as the glue, though.

    Warning: dodgy API ahead

    I haven’t found a publicly-​documented and ‑sup­port­ed offi­cial API for query­ing IKEA prod­uct infor­ma­tion but oth­ers havedecon­struct­ed the company’s web site AJAXrequests so we can use that instead. The alter­na­tive would be to scrape the IKEA web site direct­ly which, although pos­si­ble, would be more tedious and prone to fail­ure should their design change. An unof­fi­cial API is also unre­li­able but the sim­pler client code is eas­i­er to change should any errors surface.

    Enter the Mojolicious

    My orig­i­nal goal was to do this in a sin­gle line issued to the perlcom­mand, and luck­i­ly the Mojolicious framework’s ojo mod­uleis tailor-​made for such things. By adding a -Mojoswitch to the perlcom­mand, you get over a dozen quick single-​character func­tions for spin­ning up a quick web appli­ca­tion or, in our case, mak­ing and inter­pret­ing web requests with­out a lot of cer­e­mo­ny. Here’s the start of my one-​line request to the IKEA API for infor­ma­tion on their BLÅHAJ prod­uct, using ojo’s gfunc­tionto per­form an HTTP GET and dis­play­ing the JSONfrom the response body to the terminal.

    $ perl -Mojo -E 'say g("https://sik.search.blue.cdtapps.com/us/en/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->body'

    This cur­rent­ly returns over 2,400 lines of data, so after read­ing it over I’ll con­vert the response body JSON to a Perl data struc­tureand dump only the main prod­uct infor­ma­tion using ojo’s rfunc­tion:

    $ perl -Mojo -E 'say r g("https://sik.search.blue.cdtapps.com/us/en/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->json->{searchResultPage}{products}{main}{items}[0]{product}'
{
  "availability" => [],
  "breathTaking" => bless( do{\(my $o = 0)}, 'JSON::PP::Boolean' ),
  "colors" => [
    {
      "hex" => "0058a3",
      "id" => 10007,
      "name" => "blue"
    },
    {
      "hex" => "ffffff",
      "id" => 10156,
      "name" => "white"
    }
  ],
  "contextualImageUrl" => "https://www.ikea.com/us/en/images/products/blahaj-soft-toy-shark__0877371_pe633608_s5.jpg",
  "currencyCode" => "USD",
  "discount" => "",
  "features" => [],
  "gprDescription" => {
    "numberOfVariants" => 0,
    "variants" => []
  },
  "id" => 90373590,
  "itemMeasureReferenceText" => "39 \x{bc} \"",
  "itemNo" => 90373590,
  "itemNoGlobal" => 30373588,
  "itemType" => "ART",
  "lastChance" => $VAR1->{"breathTaking"},
  "mainImageAlt" => "BL\x{c5}HAJ Soft toy, shark, 39 \x{bc} \"",
  "mainImageUrl" => "https://www.ikea.com/us/en/images/products/blahaj-soft-toy-shark__0710175_pe727378_s5.jpg",
  "name" => "BL\x{c5}HAJ",
  "onlineSellable" => bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ),
  "pipUrl" => "https://www.ikea.com/us/en/p/blahaj-soft-toy-shark-90373590/",
  "price" => {
    "decimals" => 99,
    "isRegularCurrency" => $VAR1->{"breathTaking"},
    "prefix" => "\$",
    "separator" => ".",
    "suffix" => "",
    "wholeNumber" => 19
  },
  "priceNumeral" => "19.99",
  "quickFacts" => [],
  "tag" => "NONE",
  "typeName" => "Soft toy"
}

    If I just want the price I can do:

    $ perl -Mojo -E 'say g("https://sik.search.blue.cdtapps.com/us/en/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->json->{searchResultPage}{products}{main}{items}[0]{product}->@{qw(currencyCode priceNumeral)}'
USD19.99

    That ->@{qw(currencyCode priceNumeral)}towards the end uses the post­fix ref­er­ence slic­ing syn­taxintro­duced exper­i­men­tal­ly in Perl v5.20and made offi­cial in v5.24. If you’re using an old­er perl, you’d say:

    $ perl -Mojo -E 'say @{g("https://sik.search.blue.cdtapps.com/us/en/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->json->{searchResultPage}{products}{main}{items}[0]{product}}{qw(currencyCode priceNumeral)}'
USD19.99

    I pre­fer the for­mer, though, because it’s eas­i­er to read left-to-right.

    But I’m not in the United States! Where’s my native currency?

    You can either replace the ​”us/en” in the URL above or use the core I18N::LangTags::Detect mod­uleadded in Perl v5.8.5 if you’re real­ly deter­mined to be portable across dif­fer­ent users’ locales. This is real­ly stretch­ing the def­i­n­i­tion of ​”one-​liner,”though.

    $ LANG=de_DE.UTF-8 perl -Mojo -MI18N::LangTags::Detect -E 'my @lang = (split /-/, I18N::LangTags::Detect::detect)[1,0]; say g("https://sik.search.blue.cdtapps.com/" . join("/", @lang == 2 ? @lang : ("us", "en")) . "/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->json->{searchResultPage}{products}{main}{items}[0]{product}->@{qw(currencyCode priceNumeral)}'
EUR27.99

    Window dressing

    It’s hard to envi­sion cud­dling a num­ber, but luck­i­ly the prod­uct infor­ma­tion returned above links to a JPEG file in the mainImageUrlkey. My favorite ter­mi­nal app iTerm2 can dis­play images inlinefrom either a file or Base64encod­ed data, so adding an extra HTTP request and encod­ing from the core MIME::Base64 mod­uleyields:

    $ perl -Mojo -MMIME::Base64 -E 'say "\c[]1337;File=inline=1;width=100%:", encode_base64(g(g("https://sik.search.blue.cdtapps.com/us/en/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->json->{searchResultPage}{products}{main}{items}[0]{product}{mainImageUrl})->body), "\cG"'

    (You could just send the image URL to iTerm2’s bun­dled imgcatutil­i­ty, but where’s the fun in that?)

    $ imgcat --url `perl -Mojo -E 'print g("https://sik.search.blue.cdtapps.com/us/en/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->json->{searchResultPage}{products}{main}{items}[0]{product}{mainImageUrl}'`

    But I don’t have iTerm2 or a Mac!

    I got you. At the expense of a num­ber of oth­er depen­den­cies, here’s a ver­sion that will work on any ter­mi­nal that sup­ports 256-​color mode with ANSI codesusing Image::Term256Color from CPANand a Unicode font with block char­ac­ters. I’ll also use Term::ReadKeyto size the image for the width of your win­dow. (Again, this stretch­es the def­i­n­i­tion of ​“one-​liner.”)

    $ perl -Mojo -MImage::Term256Color -MTerm::ReadKey -E 'say for Image::Term256Color::convert(g(g("https://sik.search.blue.cdtapps.com/us/en/search-result-page", form => {types => "PRODUCT", q => "BLÅHAJ"})->json->{searchResultPage}{products}{main}{items}[0]{product}{mainImageUrl})->body, {scale_x => (GetTerminalSize)[0], utf8 => 1})'

    I hate Mojolicious! Can’t you just use core modules?

    Fine. Here’s retriev­ing the prod­uct price using HTTP::Tinyand the pure-​Perl JSON pars­er JSON::PP, which were added to core in ver­sion 5.14.

    $ perl -MHTTP::Tiny -MJSON::PP -E 'say @{decode_json(HTTP::Tiny->new->get("https://sik.search.blue.cdtapps.com/us/en/search-result-page?types=PRODUCT&q=BLÅHAJ")->{content})->{searchResultPage}{products}{main}{items}[0]{product}}{qw(currencyCode priceNumeral)}'
USD19.99

    Fetching and dis­play­ing a pic­ture of the hug­gable shark using MIME::Base64 or Image::Term256Color as aboveis left as an exer­cise to the reader.

  • Perl list processing is for hashes, too

    Perl list processing is for hashes, too

    This month I start­ed a new job at Alert Logic, a cyber­se­cu­ri­ty provider with Perl (among many oth­er things) at its beat­ing heart. I’ve been learn­ing a lot, and part of the process has been under­stand­ing the APIs in the code base. To that end, I’ve been writ­ing small test scripts to tease apart data struc­tures, using Perl array-​processing, list-​processing, and hash- (i.e., asso­cia­tive array)-processing func­tions.

    I’ve cov­ered map, grep, and friends a cou­ple timesbefore. Most recent­ly, I described using List::Util’s anyfunc­tionto check if a con­di­tion is true for any item in a list. In the sim­plest case, you can use it to check to see if a giv­en val­ue is in the list at all:

    use feature 'say';
use List::Util 'any';
my @colors =
  qw(red orange yellow green blue indigo violet);
say 'matched' if any { /^red$/ } @colors;

    However, if you’re going to be doing this a lot with arbi­trary strings, Perl FAQ sec­tion 4 advis­esturn­ing the array into the keys of a hash and then check­ing for mem­ber­ship there. For exam­ple, here’s a sim­ple script to check if the col­ors input (either from the key­board or from files passed as argu­ments) are in the rainbow:

    #!/usr/bin/env perl

use v5.22; # introduced <<>> for safe opening of arguments
use warnings;
 
my %in_colors = map {$_ => 1}
  qw(red orange yellow green blue indigo violet);

while (<<>>) {
  chomp;
  say "$_ is in the rainbow" if $in_colors{$_};
}

    List::Util has a bunch of func­tions for pro­cess­ing lists of pairsthat I’ve found use­ful when paw­ing through hash­es. pairgrep, for exam­ple, acts just like grepbut instead assigns $aand $bto each key and val­ue passed in and returns the result­ing pairs that match. I’ve used it as a quick way to search for hash entries match­ing cer­tain val­ue conditions:

    use List::Util 'pairgrep';
my %numbers = (zero => 0, one => 1, two => 2, three => 3);
my %odds = pairgrep {$b % 2} %numbers;

    Sure, you could do this by invok­ing a mix of plain grep, keys, and a hash slice, but it’s nois­i­er and more repetitive:

    use v5.20; # for key/value hash slice 
my %odds = %numbers{grep {$numbers{$_} % 2} keys %numbers};

    pairgrep​’s com­piled C‑based XScode can also be faster, as evi­denced by this Benchmarkscript that works through a hash made of the Unix wordsfile(479,828 entries on my machine):

    #!/usr/bin/env perl

use v5.20;
use warnings;
use List::Util 'pairgrep';
use Benchmark 'cmpthese';

my (%words, $count);
open my $fh, '<', '/usr/share/dict/words'
  or die "can't open words: $!";
while (<$fh>) {
  chomp;
  $words{$_} = $count++;
}
close $fh;

cmpthese(100, {
  grep => sub {
    my %odds = %words{grep {$words{$_} % 2} keys %words};
  },
  pairgrep => sub {
    my %odds = pairgrep {$b % 2} %words;
  },
} );

    Benchmark out­put:

               Rate     grep pairgrep
grep     1.47/s       --     -20%
pairgrep 1.84/s      25%       --

    In gen­er­al, I urge you to work through the Perl doc­u­men­ta­tion​’s tuto­ri­als on ref­er­ences, lists of lists, the data struc­tures cook­book, and the FAQs on arrayand hash manip­u­la­tion. Then dip into the var­i­ous list-​processing mod­ules(espe­cial­ly the includ­ed List::Utiland CPAN’s List::SomeUtils) for ready-​made func­tions for com­mon oper­a­tions. You’ll find a wealth of tech­niques for cre­at­ing, man­ag­ing, and pro­cess­ing the data struc­tures that your pro­grams need.

  • Get out early with Perl statement modifiers

    Get out early with Perl statement modifiers

    When I first start­ed writ­ing Perl in my ear­ly 20’s, I tend­ed to fol­low a lot of the struc­tured pro­gram­mingcon­ven­tions I had learned in school through Pascal, espe­cial­ly the notion that every func­tion has a sin­gle point of exit. For example:

    sub double_even_number {
    # not using signatures, this is mid-1990's code
    my $number = shift;

    if (not $number % 2) {
        $number *= 2;
    }

    return $number; 
}

    This could get pret­ty con­vo­lut­ed, espe­cial­ly if I was doing some­thing like val­i­dat­ing mul­ti­ple argu­ments. And at the time I didn’t yet grok how to han­dle excep­tionswith evaland die, so I’d end up with code like:

    sub print_postal_address {
    # too many arguments, I know
    my ($name, $street1, $street2, $city, $state, $zip) = @_;
    # also this notion of addresses is naive and US-centric

    my $error;

    if (!$name) {
        $error = 'no name';
    }
    else {
        print "$name\n";

        if (!$street1) {
            $error = 'no street';
        }
        else {
            print "$street1\n";

            if ($street2) {
                print "$street2\n";
            }

            if (!$city) {
                $error = 'no city';
            }
            else {
                print "$city, ";

                if (!$state) {
                    $error = 'no state';
                }
                else {
                    print "$state ";

                    if (!$zip) {
                        $error = 'no ZIP code';
                    }
                    else {
                        print "$zip\n";
                    }
                }
            }
        }
    }

    return $error;
}

    What a mess. Want to count all those braces to make sure they’re bal­anced? This is some­times called the arrow anti-​pattern, with the arrowhead(s) being the most nest­ed state­ment. The default ProhibitDeepNests perlcriticpol­i­cyis meant to keep you from doing that.

    The way out (lit­er­al­ly) is guard claus­es: check­ing ear­ly if some­thing is valid and bail­ing out quick­ly if not. The above exam­ple could be written:

    sub print_postal_address {
    my ($name, $street1, $street2, $city, $state, $zip) = @_;

    if (!$name) {
        return 'no name';
    }
    if (!$street1) {
        return 'no street1';
    }
    if (!$city) {
        return 'no city';
    }
    if (!$state) {
        return 'no state';
    }
    if (!$zip) {
        return 'no zip';
    }

    print join "\n",
      $name,
      $street1,
      $street2 ? $street2 : (),
      "$city, $state $zip\n";

    return;
}

    With Perl’s state­ment mod­i­fiers(some­times called post­fix con­trols) we can do even better:

        ...

    return 'no name'    if !$name;
    return 'no street1' if !$street1;
    return 'no city'    if !$city;
    return 'no state'   if !$state;
    return 'no zip'     if !$zip;

    ...

    (Why ifinstead of unless? Because the lat­ter can be con­fus­ing with double-​negatives.)

    Guard claus­es aren’t lim­it­ed to the begin­nings of func­tions or even exit­ing func­tions entire­ly. Often you’ll want to skip or even exit ear­ly con­di­tions in a loop, like this exam­ple that process­es files from stan­dard input or the com­mand line:

    while (<>) {
    next if /^SKIP THIS LINE: /;
    last if /^END THINGS HERE$/;

    ...
}

    Of course, if you are val­i­dat­ing func­tion argu­ments, you should con­sid­er using actu­al sub­rou­tine sig­na­turesif you have a Perl new­er than v5.20 (released in 2014), or one of the oth­er type val­i­da­tion solu­tionsif not. Today I would write that postal func­tion like this, using Type::Paramsfor val­i­da­tion and named arguments:

    use feature qw(say state); 
use Types::Standard 'Str';
use Type::Params 'compile_named';

sub print_postal_address {
    state $check = compile_named(
        name    => Str,
        street1 => Str,
        street2 => Str, {optional => 1},
        city    => Str,
        state   => Str,
        zip     => Str,
    );
    my $arg = $check->(@_);

    say join "\n",
      $arg->{name},
      $arg->{street1},
      $arg->{street2} ? $arg->{street2} : (),
      "$arg->{city}, $arg->{state} $arg->{zip}";

    return;
}

print_postal_address(
    name    => 'J. Random Hacker',
    street1 => '123 Any Street',
    city    => 'Somewhereville',
    state   => 'TX',
    zip     => 12345,
);

    Note that was this part of a larg­er pro­gram, I’d wrap that print_postal_addresscall in a tryblock and catchexcep­tions such as those thrown by the code ref­er­ence $checkgen­er­at­ed by compile_named. This high­lights one con­cern of guard claus­es and oth­er “return ear­ly” pat­terns: depend­ing on how much has already occurred in your pro­gram, you may have to per­form some resource cleanup either in a catchblock or some­thing like Syntax::Keyword::Try’s finallyblock if you need to tidy up after both suc­cess and failure.

  • Highlighting members of the Perl family

    Highlighting members of the Perl family

    This past year of blog­ginghas intro­duced me to a wide vari­ety of peo­ple in the Perl com­mu­ni­ty. Some I’ve admired from afar for years due to their pub­lished work, and even more I’ve ​“met” inter­act­ing on social media and oth­er forums. So this will be the first in an occa­sion­al series high­light­ing not just the code, but the peo­ple that make up the Perl family.

    Paul ​“LeoNerd” Evans

    I first came across Paul’s work dur­ing his series last year on writ­ing a core Perl fea­ture; he’s respon­si­ble for Perl v5.32’s isaoper­a­torand v5.34’s exper­i­men­tal try/​catchexcep­tion han­dling syn­tax. I inter­viewed him about the lat­terfor Perl.com in March 2021. He’s been active on CPANfor so much longer, though, and joined the Perl Steering Council in July. He’s also often a help­ful voice on IRC.

    Elliot Holden

    Renowned author and train­er Randal L. ​“mer­lyn” Schwartzlinked over the week­end in a pri­vate Facebook group to Elliot’s impas­sioned YouTube video about his day job as a Perl web appli­ca­tion devel­op­er. Through his alter ego Urban Guitar LegendElliot is also a pas­sion­ate musi­cian; besides gig­ging and record­ing he’s been post­ing videos for nine years. (I’m a bit envi­ous since I took a break from musicalmost twen­ty years ago and haven’t man­aged to recap­ture it.) Elliot seems like the quin­tes­sen­tial needs-​to-​get-​shit-​done devel­op­er, and Perl is per­fect for that.

    Gábor Szabó

    Gábor is a poly­glot (both in human and com­put­er lan­guages) train­er, con­sul­tant, and author, writ­ing about pro­gram­ming and devops on his Code Mavenand Perl Mavenweb­sites. He’s also the founder and co-​editor of Perl Weeklyand recip­i­ent of a Perl White Camel award in 2008thanks to his orga­ni­za­tion­al and sup­port con­tri­bu­tions. Last year he intro­duced me to the world of live pair pro­gram­ming, work­ing on a web appli­ca­tion using the Mojolicious frame­work.

    If you’re on Twitter and look­ing to con­nect with oth­er Perl devel­op­ers, please con­sid­er par­tic­i­pat­ing in the Perl com­mu­ni­tyI’ve set up there. Twitter Communitiesare topic-​specific mod­er­at­ed dis­cus­sion groups, unlike the free­wheel­ing #hash­tagssys­tem that can be dilut­ed by spam or top­ics that share the same name. Unfortunately, they’re still read-​only on the Twitter Android app, but you can par­tic­i­pate ful­ly on iOS/​iPadOSand the web­site.

  • Perl warnings and the warn function

    Perl warnings and the warn function

    I men­tioned in pass­ing last weekthat the next major release of Perl, v5.36, is set to enable warningsby default for code that opts in to use v5.35;or above. Commemorating Perl’s 34th birth­day the week before that, I not­ed that the warn­ings sys­tem has been get­ting ever finer-​grainedsince its intro­duc­tion in 2000. And fel­low Perl blog­ger and CPAN author Tom Wyanthas been cat­a­loging his favorites over the past sev­er­al months—the lat­est as of this writ­ing was on the ​“ambigu­ous” cat­e­go­ry of warn­ings, and you can find links to pre­vi­ous entries in his series at the bot­tom of that post.

    It occurred to me after­ward that there may be some con­fu­sion between the warningsprag­ma and the relat­ed warnfunc­tionfor report­ing arbi­trary run­time errors. warnout­puts its argu­ments to the stan­dard error (STDERR) stream, or if it’s not giv­en any then you get a string with any excep­tion from $@($EVAL_ERRORunder use English) fol­lowed by a tab and then “...caught at <file> line x.” If that’s emp­ty too, a plain warnjust says, ​“Warning: something's wrong at <file> line x.”, which isn’t exact­ly help­ful, but then again you didn’t give it much to go on.

    warnout­put doesn’t have to go to STDERR, and this is where the rela­tion to the warn­ings prag­ma comes in because both are gov­erned by the __WARN__sig­nal han­dler in the %SIGhash. Normally, you might opt to only dis­play run­time warn­ings if a debug­ging flag is set, like so:

    #!/usr/bin/env perl

use strict;
use warnings;

my $DEBUG = 0;
$SIG{__WARN__} = sub { warn @_ if $DEBUG };
warn 'shhh'; # silenced

$DEBUG = 1;
warn 'hello warnings';

    But if you set that sig­nal han­dler in a BEGINblock, it catch­es compile-​time warn­ings too, in which case flip­ping a flag after the fact has no effect—the compiler’s already run:

    #!/usr/bin/env perl

use strict;
use warnings;

my $DEBUG = 0;
BEGIN { $SIG{__WARN__} = sub { warn @_ if $DEBUG } }
my $foo = 'hello';
my $foo = 'world'; # no warning issued here

$DEBUG = 1;
my $foo = 'howdy'; # still nothing

    By the way, both __WARN__and __DIE__hooks are also used by the Carp mod­uleand its friends, so you can use the same tech­nique with their enhanced output:

    #!/usr/bin/env perl

use strict;
use warnings;
use Carp qw(carp cluck);

my $DEBUG = 0;
BEGIN { $SIG{__WARN__} = sub { warn @_ if $DEBUG } }
carp 'quiet fish';

$DEBUG = 1;
loud_chicken();

sub loud_chicken {
    cluck 'here comes a stack trace';
}

    You coulduse these as step­ping stones towards a debug log for larg­er appli­ca­tions, but at that point, I’d sug­gest look­ing into one of the log­ging mod­ules on CPAN like Log::Log4perl(not to be con­fused with that lately-​problematic Java library), Log::Dispatch(which can be wired into Log4perl), or some­thing elseto suit your needs.