lastfm

#!/usr/bin/env perl

# This is a Kitchen Sink Tool for Last.fm
# (C) 2021 Martin Frederic

use strict;
use warnings;
use v5.18;

# = BEGIN COMMON FUNCTIONS =

use Carp           qw{croak};
use Digest::MD5    qw{md5_hex};
use Encode         qw{decode};
use File::Basename qw{basename dirname};
use File::Path     qw{make_path};
use IPC::Open3     qw{open3};
use Pod::Usage     qw{pod2usage};
use Symbol         qw{gensym};

use LWP::UserAgent qw{};
use JSON           qw{decode_json};
use URI::Escape    qw{uri_escape_utf8};
use XML::LibXML;

use open qw{:std :utf8};

use Data::Dumper;
$Data::Dumper::Maxdepth = 2;
$Data::Dumper::Sortkeys = 1;

my $api_base = 'https://ws.audioscrobbler.com/2.0/';
my $debug = 0;

sub make_api_url {
  return $api_base unless @_;
  my %args = @_;

  my $full = $api_base;
  my $sep = '?';

  for my $key (sort keys %args) {
    my $val = $args{$key};

    $full .= $sep;
    $full .= uri_escape_utf8($key) . '=' . uri_escape_utf8($val);

    $sep = '&';
  }

  return $full;
}

sub make_api_signature {
  my $secret = shift;
  my %args = @_;

  my $s;

  # Keys need to be sorted!
  # Fascists...
  for my $key (sort keys %args) {
    my $val = $args{$key};

    $s .= $key . $val;
  }

  $s .= $secret;

  utf8::encode($s);
  return md5_hex($s);
}

sub api_request {

  my $ua         = shift;
  my $url        = shift;
  my $method     = shift || '';

  my $res;
  if ($method eq 'POST') {
    $res = $ua->post($url);
  } else {
    $res = $ua->get($url);
  }

  if ($res->is_success) {
    # We're done here!
    return $res->decoded_content;
  }

  # Even if we didn't get a 200 OK, the Last.fm API might have
  # returned something useful as JSON.

  # Might contain a "useful" error message later on.
  my ($api_err, $err_msg);

  eval {
    $api_err = decode_json($res->decoded_content);
    $err_msg = sprintf "API error #%d: %s [%s]",
        $api_err->{error}, $api_err->{message}, $url;
  };
  if ($@) {
    # OK, nothing useful here, seems like a fundamental error.
    print STDERR "Did not receive a valid JSON response!\n";
    print STDERR $res->decoded_content, "\n";
    die $res->status_line;
  } else {
    if ($api_err->{error} == 8) {
      # 8 is "Operation failed - Something else went wrong"
      print $err_msg, "\nRetrying...\n";
      sleep 5;
      return __SUB__->($ua, $url);
    }

    die $api_err;
  }
}

sub get_auth_token {
  my $ua   = shift;
  my $conf = get_config();

  my %args = (
    method  => 'auth.getToken',
    api_key => $conf->{api}->{key},
    format  => 'json'
  );

  my $sig = make_api_signature($conf->{api}->{secret}, %args);
  my $url = make_api_url(%args, api_sig => $sig);

  my $json = api_request($ua, $url);
  my $data = decode_json $json;

  return $data->{token};
}

sub get_auth_session {
  my $ua    = shift;
  my $token = shift;
  my $conf  = get_config();

  my %args = (
    method  => 'auth.getSession',
    api_key => $conf->{api}->{key},
    token   => $token

    # Note: no format => json allowed here... oh well.
  );

  my $sig = make_api_signature($conf->{api}->{secret}, %args);
  my $url = make_api_url(%args, api_sig => $sig);

  my $xml = api_request($ua, $url);

  # TODO: unify XML parsing (that is: not use regexes!!1!11)
  my $res = $xml =~ m@<key>([[:alnum:]_-]+)</key>@;
  if ($res) {
    my $key = $1;
    return $key;
  } else {
    die "Could not extract key from XML, got:\n\n$xml\n";
  }
}

sub request_user_auth {
  my $token = shift;
  my $config = get_config();

  my $api_key = $config->{api}->{key};

  my $url = "http://www.last.fm/api/auth/"
      . "?api_key=$api_key&token=$token";

  print STDERR "Authentication request! Point your browser to:\n";
  print STDERR $url, "\n";
}

