File Coverage

blib/lib/Lyrics/Fetcher/LyricsOVH.pm

Criterion	Covered	Total	%
statement	20	75	26.6
branch	0	14	0.0
condition	0	3	0.0
subroutine	7	10	70.0
pod	2	2	100.0
total	29	104	27.8

package Lyrics::Fetcher::LyricsOVH;

# $Id$

use 5.008000;
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use Carp;

my $haveLyricsFetcher = 0;
eval "use Lyrics::Fetcher (qw(\$AGENT)); \$haveLyricsFetcher = 1; 1";

our $VERSION = 0.01;

# the HTTP User-Agent we'll send:
our $AGENT = ($haveLyricsFetcher && defined $Lyrics::Fetcher::AGENT)
        ? $Lyrics::Fetcher::AGENT
        : "Mozilla/5.0 (X11; Linux x86_64; rv:80.0) Gecko/20100101 Firefox/80.0";

$Lyrics::Fetcher::Error = 'OK'  unless ($haveLyricsFetcher);

sub fetch {
    my $self = shift;
    my ($artist, $song) = @_;

    # reset the error var, change it if an error occurs.
    $Lyrics::Fetcher::Error = 'OK';

    unless ($artist && $song) {
        carp($Lyrics::Fetcher::Error
                = 'fetch() called without artist and song');
        return;
    }

    $artist =~ s#\s*\/.*$##;    #ONLY USE 1ST ARTIST, IF MORE THAN ONE!
    $artist =~ s/\s+/\%20/g;
    $artist =~ s/[^a-z0-9\%]//gi;

    $song   =~ s/\s+/\%20/g;
    $song   =~ s/[^a-z0-9\%]//gi;

    # Their URLs look like e.g.:
    # https://api.lyrics.ovh/v1/Dire%20straits/heavy%sfuel%s
    my $url = "https://api.lyrics.ovh/v1/${artist}/$song";

    my $ua = LWP::UserAgent->new(
        ssl_opts => { verify_hostname => 0, },
    );
    $ua->timeout(10);
    $ua->agent($AGENT);
    $ua->protocols_allowed(['https']);
    $ua->cookie_jar( {} );
    push @{ $ua->requests_redirectable }, 'GET';
    (my $referer = $url) =~ s{^(\w+)\:\/\/}{};
    my $protocol = $1;
    $referer =~ s{\/.+$}{\/};
    my $host = $referer;
    $host =~ s{\/$}{};
    $referer = $protocol . '://' . $referer;
    my $req = new HTTP::Request 'GET' => $url;
    $req->header(
        'Accept' =>
            'text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8',
        'Accept-Language'           => 'en-US,en;q=0.5',
        'Accept-Encoding'           => 'gzip, deflate',
        'Connection'                => 'keep-alive',
        'Upgrade-insecure-requests' => 1,
        'Host'                      => $host,
    );

    my $res = $ua->request($req);

    if ($res->is_success) {
        my $lyrics = _parse($res->decoded_content);
        return $lyrics;
    } else {
        if ($res->status_line =~ /^404/) {
            $Lyrics::Fetcher::Error = 'Lyrics not found';
            return;
        } else {
            carp($Lyrics::Fetcher::Error
                = "Failed to retrieve $url (".$res->status_line.')');
            return;
        }
    }
}

# Allow user to specify a different user-agent:
sub agent {
    if (defined $_[1]) {
        $AGENT = $_[1];
    } else {
        return $AGENT;
    }
}

# Internal use only functions:

sub _parse {
    my $html = shift;

    if (my ($goodbit) = $html =~
        m{\{\"lyrics\"\:\"([^\"]+)\"}msi)
    {
        my $text = '';
        # convert literal "\" followed by "r" or "n", etc. to "\r" or "\n" characters respectively:
        eval "\$text = \"$goodbit\";";

        # fix apparent site bug where they use "\n\n" where they appear to mean "\r\n" (excess double-lines):
        $text =~ s/\n\n/\n/gs;
        # normalize Windowsey \r\n sequences:
        $text =~ s/\r+//gs;
        # strip off pre & post padding with spaces:
        $text =~ s/^ +//mg;
        $text =~ s/ +$//mg;
        # clear up repeated blank lines:
        $text =~ s/(\R){2,}/\n\n/gs;
        # and remove any blank top lines:
        $text =~ s/^\R+//s;
        $text =~ s/\R\R+$/\n/s;
        $text .= "\n"  unless ($text =~ /\n$/s);
        # now fix up for either Windows or Linux/Unix:
        $text =~ s/\R/\r\n/gs  if ($^O =~ /Win/);

        return $text;
    } else {
        carp "Failed to identify lyrics on result page";
        return;
    }

} # end of sub parse

1;

__END__