A Video-to-Song Converter in Perl 6

Here's my longest Perl 6 script yet. I'm trying to come up with some shorter ideas for future articles.

I have a directory full of music videos in MP4 format, and wanted to convert the audio to MP3 files. I also wanted to insert the title and artist, which are generally found in the filenames, into the ID3 fields in the MP3 file. However, there was a sticking point: the filenames are inconsistent. The only pattern is that they all end in 12 junk characters and a ".mp4" extension. Other than that, some are "title - artist", some are "artist - title", some are one of those without the hyphen or anything to separate the two, some have other bits of text stuck in here and there, a few don't have the artist at all, and so on.

So I knew I couldn't fully automate it. But I thought there had to be a better solution than renaming them all by hand and typing in all the correct data. What if I wrote a script that did a best guess of what the fields should be, showed them to me, let me edit them, and then used that to create the files? That led to the script below. Notes after.

#!/usr/bin/env perl6
use v6;

sub MAIN() {                                               #1
    my %s;
    for dir.grep: / . ** 12 \.mp4 $/ -> $l {               #2
        my $n = $l.substr(0,*-16);                         #3
        my ($a, $t) = $n.split( rx| \s* \- \s* |, 2 );
        unless $t and $a {
            ($a, $t) = $n.split( rx| \s+ |, 2);            #4
            $t = $a unless $t;
        my %h = ( title   => $t,
                  artist  => $a,
                  album   => 'Downloads',
                  genre   => 'Rock',
                  comment => "Converted by $*PROGRAM-NAME",  #5
        loop {
            %h<newfile> = "%h<artist> - %h<title>.mp3";      #6
            print-song($l, %h);
            my $p = prompt('Type a letter and new value: ');
            my ($c,$r) = $p.split( rx| \s+ |, 2);
            given lc $c {                                    #7
                when 'a' { %h<artist>       = $r }
                when 't' { %h<title>        = $r }
                when 'l' { %h<album>        = $r }
                when 'g' { %h<genre>        = $r }
                when 'c' { %h<comment>      = $r }
                when 'w' { %h<title artist> = %h<artist title> }
                when 'h' { show-help }
                when 'n' { next SONG }
                when 'x' { exit }
                when 's' { last }
                when 'p' {
        %s{$l} = %h;

my &process-saved-songs = sub (%s is rw){                      #8
    for %s.kv -> $k, %v {                                      #9
        my $p1 = run(< ffmpeg -i >, $k, < -ab 96k >, "new/%v<newfile>", :out );  #10
        say $p1.out.slurp-rest;
        my $p2 = run('id3v2',
                     '-a', %v<artist>,
                     '-t', %v<title>,
                     '-A', %v<album>,
                     '-g', %v<genre>,
                     '-c', %v<comment>,
                     "new/%v<newfile>", :out);
        say $p2.out.slurp-rest;
        rename( $k, "./done/$k" ) or die $!;             #11

my &print-song = sub ($l, %h) {
    say qq:to/END/;                                      #12

    Old Filename: $l
    New Filename: %h<newfile>

    Artist:   %h<artist>
    Title:    %h<title>
    aLbum:    %h<album>
    Genre:    %h<genre>
    Comment:  %h<comment>

    w: sWap Title and Artist      s: Save song info         h: Help
    n: Next song without saving   p: Process saved songs    x: Exit      

my &show-help = sub (){
    say q:to/HELP/;
This program tries to determine what the title and artist of a song should be
from its filename, lets you edit those and other ID3 fields, saves a list of
files to process, then processes them by converting them to MP3 format and
setting their ID3 fields.

Type one letter, then if it needs a value, type that after a space
and hit enter.


t Dirty Deeds           -> Changes the song title to "Dirty Deeds"
a AC-DC                 -> Changes the artist to "AC-DC"
l Back in Black         -> Changes the album to "Back in Black"
g Rock                  -> Changes the genre to Rock
c Favorite song         -> Sets the comment field to "Favorite song"
w                       -> Swaps the artist and title fields        
h                       -> Displays this help
s                       -> Saves the song info for processing
p                       -> Processes all saved files
n                       -> Skips to the next song, ignoring this one
x                       -> Exit

    prompt("Hit enter to return to songs: ");

1) I don't really need a MAIN sub, since I don't have any command-line variables. But it's always possible that I'll add some later, so this way I'm prepared. Also, it lets me put %s inside its scope, rather than having it exist in the entire file.

2) There's some interesting stuff going on here. First, dir() replaces all the opendir/readdir stuff we used to have to do. Then you can see how method calls like grep can use the "grep: argument" notation. I kinda like that; I may have to use that more often. The regex here is interesting because it uses .**12 where it would have been .{12} before. By the way, a big thanks to whoever put all the hints in the perl6 compiler that say, "It looks like you're trying to do [insert perl5 thing]; maybe you should try this." Those are a big time-saver.

3) substr() has changed in some ways. Now instead of using a negative number to count from the end of the string, you use *-n to say "end of string minus n". It makes sense. I did notice one problem: if the string isn't that long, you get an error, because then it ends up with a negative number after all, which it doesn't like. So I guess if there's a possibility of a shorter string, you have to adjust for that.

4) I expected to use the new words() method here, but couldn't, because it turns out words() and split() work differently when you give them a limit. split() stuffs all the remaining text in the last element, while words() drops whatever doesn't fit. For instance:

"The quick brown fox".split( rx| \s+ |, 2 ); #= ('The', 'quick brown fox')   
"The quick brown fox".words(2);              #= ('The', 'quick')

So split() it is this time, unless there's an option to words() that I didn't see.

5) Most of the old short-named special variables are gone. The old $0 has become $*PROGRAM-NAME. That's probably not a bad thing; I often had to look up the ones I didn't use regularly anyway. Now $0 is the first captured match from a regex.

6) I'm still getting used to the new look of hash variables. I still catch myself putting $ in front of them, but I'm getting better. The quoting when you don't want interpolation is nice and clear.

7) given/when makes for a nice, clear table of actions here.

8) In Perl 5, if you passed a hash (or array) to a sub, it got flattened out into a list and copies of the values passed, so if you wanted the actual thing passed, you passed a reference. Perl 6 pretty much passes a reference by default, but it also makes it read-only. So to let my sub clean out the hash after doing its work on it, I needed to specify it as rw (read-write).

9) I'm noticing that Perl 6 is even better than 5 at just doing what you mean. Here I'm pulling key and value pairs from a hash, where the values are hash references. In 5, I would have needed to deference those, so I probably would have had something like $s->{$k}{newfile} all over the place. Here I just say, "give me that as a hash," and away I go. I suppose eventually I'll run into a situation where I wish it were more literal and less helpful, but I think that will be rare.

10) I'm not thrilled with the ugliness of this list of arguments. Guess that's why I went a different route two lines later.

11) I tried to use move() first, but it's not implemented yet, so rename() worked.

