#!/usr/bin/env perl

use v5.24;

use utf8;
use strict;
use warnings;

use Data::Dumper;
use DateTime;
use FindBin qw($RealBin);
use Getopt::Long qw(:config bundling);
use IPC::System::Simple qw(system capture);
use Pod::Usage;
use POSIX::strptime;
use Sys::Hostname qw(hostname);
use Time::HiRes qw(nanosleep);

use feature qw(signatures postderef);
no warnings qw(experimental::signatures);

my $options = {};

#------------------------------------------------------------------------------

# remember to rmmod pcspkr if it wasn't loaded in the first place
my $pcspkr_was_loaded;

# Add pcspkr module if needed
sub add_pcspkr {
    my @modules = capture 'lsmod';

    if (!grep { $_ =~ /^pcspkr/ } @modules) {
        print "module pcspkr not detected, adding\n";
        system qw(modprobe pcspkr);
    } else {
        $pcspkr_was_loaded = 1;
        print "pcspkr found\n";
    }
}

# Remove pcspkr module if it was loaded for this script
sub rm_pcspkr {
    system qw(rmmod pcspkr)
        unless $pcspkr_was_loaded;
}

# Return a first number found in the hostname.
# Dies if no number can be extracted.
#
# * returns number extracted from the hostname
sub get_number_from_hostname {
    my $hostname = hostname;
    print "hostname: $hostname\n";

    die "failed to extract hostname number"
        if $hostname !~ /(?<n>\d+)/;

    return $+{n};
}

# Returns a list of tracks of the given score.
# This function searches the $CWD/tracks/$score/ directory
# Dies if there are no tracks found.
#
# * param $score    name of the piece
# * returns an arrayref of matching files
sub get_tracks($score) {
    my @files = glob "tracks/$score/*.beep"
        or die "$score no matching files";

    return [ grep { /\d+.*\.beep$/ } @files ];
}

# Wrapper for POSIX::strptime to parse ISO 8601 time format.
#
# A parameter 'now' can be supplied to get the time with the
# 3 second offset. This allows beeplay on various machines to
# (probably) avoid desynchronisation caused by tracks of different
# file size.
#
# * param $datestr  time string in format 'HH:MM:SS' or value 'now'
# * returns a DateTime object representing the given time
sub parse_date($datestr) {
    my $date = DateTime->now(time_zone => 'local');

    if ($datestr eq 'now') {
        # so that beeplay won't (probably) complain
        $date->add(seconds => 3);
    } else {
        my @ts = POSIX::strptime($datestr, '%H:%M:%S');
        $date->set(hour => $ts[2], minute => $ts[1], second => $ts[0]);
    }

    return $date;
}

#------------------------------------------------------------------------------

GetOptions($options, qw(h help debug))
    or pod2usage(-verbose => 1);

pod2usage(-exitval => 0, -verbose => 0) if $options->{h};
pod2usage(-exitval => 0, -verbose => 2) if $options->{help};
pod2usage(-exitval => 1, -verbose => 1) if @ARGV != 2 and @ARGV != 3;

my ($datestr, $score, $number) = @ARGV;

my $start = parse_date($datestr);

$number = get_number_from_hostname
    unless defined $number;

my $tmpl  = get_tracks($score);
my $track = $tmpl->[$number % scalar @$tmpl];

print "track to play: $track\n";

add_pcspkr;
my $now = DateTime->from_epoch(epoch => Time::HiRes::time);

if (DateTime->compare($now, $start) > 0) {
    die "scheduled start is in the past";
}

my $pid = fork;

die "fork failed: $!"
    if $pid < 0;

if ($pid) {
    print "playing score\n";
    wait;
} else {
    my @args = ('--precise', '--start', $start->iso8601);

    push @args, '--debug'
        if $options->{debug};

    push @args, $track;

    my $exe = "$RealBin/beeplay";
    print "exec ", join(' ', $exe, @args), "\n";

    exec $exe, @args;
    die "exec failed: $!\n";
}

print "score finished\n";
rm_pcspkr;

=head1 NAME

    polybeep -- schedule polyphonic play of a piece

=head1 SYNOPSIS

    polybeep [OPTIONS] TIME SCORE [NUMBER]

Short list of options

    -h                  show synopsis and exit
        --help          show Perl POD page and exit
        --debug         print debugging information
    TIME                when to start playing, HH:MM:SS
    SCORE               track name
    NUMBER              track number to play

=head1 DESCRIPTION

Given the time C<TIME> and score name C<SCORE>, this script
selects a track to play from directory C<tracks/SCORE/> on this host with
the C<beeplay> command.

The track is selected based on the hostname, which must include a number
unless the optional parameter C<NUMBER> is specified explicitly.
Track files are expected in the format C<.*ID.*\.beep>, where ID
is the number of a track.

The script sorts the filenames alphabetically and selects C<K>th track
where C<K> is C<hostname-number mod number-of-tracks>.

The script then calls

    beeplay --precise --start=[DATE]TIME TRACK

where C<DATE> is prepended to the argument automatically for the current day.

=head1 OPTIONS AND ARGUMENTS

=over

=item C<-h>

Show synopsis and exit.

=item C<--help>

Show Perl POD page and exit

=item C<--debug>

Print debugging information.

=item C<TIME>

Start playing at the given time, given in the format C<HH:MM:SS>.

=item C<SCORE>

Name of the piece to play. Tracks are searched in the C<tracks/SCORE/>
directory and must end with the C<.beep> suffix.

These track files can be generated using the C<midiconv> script.

=item C<NUMBER>

If given, play track number C<NUMBER> instad of choosing the track
based on the hostname.

=back

=head1 BUGS

=over

=item

The script only works for the current day. That is, there is no exact way to
say "play this track two minutes after midnight", since calling the script
like this

    ./polybeep 00:02:00 super-mario 0

will run C<beeplay> with the B<current> date. However, using C<now>
should work just fine even when called right before midnight

    ./polybeep now super-mario 0

=back

=head1 AUTHOR

    Roman Lacko <xlacko1@fi.muni.cz>
