Creating a Simple DSL in Perl

Let's look at the XSPF playlist format. It's a pretty simple XML-based
file format.

<?xml version="1.0" encoding="UTF-8"?>
<playlist version="1" xmlns="http://xspf.org/ns/0/">
  <title>80's Music</title>
  <trackList>
    <track>
      <title>Take On Me</title>
      <creator>A-ha</creator>
      <location>https://example.com/music/01.mp3</location>
    </track>
    <track>
      <title>Tainted Love</title>
      <creator>Soft Cell</creator>
      <location>https://example.com/music/02.mp3</location>
    </track>
    <track>
      <title>Livin' on a Prayer</title>
      <creator>Bon Jovi</creator>
      <location>https://example.com/music/03.mp3</location>
    </track>
    </track>
  </trackList>
</playlist>

The full specification has a lot more details, but
for now, we'll just use those elements.

If we are building a Perl application that needs to allow less experienced
users to write playlists in Perl, it might be useful to define a
domain-specific dialect of Perl for writing playlists.

Something like this:

my $pl = playlist {
  title "80's Music";
  track {
    location "https://example.com/music/01.mp3";
    title "Take On Me";
    creator "A-ha";
  };
  track {
    location "https://example.com/music/02.mp3";
    title "Tainted Love";
    creator "Soft Cell";
  };
  track {
    location "https://example.com/music/03.mp3";
    title "Livin' on a Prayer";
    creator "Bon Jovi";
  };
};

It is actually pretty simple to do this!

The playlist function

A simple implementation of the playlist function is this:

my $current_playlist;

sub playlist (&) {
  my $block = shift;
  $current_playlist = {};
  $block->();
  return $current_playlist;
}

The prototype of (&) allows a function to accept a block of code.
Our playlist function wants to create a blank playlist (which we'll
implement as an empty hashref), run the block (which will define the tracks),
and then return the playlist.

The reason that the $current_playlist variable is declared outside
the function is so that other functions (such as title) can access it.

Here's an implementation for title:

sub title ($) {
  my $string = shift;
  $current_playlist->{title} = $string;
  return;
}

And we'll use Exporter::Shiny to export our functions. Other exporters
also exist.

use Exporter::Shiny qw( playlist title );

Let's test it:

use XML::XSPF -all;
use Test2::V0;

my $pl = playlist {
  title "Test 123";
};

is( $pl, { title => "Test 123" } );

done_testing;

Yay! It works!

Some sanity checks

We should add some checks to make sure title is only ever used inside
a playlist, and also ensure that playlists are not nested.

use Carp qw( croak );
use Scope::Guard qw( guard );

my $current_playlist;

sub playlist (&) {

  my $block = shift;

  $current_playlist and croak( "Nested playlist" )
  $current_playlist = {};
  my $guard = guard { undef $current_playlist };

  $block->();

  return $current_playlist;
}

sub title ($) {

  my $string = shift;

  $current_playlist or croak( "Title outside playlist" );

  $current_playlist->{title} = $string;
  return;
}

Using a guard to undef $current_playlist at the end of building
a playlist ensures it will always happen, even if the block throws an
exception, so we never end up with $current_playlist remaining dirty
at the end of a playlist block.

Expanding on all that

Expanding upon these ideas to also provide track, creator, and
location functions, we get:

use 5.010001;
use strict;
use warnings;

package XML::XSPF;

# Utility functions we need.
use Carp qw( croak );
use Scope::Guard qw( guard );

# Functions we will export.
use Exporter::Shiny qw(
  playlist
  track
  title
  creator
  location
);

# Scratchpad for storing playlists and tracks while they are
# being built.
my $current_playlist;
my $current_track;

# Function called to define a new playlist.
sub playlist (&) {

  # It accepts a block of Perl code (which will define tracks, etc).
  my $block = shift;

  # Ensure that there isn't already a half-built playlist, and then
  # start building one. The guard ensures that the playlist will be
  # cleaned up at the end of this function, even if an exception gets
  # thrown later.
  $current_playlist and croak( "Nested playlist" );
  $current_playlist = {};
  my $guard = guard { undef $current_playlist };

  # Run the block we were given.
  $block->();

  # Return the complete playlist.
  return $current_playlist;
}

# Function called to define a new track.
sub track (&) {

  # It accepts a block of Perl code (which will add track details).
  my $block = shift;

  # Ensure that there isn't already a half-built track, and we haven't
  # been called outside a playlist, and then start building a track.
  # The guard ensures that the track will be cleaned up at the end of
  # this function, even if an exception gets thrown later.
  $current_track and croak( "Nested track" );
  $current_playlist or croak( "Track outside playlist" );
  $current_track = {};
  my $guard = guard { undef $current_track };

  # Run the block we were given.
  $block->();

  # Add the built track to the playlist. Return nothing.
  push @{ $current_playlist->{trackList} //= [] }, $current_track;
  return;
}

# Function to set the title for current track or playlist.
sub title ($) {

  # It accepts a string.
  my $string = shift;

  # If there's a track being built, that's the target. Otherwise,
  # the target is the playlist being built. It's an error to call
  # this function if neither is being built.
  my $target = $current_track // $current_playlist;
  $target // croak( "Title outside playlist or track" );

  # Set the title. Return nothing.
  $target->{title} = $string;
  return;
}

# Function to set the location for current track.
sub location ($) {

  # It accepts a string.
  my $string = shift;

  # It's an error to call this function if no track is being built.
  $current_track // croak( "Location outside track" );

  # Set the location of the current track. Return nothing.
  $current_track->{location} = $string;
  return;
}

# Function to set the creator for current track.
sub creator ($) {

  # It accepts a string.
  my $string = shift;

  # It's an error to call this function if no track is being built.
  $current_track // croak( "Creator outside track" );

  # Set the creator of the current track. Return nothing.
  $current_track->{creator} = $string;
  return;
}

1;

And here's a simple test:

use Test2::V0;
use Data::Dumper;
use XML::XSPF -all;

my $pl = playlist {
  title "80's Music";
  track {
    location "https://example.com/music/01.mp3";
    title "Take On Me";
    creator "A-ha";
  };
  track {
    location "https://example.com/music/02.mp3";
    title "Tainted Love";
    creator "Soft Cell";
  };
  track {
    location "https://example.com/music/03.mp3";
    title "Livin' on a Prayer";
    creator "Bon Jovi";
  };
};

is(
  $pl,
  {
    title => "80's Music",
    trackList => [
      {
        creator  => "A-ha",
        location => "https://example.com/music/01.mp3",
        title    => "Take On Me",
      },
      {
        creator  => "Soft Cell",
        location => "https://example.com/music/02.mp3",
        title    => "Tainted Love",
      },
      {
        creator  => "Bon Jovi",
        location => "https://example.com/music/03.mp3",
        title    => "Livin' on a Prayer",
      },
    ],
  },
) or diag Dumper( $pl );

done_testing;

If you try it out, it should pass.

Next steps

A good next step might be for playlist to build a blessed
XML::XSPF::Playlist object, and track to build blessed
XML::XSPF::Track objects. XML::XSPF::Playlist could
offer a to_xml method.

These improvements are left as an exercise to the reader.

Comments

[Sloan the DEV Moderator]

Just a heads up that you can add highlighting to the code blocks if you'd like. Just change:

... to specify the language:

More details in our editor guide!

[Toby Inkster]

Yeah, I know, but I've recently been using dev.to's feature where it will import articles from a feed, and I don't think it's able to pick up any syntax highlighting hints. I could edit the draft manually, but I'm lazy.