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.
Top comments (2)
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!
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.