12) This is the new heredoc syntax. It has some nice features, one being that it's smart about indentation. Here, since END is indented four spaces, it'll strip four spaces from the beginning of the other lines as well. The qq:to/END/; syntax gives cperl-mode in emacs fits, though; I'll have to submit an issue on that.

For details on how to actually use it, run it and hit 'h' for help. Basically, it takes a guess at the file's title and artist, and displays them for you along with some other fields that you can edit. One idea I had was to provide a sWap option that swaps the title and artist fields, since about 1/3 of the files had them backwards from the rest. Once I like a file's info, I hit 's' to save it. It doesn't go ahead and process the file right away, because that might take a while and be annoying. So it saves the info in %s, and doesn't process the files until you hit 'p' to process all saved ones, or when it runs out of files.

It's not really intended to be portable or anything yet, and it assumes a lot of things: that your files have a certain format and extension, that certain directories exist, that you have ffmpeg and id3v2 installed, etc. But feel free to use it, expand on it, laugh at it, curse it, whatever you like.


What does `my &process-saved-songs = sub () {}` gain you over just doing `sub process-saved-songs() {}` ?

One of the things I really like about Perl 6 regexes is that quotes escape metacharacters. For example, instead of this:

rx| \s* \- \s* |

you can also do this, if you like:

rx| \s* '-' \s* |

Printing your help via show-help works, but for future proofing (like you did by creating a MAIN), you may want to rename it to USAGE. USAGE is automatically called if, for example, not enough arguments are provided for MAIN.

I'm working on the substr() bug and lack of move() you pointed out; thanks for doing that!

If you have questions about Perl 6, you can always drop by #perl6 on Freenode. If you find bugs, we are happy to receive them on rt.perl.org under the perl6 queue.


I believe in Perl 6, you can still use sub process-saved-songs and it will be callable sans-parens even if you declare it after MAIN. Also, subs in Perl 6 are lexically scoped by default.

Leave a comment

About Aaron Baugher

user-pic I'm a programmer and Unix sysadmin who uses Perl as much as possible, operating from the Midwest USA. To hire me for sysadmin or programming work, contact me at aaron.baugher @ gmail.com or as 'abaugher' on #perl6.