view release on metacpan or  search on metacpan

lib/Audio/Ofa/Util.pm  view on Meta::CPAN

The fingerprint is calculated by L<Audio::Ofa / ofa_create_print>, and the
C<fingerprint> field of the object will be set.
Additionally, the C<duration> (in milliseconds) and the C<extension> will be
set to the values provided by the file name.

In case of an error, an empty list is returned and the error message can be
retrieved via L</error>.  Otherwise, a true value will be returned.

=cut


sub analyze_file {
    my $this = shift;

    my $fn = $this->filename;
    croak 'No filename given' unless defined $fn;

    use bytes;

    my $extractor = Audio::Extract::PCM->new($fn);
    my $pcm = $extractor->pcm(FREQ, 2, 2);

    unless (defined $pcm) {
        $this->error('Could not extract audio data: ' . $extractor->error);
        return ();
    }

    my $duration = int (1000 * length($$pcm) / (2*2) / FREQ); # 2 channels, 2 bytes per sample

    # Fingerprinting only uses the first 135 seconds; we throw away the rest.
    # Certainly it would be more efficient to instruct sox not to generate more
    # than 135 seconds; however we need the rest to calculate the duration.
    # Unless I find a possibility to find out the duration from as many file
    # formats as sox supports, I will probably use this unefficient solution.
    # It's just a matter of Pink Floyd vs. Ramones.
    my $s135 = (2*2)*FREQ*135;
    substr($$pcm, $s135, length($$pcm)-$s135, '') if $s135 < length($$pcm);

    # This is usually the same, but "use bytes" has no effect here.
    # substr($pcm, $s135) = '' if length($pcm) > $s135;

    my $fp = ofa_create_print($$pcm, OFA_LITTLE_ENDIAN, length($$pcm)/2, FREQ, 1);
    undef $$pcm;
    unless ($fp) {
        $this->error("Fingerprint could not be calculated");
        return ();
    }

    my ($extension) = $fn =~ /^\.([a-z0-9])\z/i;

    $this->fingerprint($fp);
    $this->duration($duration);
    $this->extension($extension);
    
    return 1;
}


=head2 musicdns_lookup

This looks up a track at the MusicDNS web service.

To do a fingerprint lookup, the keys C<fingerprint> and C<duration> must be
present, where duration is the length of the song in milli seconds.
Additionally, the following fields (defaults in parentheses) will be sent to
the MusicDNS service:

client_id (hardcoded client id), client_version (module name and version),
fingerprint, metadata (1), bitrate (0), extension ("unknown"), duration, artist
("unknown"), title ("unknown"), album ("unknown"), track (0), genre
("unknown"), year (0).

To do a fingerprint lookup, C<fingerprint> and C<duration> must have been set
(can be given to L</new>), where C<duration> is the song length in milli
seconds.

If C<fingerprint> hasn't been set, L</analyze_file> is called implicitly.

client_id defaults to a hard-coded Client ID.  You can get your own from
http://www.musicip.com.

You should set as much of the above-mentioned metadata (like artist, etc.) as
you have available, because the MusicDNS terms of service require this in order
to help clean errors in their database.

In the case of an error, C<musicdns_lookup> returns an empty list and the error
message can be retrieved with the L</error> method.

In the case of success, C<musicdns_lookup> sets the fields C<puids> to the
found PUIDs, and sets the fields C<artist> and C<title> to the first of the
found values, and returns a true value.  In list context, it returns a list of
objects which have C<artist>, C<title> and C<puid> methods.

=cut


sub musicdns_lookup {
    my $this = shift;

    if (defined $this->fingerprint) {
        unless (defined $this->duration) {
            croak 'Fingerprint was given but duration wasn\'t';
        }
    } else {
        $this->analyze_file or return ();
    }

    my %req_params;

    while (my ($key, $val) = each %musicdns_parameters) {
        my ($param, $default) = @$val;

        if (defined $this->$key()) {
            $req_params{$param} = $this->$key();

        } elsif (defined $default) {
            $req_params{$param} = $default;
        }
    }
    utf8::encode($_) for values %req_params;
    
    my $url = 'http://ofa.musicdns.org/ofa/1/track';
    my $ua = LWP::UserAgent->new;
    $ua->env_proxy;

    #use Data::Dumper;
    #warn Dumper \%req_params;

    my $response = $ua->post($url, \%req_params);

    unless ($response->is_success) {
        $this->error('Server says ' . $response->status_line);
        return ();
    }

    unless ('text/xml' eq $response->header('Content-Type')) {
        $this->error('Unexpected content type: ' . $response->header('Content-Type'));
        return ();
    }

    unless (defined $response->content) {
        $this->error('No content');
        return ();
    }

    my $xml = XMLin($response->content, ForceArray => ['track', 'puid']);

    # warn Dumper $xml;

    my @return = map {
        +{
            title => $_->{title},
            artist => $_->{artist}{name},
            puids => [keys %{$_->{'puid-list'}{puid}}],
        };
    } @{$xml->{track}};

    $this->error('No tracks returned') unless @return;

    $this->puids([map @{$_->{puids}}, @return]);
    $this->title($return[0]{title});
    $this->artist($return[0]{artist});

    if (wantarray) {
        return map Audio::Ofa::Util::Metadata->new(
            $_->{artist}, $_->{title}, $_->{puids}[0]
        ), @return;
    } else {
        return 1;
    }
}


=head2 musicbrainz_lookup

This looks up a PUID at MusicBrainz.  The PUID can come from a call to
L</musicdns_lookup>.  In fact this is implicitly done if there is no PUID
stored in the object (cf. L</SYNOPSIS>).

This returns a list of L<WebService::MusicBrainz::Response::Track> objects on
success, or the first of them in scalar context.
Otherwise it returns an empty list and the error message can be retrieved via
the L</error> method.

This method returns a list of tracks or the first track in scalar context.  The
tracks are represented as objects that are guaranteed to have the methods
C<artist>, C<title>, C<album>, C<track> and C<wsres>, where the latter is an
L<WebService::MusicBrainz::Response::Track> object, and the four former return
values that have been retrieved from that object for your convenience.

In the case of an error, an empty list is returned and the error can be
returned via the L</error> method.

=cut


# MusicBrainz demands that we not look up more often than once a second.
my $last_mb_lookup = 0;


sub musicbrainz_lookup {
    my $this = shift;
    my (%args) = @_;

    require WebService::MusicBrainz::Track;

    unless ($this->puids) {
        $this->musicdns_lookup or return ();
    }
    my @puids = @{ $this->puids };

    my @tracks;
    my $searcherror;

    for my $puid (@puids) {

        my $next_lookup_in = $last_mb_lookup + 1 - Time::HiRes::time();
        if ($next_lookup_in > 0 && $next_lookup_in < 1) {
            Time::HiRes::sleep($next_lookup_in);
        }
        $last_mb_lookup = Time::HiRes::time();

        my $ws = WebService::MusicBrainz::Track->new();

        local $@;
        local $SIG{__DIE__};

        my $resp = eval { $ws->search({ PUID => $puid }) };

        unless ($resp && $resp->track_list) {
            if ($@) {
                # search throws exception e.g. for "503 Service Temporarily
                # Unavailable" errors
                $this->error("$@");
                return ();
            }