sub get_sk {
  my $ua   = shift;
  my $user = shift;

  # Build path to cache file
  die "Missing env: \$HOME\n" unless exists $ENV{HOME};
  # say STDERR $ENV{HOME};

  my $cache_dn = "$ENV{HOME}/.cache/lastfm-tools";
  my $cache_fn = "$cache_dn/$user.session";
  my $sk;

  if (-e -f $cache_fn) {
    # cache file exists, read sk from it!

    $sk = read_utf8($cache_fn);
    # print STDERR "Read sk: $sk\n";
  } else {
    # cache file does not exist, create it

    my $token = get_auth_token($ua);
    request_user_auth($token);
    print STDERR "(Hit RETURN to continue.)\n";
    <STDIN>;
    $sk = get_auth_session($ua, $token);

    make_path($cache_dn);
    write_utf8($cache_fn, $sk);

    print STDERR "Session stored at $cache_fn\n";
  }

  return $sk;
}

sub scrobble {
  my $ua         = shift;
  my $track      = shift;
  my $success_cb = shift;

  my $conf = get_config();

  my $sk = get_sk($ua, $conf->{core}->{user});

  my %args = (
    method    => 'track.scrobble',

    # Let's be explicit
    artist    => $track->{artist},
    track     => $track->{title},
    (exists $track->{album} ?
     (album   => $track->{album}) : ()),

    # Use current time if none is provided
    timestamp => ($track->{time} // time()),

    api_key   => $conf->{api}->{key},
    sk        => $sk
  );

  my $sig = make_api_signature($conf->{api}->{secret}, %args);
  my $url = make_api_url(%args, api_sig => $sig);

  # Technically, we should send the arguments as a
  # POST body, but simply doing a POST with the args
  # in the URL seems to work fine...
  my $xml = api_request($ua, $url, 'POST');
  my $dom = XML::LibXML->load_xml(string => $xml);

  my $status = $dom->find('//lfm/@status');
  if ($status ne 'ok') {
    die "LastFM: not ok\n" . $xml;
  }

  # It is ok to check for exactly 1 accepted scrobble since
  # we're never scrobbling multiple tracks in a batch.
  # Also, we do string comparison since LibXML does not seem
  # to overload the != operator, ugh.
  my $accepted = $dom->find('//lfm/scrobbles/@accepted');
  if ($accepted ne '1') {
    warn "LastFM: not accepted\n" . $xml;
  }

  if (defined $success_cb) {
    $success_cb->($track);
  }

  return 1;
}

sub scrobble_success_cb {
  my $track = shift;

  print "Scrobbled: $track->{artist} - $track->{title}\n";
}

sub get_ua {
  my ($c_pkg, $c_fn) = caller;

  my $ua = LWP::UserAgent->new(timeout => 10);
  $ua->env_proxy;

  $ua->agent("nanont-lastfm/0.1");

  return $ua;
}

sub get_config {
  # TODO: use XDG conventions
  my $conf_path = "$ENV{HOME}/.config/lastfm-tools.conf";
  unless (-e -f $conf_path) {
    die "Missing config file! ($conf_path)\n";
  }

  my %config;

  my @lines = split /\r?\n/, read_utf8($conf_path);
  my $top_key;
  for (@lines) {
    if (/ \[ ([[:alnum:]]+) \] /x) {
      # say STDERR "LABEL: {$1}";
      $top_key = $1;
    } elsif (/ ([[:alnum:]]+) \s* = \s* ([[:alnum:]]+) /x) {
      # say STDERR "VAL: {$1} -> {$2}";
      $config{$top_key}->{$1} = $2;
    }
  }

  return \%config;
}

sub write_binary {
  my $fn      = shift;
  my $dataref = shift;

  open(my $fh, '>', $fn) or croak "$!";
  binmode $fh;
  print $fh $$dataref;
  close $fh;
}

sub write_utf8 {
  my $fn  = shift;
  my $str = shift;

  # print STDERR "WRITE_UTF8: <<$str>>\n";

  utf8::encode($str);
  write_binary($fn, \$str);
}

sub read_binary {
  my $fn = shift;

  open(my $fh, '<', $fn) or croak "$!";
  binmode $fh;
  local $/ = undef;
  my $bin = <$fh>;
  close $fh;

  return $bin;
}

sub read_utf8 {
  my $fn = shift;

  my $bin = read_binary($fn);
  utf8::decode($bin);

  return $bin;
}

# = BEGIN DAP FUNCTIONS =

# Resources:
# https://web.archive.org/web/20180315041951/ \
#   http://www.audioscrobbler.net/wiki/Portable_Player_Logging

sub dap_validate_log {
  my $logref = shift;

  my %expected = (
    0 => '#AUDIOSCROBBLER/1.1',
    1 => '#TZ/UNKNOWN'
  );

  for my $i (sort keys %expected) {
    my $exact_match = $expected{$i};

    if ($logref->[$i] !~ /^\Q$exact_match\E$/) {
      die sprintf("Expected <%s>, got <%s>\n",
                  $exact_match, $logref->[$i]);
    }
  }

  # The header is made up of 3 lines,
  # so check if we have at least 4
  if (scalar @{ $logref } < 4) {
    die "Expecting at least one log entry\n";
  }
}

sub dap_make_track {
  my ($artist, $album, $track,
      $position, $duration, $rating,
      $timestamp, $mbid) = @_;

  my %track = (
    artist    => $artist,
    album     => $album,
    track     => $track,
    position  => $position,
    duration  => $duration,
    rating    => $rating,
    timestamp => $timestamp,
    mbid      => $mbid
  );

  return \%track;
}

sub dap_parse_log {
  my @raw = @{ shift() };

  # Remove the first three lines
  splice @raw, 0, 3;

  my @log =
      map { dap_make_track @{ $_ } }
      # Break lines by tabs into track
      map { [ split /\t/, $_ ] }
      @raw;
}

sub dap_scrobble_log {
  my $ua     = shift;
  my $logref = shift;

  my @log = dap_parse_log($logref);

  # Ignore skipped tracks
  my @listened = grep { $_->{rating} eq 'L' } @log;

  for my $listen (@listened) {
    # Consider time offset
    my $tz_offset = +(60 * 60 * 2); # CEST: +2h

    my $local_timestamp = $listen->{timestamp} - $tz_offset;

    # Move relevant bits into a structure
    # that Common::scrobble understands
    # (Yes, this sucks bad.)

    my $submission = {
      artist       => $listen->{artist},
      title        => $listen->{track},
      album        => $listen->{album},
      time         => $local_timestamp
    };

    scrobble($ua, $submission, \&scrobble_success_cb);
  }

  #p @listened;
}

sub dap_maybe_delete_log {
  my $file = shift;

  my $bn = basename $file;

  local $| = 1;
  print "Delete logfile ($bn)? [y/N] ";

  my $resp = <STDIN>;
  if ($resp !~ /[yY]/) {
    return;
  }

  if (unlink $file) {
    print "Deleted: $file\n";
  } else {
    print "unlink failed: $file\n";
  }
}

# = BEGIN STATION FUNCTIONS =

my $station_now;
station_clear_now($station_now);

sub station_update_now {
  my $artist = shift;
  my $title  = shift;

  $station_now = {artist => $artist, title => $title};

  if ($debug) {
    print STDERR "Update!\n";
    print STDERR Dumper($station_now);
  }
}

sub station_pending_now {
  my $artist = shift;
  my $title  = shift;

  if (station_clearp_now($station_now)) {
    return 0;
  }

  if (($station_now->{artist} ne $artist) or
        ($station_now->{title} ne $title)) {
    if ($debug) {
      printf STDERR "Pending! (%s = %s | %s = %s)\n",
        $station_now->{artist}, $artist,
        $station_now->{title}, $title;
    }

    return 1;
  }

  return 0;
}

sub station_clear_now {
  $station_now = undef;
}

sub station_clearp_now {
  return !(defined $station_now);
}

sub station_scrobble_now {
  if ($debug) {
    printf "station_clearp_now: %d\n", station_clearp_now();
  }
  if (!(station_clearp_now())) {
    scrobble(get_ua(), $station_now);
  }

  station_clear_now();
}

sub station_handle_ok {
  my $fh_out = shift;
  my $fh_err = shift;

  my $artist = readline $fh_out;
  my $title  = readline $fh_out;

  chomp($artist, $title);

  if (station_pending_now($artist, $title)) {
    station_scrobble_now;
  }

  station_update_now($artist, $title);
};

sub station_handle_skip {
  station_scrobble_now;
}

sub station_handle_error {
  my $fh_out = shift;
  my $fh_err = shift;

  station_scrobble_now;
}

# = TASK RUNNER =

sub task_scrobble {
  my @args = @_;

  print "Artist > ";
  my $artist = <STDIN>;

  print "Title > ";
  my $title = <STDIN>;

  chomp($artist, $title);

  if ($artist eq '' or $title eq '') {
    print STDERR "Artist and Title are required.\n";
    exit -1;
  }

  print "Album (optional) > ";
  my $album = <STDIN>;
  chomp($album);

  my $submission = {
    artist => $artist,
    title  => $title,
    ($album ne ''      ?
     (album => $album) : ())
  };

  my $ua = get_ua;
  scrobble($ua, $submission, \&scrobble_success_cb);
}

sub task_scrobble_dap {
  my @args = @_;

  my $file;
  while (local $_ = shift @args) {
    if (/--?f(ile)?/) { $file = shift @args }
  }

  unless (defined $file) {
    pod2usage "Missing: --file";
  }

  my @log = split /\n/, read_utf8($file);
  dap_validate_log(\@log);

  my $ua = get_ua;
  dap_scrobble_log($ua, \@log);

  dap_maybe_delete_log($file);
}

sub task_scrobble_station {
  my @args = @_;

  my $station = shift @args;
  my $script = "$ENV{HOME}/.nanont-lastfm/stations/$station"; # TODO improve

  if (!(-e -f -x $script)) {
    print STDERR "Provider does not exist or is not executable\n";
    print STDERR "(Looked for: $script)\n";
    exit -1;
  }

  print STDOUT "Listening to $station ...\n";
  while (1) {

    my $pid = open3(my $s_in, my $s_out, my $s_err = gensym,
                    $script);
    binmode($_, ':encoding(UTF-8)') for ($s_in, $s_out, $s_err);
    waitpid($pid, 0);
    my $rc = $? >> 8;

    my $handlers = {
      OK   =>  \&station_handle_ok,
      SKIP =>  \&station_handle_skip,
      ERROR => \&station_handle_error
    };

    my $status = readline $s_out;
    chomp $status;
    if (exists $handlers->{$status}) {
      $handlers->{$status}->($s_out, $s_err);
    } else {
      die "Station Provider not working as intended (status: $status)\n";
    }

    sleep 30;
  }
}

sub task_recent {
  my $ua = get_ua;
  my $conf = get_config;

  my $url = make_api_url(method  => 'user.getrecenttracks',
                         user    => 'nanont',
                         limit   => 10,
                         api_key => $conf->{api}->{key});

  my $xml = api_request($ua, $url);
  my $doc = XML::LibXML->load_xml(string => $xml);
  # say $doc;
  my @tracks = $doc->findnodes(q(//lfm/recenttracks/track));

  for my $t (@tracks) {
    printf "%s - %s\n",
        $t->find(q(./artist/text())),
        $t->find(q(./name/text()));
  }
}

# = MAIN =

sub main {
  my @cli_argv = @ARGV;

  if (scalar(@cli_argv) == 0 or
        $cli_argv[0] =~ /--?h(elp)?/) { pod2usage(1) } # exits

  my $tasks = {
    'scrobble'         => \&task_scrobble,
    'scrobble-dap'     => \&task_scrobble_dap,
    'scrobble-station' => \&task_scrobble_station,
    'recent'           => \&task_recent
  };

  my $selection = shift @cli_argv;
  if (exists $tasks->{$selection}) {
    $tasks->{$selection}->(@cli_argv);
  } else {
    local $" = ', ';
    my @available = sort keys %{ $tasks };
    die "Task not found: $selection (try: @available)\n";
  }
}

main;

__END__

=head1 lastfm

Submit a scrobble log (e.g. from Rockbox) to Last.fm.

=head1 SYNOPSIS

  lastfm TASK [task-specific options]

  Available TASKs are:

    scrobble
      Scrobble a single track. Interactive.

    scrobble-dap
      Use this to submit scrobbler.log files from your mp3 player.

      Options:
            -f PATH
        --file PATH     Path to log file.

    scrobble-station
      Scrobble from a radio station or other sources.

      Options:
        NAME     Name of the station provider binary.

      Example:
        lastfm scrobble-station fm4

    recent
      Show the 10 most recent scrobbles.