File Coverage

lib/Music/AirGuitar.pm

Criterion	Covered	Total	%
statement	14	53	26.4
branch	0	24	0.0
condition	0	11	0.0
subroutine	5	9	55.5
pod	2	2	100.0
total	21	99	21.2

# Copyright (c) 2025 Philipp Schafft

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: Interface for air guitars


package Music::AirGuitar;

use v5.16;
use strict;
use warnings;

use Carp;

our $VERSION = v0.04;

my @_standard_types = qw(string Data::Identifier Data::TagDB::Tag Data::URIID::Base);

my %_valid_attribute_types = (
    displayname => [qw(string)],
    player      => \@_standard_types,
    strings     => [qw(uint)],
    keys        => [qw(uint)],
);

my %_attribute_defaults = (
    strings     => 6,
    keys        => 0,
);

{
    no strict 'refs'; # This is an invalid access, but it is the only one working in perl v5.24.1, the correct one segfaults.
    foreach my $attribute (keys %_valid_attribute_types) {
        *$attribute = sub { my ($self, @args) = @_; return $self->_attribute($attribute, @args); };
    }
}


sub new {
    my ($pkg, %opts) = @_;
    my $self = bless {}, $pkg;

    foreach my $attribute (keys %_valid_attribute_types) {
        if (defined(my $value = delete $opts{$attribute})) {
            my $found;

            foreach my $type (@{$_valid_attribute_types{$attribute}}) {
                if ($type eq 'string') {
                    $found = !ref($value);
                } elsif ($type eq 'uint') {
                    $found = !ref($value) && $value =~ /^[0-9]+$/;
                    $value = int($value) if $found;
                } elsif (eval {$value->isa($type)}) {
                    $found = 1;
                }

                last if $found;
            }

            croak 'Type mismatch for attribute: '.$attribute unless $found;;

            $self->{$attribute} = $value;
        }
    }

    croak 'Invalid options present: '.join(', ', keys %opts) if scalar(keys %opts);

    foreach my $attribute (keys %_attribute_defaults) {
        $self->{$attribute} //= $_attribute_defaults{$attribute};
    }

    unless ($self->{strings} || $self->{keys}) {
        croak 'Your guitar has no strings nor keys. Kinda dull!';
    }

    return $self;
}


sub perform {
    my ($self, %opts) = @_;
    my $duration = $opts{duration} // '5:55';

    if ($duration =~ /:/) {
        my $s = 0;

        foreach my $c (split /:/, $duration) {
            $s *= 60;
            $s += $c;
        }

        $duration = $s;
    } else {
        $duration = int($duration);
    }

    require Music::AirGuitar::Performance;

    return Music::AirGuitar::Performance->_new(guitar => $self, duration => $duration);
}


*be_most_excellent = *perform;



# ---- Private helpers ----

sub _attribute {
    my ($self, $key, %opts) = @_;
    return $self->{$key} if defined $self->{$key};
    return $opts{default} if exists $opts{default};
    croak 'No data for attribute: '.$key;
}

1;

__END__