html/lastfm.pl


   1 # vim: set expandtab:
   2 use vars qw($VERSION %IRSSI);
   3 $VERSION = "5.8";
   4 %IRSSI = (
   5         authors     => "Simon 'simmel' Lundström",
   6         contact     => 'simmel@(freenode|quakenet|efnet) http://last.fm/user/darksoy',
   7         name        => "lastfm",
   8         date        => "20110125",
   9         description => 'A now-playing-script which uses Last.fm',
  10         license     => "BSD",
  11         url         => "http://soy.se/code/",
  12 );
  13 # USAGE
  14 # For details on how to use each setting, scroll down to the SETTINGS section.
  15 
  16 # QUICK START
  17 # * First of all, you need the libwww/LWP package installed. The package in
  18 # your package system is probably called something with libwww and perl and/or
  19 # p5 in it.
  20 # * /set lastfm_user to the username that you are using on Last.fm
  21 # * Show with /np or %np<TAB> what song "lastfm_user" last scrobbled to Last.fm via /say. If "lastfm_use_action" is set, it uses /me.
  22 # * To see what another user on Last.fm is playing is also possible via /np <username> or %np(<username>).
  23 # The now-playing message is configurable via via "lastfm_output" (and lastfm_output_tab_complete when using %np, if not set it will use lastfm_output by default.). "lastfm_strftime" can be used to configure the display of date and time when the song was scrobbled.
  24 
  25 # SETTINGS
  26 # NOTE: Do not set these options here, use /set <option> <value> in irssi!
  27 # These are just defaults and descriptions on what the options do.
  28 
  29 # The username which you are using on Last.fm
  30 Irssi::settings_add_str("lastfm", "lastfm_user", "");
  31 
  32 # The output that you want to use.
  33 # The substitution variables are:
  34 #   %artist = Self explanatory
  35 #   %album  = Self explanatory
  36 #   %name   = Name of song*
  37 #   %url    = URL to song on Last.fm
  38 #   %player = Player we are using to submit to Last.fm with. See setting "lastfm_get_player" below
  39 #   %user   = User that is playing, when /np <username> or %np(<username> is used
  40 # If "lastfm_output_tab_complete" is not defined, "lastfm_output" will be used instead.
  41 # Something bothered me for a long time and when something really starts to itch
  42 # I tend to want to do something about it. I'm /np:ing away displaying all sorts
  43 # of tracks to my friends until I get to a track which has no album information
  44 # on Last.fm and the output becomes really ugly "np: Kraftwerk-Aerodynamik 
  45 # (Alex Gopher/Etienne de Crecy dynamik mix) ()". What's with that last ()!? Oh,
  46 # right we are using "np: %artist-%name (%album)" as "lastfm_output". Wouldn't 
  47 # it be really cool if lastfm.pl knew when certain information from Last.fm
  48 # didn't exist and didn't display it? So thought I, so that's why I created a 
  49 # conditional. It works that you have to put your tag (%album e.g.) within %()
  50 # e.g. "np: %artist-%name%( (%album))" and everything between %( and ) only gets
  51 # displayed if the tag inside actually exists! Cool, huh!?
  52 
  53 #  *) Name is used instead of, the more logical IMO, track since that is what Last.fm reports in their .xml file that we parse.
  54 Irssi::settings_add_str("lastfm", "lastfm_output", '%(%user is )np: %artist-%name');
  55 Irssi::settings_add_str("lastfm", "lastfm_output_tab_complete", '');
  56 
  57 # If we should use /me instead of /say
  58 Irssi::settings_add_bool("lastfm", "lastfm_use_action", 0);
  59 
  60 # If we should make the subtitution variable %player available which is very slow to fetch but nice to have.
  61 Irssi::settings_add_bool("lastfm", "lastfm_get_player", 0);
  62 
  63 # Changelog#{{{
  64 
  65 # 5.8 -- Tue Jan 25 16:11:29 CET 2011
  66 # * Ignore a closure warning
  67 
  68 # 5.7 -- Mon Jan 24 16:39:06 CET 2011
  69 # * Fixed a bug where we forked when we still waited for a reply from last.fm
  70 
  71 # 5.6 -- Sun Jul 18 13:16:38 CEST 2010
  72 # * Made substitution variable %user available when /np <username> or
  73 # %np(<username>) is used.
  74 # * Made some checks a bit more strict.
  75 
  76 # 5.5 -- Mon Jul 12 19:04:26 CEST 2010
  77 # * Rewrote the whole error handling
  78 # * Fixed a bug where the error messages would be said and not printed.
  79 # * Fixed some minor bugs and removed some unneeded code.
  80 
  81 # 5.4 -- Wed May 26 17:04:08 CEST 2010
  82 # * Last.fm updated their profile HTML so that the %player macro didn't work.
  83 # Thanks to Keith Ward for mentioning this and suggesting a fix.
  84 # * A minor fix which removes some debug messages when error reporting.
  85 
  86 # 5.3 -- 
  87 # * I used POSIX::_exit() but I never did "use POSIX;". Leo Green, mortiis and
  88 # rissy reported this problem, thanks! This is an issue when you have a newer
  89 # version of Perl installed (>5.10)
  90 
  91 # 5.2 -- Mon Nov 16 08:25:20 CET 2009
  92 # * When you remove a subroutine you should remove all calls to it..
  93 
  94 # 5.1 -- Wed Nov 11 09:39:54 CET 2009
  95 # * Ok, I admit that using undocumented features in an API is bad, but come
  96 # on..  Anyway, fixed now, everything should work as it should and should
  97 # never break again (flw)...
  98 
  99 # 5.0 -- Mon Nov 9 08:34:48 CET 2009
 100 # * Fixed a warning reported by mm_mannen and did a yet another clean up
 101 
 102 # 4.9 -- Sat Nov 7 18:10:17 CET 2009
 103 # * Last.fm changed how their API behaved and that broke my code because
 104 # I'm a fool and I don't want to use an XML-lib because of your sake (so you
 105 # won't have to install yet another Perl-module). Thanks to supertobbe and 
 106 # mm_mannen who saw and reported this!
 107 # * Fixed so that lastfm_get_player works again and made it say that it
 108 # doesn't work next time Last.fm changes their HTML.
 109 # * Removed the date support in lastfm_output and lastfm_output_tab_complete
 110 # since I use the API another way now.
 111 # * Removed cache. It was broken at times and I can't be arsed to debug it.
 112 # It's not that much faster but the complexity gets bigger. If someone REALLY
 113 # needs this, give me a shout.
 114 # * Removed, rewrote and cleaned up some parts of the script.
 115 
 116 # 4.8 -- Sun May 10 10:11:29 CEST 2009
 117 # * Fixed a bug with the cache ('There are only two hard things in 
 118 # Computer Science: cache invalidation and naming things' -Phil Karlton)
 119 # * Started using HTML::Entities for decoding all sorts of HTML-chars, it's 
 120 # included in libwww anyway.
 121 
 122 # 4.7 -- Tue Apr  8 13:37:11 CEST 2009
 123 # * Start using LWP::UserAgent instead of LWP::Simple and got rid of the idea to
 124 # start using my own HTTP-lib (it was finished, but..). I'm getting old ; P
 125 # * Made so that everything is cached and checks if the Last-Modified date when 
 126 # getting information from Last.fm.
 127 # * Fixed some documentation bugs.
 128 
 129 # 4.6 -- Wed Mar 18 19:45:11 CET 2009
 130 # * Fixed an changed behavour in irssi-trunk with the error handling (which I should replace anyway!).
 131 # * Added %player substitute variable that shows what application you are using to scrobble with. This is very slow, so I made it an option, "lastfm_get_player".
 132 # * Fixed print_raw once and for all (famous last words..) so now debug output looks really neat.
 133 # * Added an quick start which should help get going faster
 134 # * Fixed an issue where %np(lastfmusername) would not work.
 135 # * Fixed error mesages for %np(lastfmusername)
 136 # * Fixed an problem with irssi-svn where die's message have changed. Thanks tto jnpplf  for reporting this.
 137 
 138 # 4.5 -- Wed  1 Oct 2008 20:03:47 CEST
 139 # * Removed a debug output
 140 # * Fixed some datacorruption, references in Perl is hard! = (
 141 
 142 # 4.4 -- Wed  1 Oct 2008 16:34:34 CEST
 143 # * Changed so that all the tab-commands use % instead of $ so that it's consistent through out the script.
 144 # * Ripped out my sprintf crap and made it more sane. You should use %artist, %album, etc in your nowplaying-setting now. Since sprintf is nolonger used I renamed that setting too.
 145 # * Made everything that you can set in "lastfm_output" tabable so now you can do %artist<TAB>.
 146 # %() in "lastfm_output" really works. It really didn't before.
 147 # * Fixed some issues with the date probably not working, but should now.
 148 # * Made the script check if Last.fm's scrobbler server is alive and kicking before we blame them.
 149 
 150 # 4.3 -- Mon 21 Jul 2008 08:46:36 CEST
 151 # * Seem like I misunderstood the protocol. The date/time is only sent when we have scrobbled the track, not when we started to listen to it.
 152 
 153 # 4.2 -- Tue 15 Jul 2008 15:40:08 CEST
 154 # Yay! Three new version within a day! (No, I'm not bored at work)
 155 # * Made /np username and $np(username) make username the prefix of np: yadayada or whatever your lastfm_sprintf or lastfm_sprintf_tab_complete is.
 156 
 157 # 4.1 -- Tue 15 Jul 2008 15:23:03 CEST
 158 # Well, that version lasted long!
 159 # * Fixed a bug with /np not working.
 160 # * Fixed an issue where debug info would be printed even if lastfm_debug was off.
 161 
 162 # 4.0 -- Tue 15 Jul 2008 10:17:51 CEST
 163 # * Fixing a sprintfng-bug which didn't display time if album was not set.
 164 # * Rewrote the whole script to use Last.fm's API which is very accurate. There is no need for $np! and /np! now, so I'm removing them.
 165 # * Cleaned up abit.
 166 
 167 # 3.9 -- Fri 11 Jul 2008 21:49:20 CEST
 168 # * Fixing a few bugs noticed by supertobbe
 169 
 170 # 3.8 -- Fri 11 Jul 2008 18:21:52 CEST
 171 # * Shaped up error handling and now all error messages are shown.
 172 # * Added a user configurable debug mode, good for sending in bugs and weird behaviour.
 173 # * Minor cleanup
 174 
 175 # 3.7 -- Thu 22 May 2008 10:33:55 CEST
 176 # * Fixed so that /np! and $np! fetches the album title too. This is horribly slow and takes approx. 6s on very fast connection. Last.fm isnt very fast I'm afraid and this is not a good way to do it.
 177 # * Cleaned up a few places. Started to look at the error handling and it seems to be alot of work.
 178 
 179 # 3.6 -- Tue Nov 13 15:22:37 CET 2007
 180 # * Fixed encoding so that it always the data into the charset that you have specified in "term_charset" which irssi also uses.
 181 
 182 # 3.5 -- Mon Nov 12 11:50:46 CET 2007
 183 # * Fixed the regex for parsing Recently Listened Tracks so that it works when listening with the Lastfm client.
 184 
 185 # 3.4 -- Fri Nov  9 00:23:40 CET 2007
 186 # * Added /np lastfmusername
 187 
 188 # 3.3 -- Tue Nov  6 01:54:59 CET 2007
 189 # * Finally added conditional sprintf-syntax! Let's say you want to use 'np: %s-%s (%s)' as "lastfm_sprintf". If you use /np it works out fine and displays 'np: Boards of Canada-Energy Warning (Geogaddi)' but what if you use /np! then it displays 'np: Boards of Canada-Energy Warning ()' since /np! can't get the album information. Doesn't that look ugly? Meet conditional sprintf. Now set your "lastfm_sprintf" to 'np: %s-%s%( (%s))'. ' (%s)' will only be printed if we get a third value, the album name in this case. Smart, huh? Big thanks to rindolf, apeiron and Khisanth from #perl@freenode for help with scoping with global variables.
 190 # * Also added "lastfm_sprintf_tab_complete" which makes, if set, $np<TAB> use a different sprintf pattern than /np. Will default back to "lastfm_sprintf".
 191 
 192 # 3.2 -- Wed Oct 24 23:07:01 CEST 2007
 193 # * I don't like dependencies and I really wonder why I lastfm depended on DateTime. I remember now that it was morning and I was really tired when I coded it. Anyway, it's removed now along with Socket and URI::Escape. I'll try to remove the dependency for libwww later on.
 194 
 195 # 3.1 -- Sun Oct 21 22:52:36 CEST 2007
 196 # * Added /np! and $np! to use the "lastfm_be_accurate_and_slow" method without having to change the setting.
 197 
 198 # 3.0 -- Fri Oct 19 14:26:03 CEST 2007
 199 # * Created a new setting "lastfm_be_accurate_and_slow" which makes lastfm.pl parse your profile page to check what song you are playing right now. But be warned, this is slow and horrible (like my code! ; ). But it works until Last.fm makes this data available through their Web Services. This disables the album and "scrobbled at" features of "lastfm_sprintf" so you have to adapt it if you don't want it to look weird. I'm working on a new implementation of printf which allows for conditions but it took more time than I thought and time is something that I don't have much of ='(
 200 
 201 # 2.5 -- Tue Oct  9 11:29:56 CEST 2007
 202 # * Fixed the encoding issue by converting from Last.fms UTF-8 into Perls internal encoding. With $np<TAB> output will be looking UTF-8-in-latin1 if you don't have an UTF-8 enabled Terminal, but it will display correctly after you have sent it.
 203 
 204 # 2.4 -- Mon Oct  8 16:08:09 CEST 2007
 205 # * Fixed an error in error reporting ; P Bug noticed by supertobbe = *
 206 # * I should make an more generic and better error reporting.
 207 
 208 # 2.3 -- Sat Oct  6 16:38:34 CEST 2007
 209 # * Made /np a nonblocking operation. Irssi's fork handling is REALLY messy. Thanks to tss and tommie for inspiring me in their scripts. $np cannot be made nonblocking, I'm afraid (patches welcome).
 210 # * Cleaned up abit.
 211 
 212 # 2.2 -- Sat Aug 18 02:20:44 CEST 2007
 213 # * Now you can use $np(darksoy) to see what I play (or someone else for that matter ; ).
 214 
 215 # 2.1 -- Tue Jul 17 12:50:18 CEST 2007
 216 # * Now you can use $np or $nowplaying as a tab-completion too, but a warning here, this is a blocking action so irssi won't respond or be usable until it is finished or the timeout is hit.
 217 # * Abstracted it abit more so that it can be used in more ways, ex. for the reason above.
 218 
 219 # 2.0 -- Fri Jun 29 10:38:32 CEST 2007
 220 # * Now you can show the time that the song was submitted in lastfm_sprintf. Added lastfm_strftime to configure how the date is presented.
 221 # * Added $lastfm and $lfm as tab-completions to your own Last.fm profile URL. Ripoff of Jured's guts.pl (http://juerd.nl/irssi/)
 222 
 223 # 1.5 -- Sat May 12 03:30:24 CEST 2007
 224 # * Started using XML instead because we get more info from it, like album (but it's often wrong).
 225 
 226 # 1.0 -- Thu Apr 12 16:57:26 CEST 2007
 227 # * Got fedup with no good Last.fm-based now playing scripts around.
 228 
 229 # THANKS
 230 # Random individuals on #perl@freenode, could namedrop icke, 
 231 # }}}
 232 
 233 # TODO
 234 # You tell me!
 235 
 236 # Move along now, there's nothing here to see.
 237 
 238 sub DEBUG {
 239   Irssi::settings_add_bool("lastfm", "lastfm_debug", 0);
 240   Irssi::settings_get_bool("lastfm_debug");
 241 };
 242 
 243 use strict;
 244 use warnings;
 245 no warnings 'closure';
 246 use Data::Dumper;
 247 use Encode;
 248 use HTML::Entities;
 249 use Irssi;
 250 use LWP::UserAgent;
 251 use POSIX;
 252 
 253 my $pipe_tag;
 254 my $waiting_for_reply;
 255 my $api_key = "eba9632ddc908a8fd7ad1200d771beb7";
 256 my $fields = "(artist|name|album|url|player|user)";
 257 my $ua = LWP::UserAgent->new(agent => "lastfm.pl/$VERSION", timeout => 10);
 258 
 259 sub lastfm_nowplaying {
 260   my ($content, $url, $response, $tag, $value, %data);
 261   my ($user_shifted, $is_tabbed, $nowplaying, $witem) = @_;
 262   my $user = $user_shifted || Irssi::settings_get_str("lastfm_user");
 263   $nowplaying ||= ((Irssi::settings_get_str("lastfm_output_tab_complete") ne "" && $is_tabbed) ? Irssi::settings_get_str("lastfm_output_tab_complete") : Irssi::settings_get_str("lastfm_output"));
 264 
 265   my $command_message = ($is_tabbed) ? '%%np(username)' : '/np username';
 266   if ($user eq '') {
 267     return "ERROR: You must /set lastfm_user to a username on Last.fm or use $command_message";
 268   }
 269 
 270   if ($nowplaying =~ /^%(lastfm|lfm)$/) {
 271     return "http://last.fm/user/$user/";
 272   }
 273   elsif ($nowplaying =~ /^%user$/) {
 274     return $user;
 275   }
 276 
 277   $data{'user'} = $user if ($user_shifted);
 278 
 279   $url = "http://ws.audioscrobbler.com/2.0/?method=user.getrecenttracks&user=$user&api_key=$api_key&limit=1";
 280   print Dumper "Checking for scrobbles at: $url" if DEBUG;
 281   $response = $ua->get($url);
 282   $content = $response->content;
 283 
 284   # TODO This should work, untested (fail more Last.fm! ; )
 285   if ($content =~ m!<lfm status="failed">.*<error .*?>([^<]+)!s) {
 286     return "ERROR: $1";
 287   }
 288   my @data = split('\n', $content);
 289 
 290   if (!grep(m!<track nowplaying="true">!, @data)) {
 291     print Dumper \$response if DEBUG;
 292     print Dumper \$content if DEBUG;
 293     return "ERROR: You are not playing anything according to Last.fm. Check http://www.last.fm/user/$user and see if they turn up there, otherwise restart your scrobbler.";
 294   }
 295 
 296   my $regex = qr!<$fields.*?(?:uts="(.*?)">.*?|>(.*?))</\1>!;
 297 
 298   foreach my $data (@data) {
 299     if ($data =~ m!</track>!) {
 300       last;
 301     }
 302     elsif ($data =~ /$regex/) {
 303       ($tag, $value) = ($1, (defined($2) ? $2 : $3));
 304       print Dumper \$tag, \$value, \$data if DEBUG;
 305       $data{$tag} = $value;
 306     }
 307   }
 308 
 309   if (Irssi::settings_get_bool("lastfm_get_player")) {
 310     $url = "http://www.last.fm/user/$user";
 311     $content = $ua->get($url)->content;
 312     if ($content =~ m!<span class="source">(.*?)</span>!) {
 313       $_ = $1;
 314       s/<[^>]*>//mgs;
 315       $data{'player'} = $_;
 316     }
 317     else {
 318       print "Couldn't find the player even though lastfm_get_player was set" if DEBUG;
 319     }
 320   }
 321 
 322   print Dumper \%data if DEBUG;
 323   print Dumper "Output pattern before: $nowplaying" if DEBUG;
 324   $nowplaying =~ s/(%\((.*?%(\w+).?)\))/($data{$3} ? $2 : "")/ge;
 325   print Dumper "Output pattern after: $nowplaying" if DEBUG;
 326   $nowplaying =~ s/%$fields/$data{$1}/ge;
 327   decode_entities($nowplaying);
 328   Encode::from_to($nowplaying, "utf-8", Irssi::settings_get_str("term_charset"));
 329   return $nowplaying;
 330 }
 331 
 332 sub lastfm_blocking {
 333   my ($witem, $user) = @_;
 334   my $nowplaying = lastfm_nowplaying($user, undef, undef, $witem);
 335   lastfm_print($witem, $nowplaying);
 336 }
 337 
 338 sub lastfm_forky {
 339   my ($witem, $user) = @_;
 340   if ($waiting_for_reply) {
 341     lastfm_print(Irssi::active_win(), "We are still waiting for Last.fm to return our results");
 342     return;
 343   }
 344   # pipe is used to get the reply from child
 345   my ($rh, $wh);
 346   pipe($rh, $wh);
 347 
 348   # non-blocking host lookups with fork()ing
 349   my $pid = fork();
 350   if (!defined($pid)) {
 351     Irssi::print("Can't fork() - aborting");
 352     close($rh);
 353     close($wh);
 354     return;
 355   }
 356 
 357   $waiting_for_reply = 1;
 358 
 359   if ($pid > 0) {
 360     # parent, wait for reply
 361     close($wh);
 362     Irssi::pidwait_add($pid);
 363     $pipe_tag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, [$witem, $rh]);
 364     return;
 365   }
 366 
 367   my $text;
 368   eval {
 369     # child, do the lookup
 370     $text = lastfm_nowplaying($user);
 371   };
 372 
 373   if (!$text) {
 374     $text = "ERROR: Error message: $!";
 375   }
 376 
 377   eval {
 378     # write the reply
 379     print($wh $text);
 380     close($wh);
 381   };
 382   POSIX::_exit(1);
 383 }
 384 
 385 
 386 sub pipe_input {
 387   my ($witem, $rh) = @{$_[0]};
 388   my $text = <$rh>;
 389   close($rh);
 390 
 391   Irssi::input_remove($pipe_tag);
 392   $pipe_tag = -1;
 393   undef $waiting_for_reply;
 394 
 395   lastfm_print($witem, $text);
 396 }
 397 
 398 sub lastfm_print {
 399   my ($witem, $text, $tabbed) = @_;
 400   # Fugly error handling
 401   if ($text =~ s/^ERROR: //) {
 402     Irssi::active_win()->print($text);
 403     return;
 404   }
 405 
 406   if ($tabbed) {
 407     return $text;
 408   }
 409   elsif (defined $witem->{type} && $witem->{type} =~ /^QUERY|CHANNEL$/) {
 410     if (Irssi::settings_get_bool("lastfm_use_action")) {
 411       $witem->command("me $text");
 412     }
 413     else {
 414       $witem->command("say $text");
 415     }
 416   }
 417   else {
 418     Irssi::active_win()->print($text);
 419   }
 420 }
 421 
 422 Irssi::command_bind('np', sub {
 423     my ($data, $server, $witem) = @_;
 424     $data =~ s/ .*//;
 425     $data ||= 0;
 426     if (DEBUG) {
 427       lastfm_blocking($witem, $data);
 428     }
 429     else {
 430       lastfm_forky($witem, $data);
 431     }
 432   }, 'lastfm');
 433 
 434 Irssi::signal_add_last 'complete word' => sub {
 435   my ($complist, $window, $word, $linestart, $want_space) = @_;
 436   my $is_tabbed = 1;
 437   my $tab_fields = $fields;
 438   $tab_fields =~ s/\(/(nowplaying|np|lastfm|lfm|/;
 439   if ($word =~ /(\%(?:$tab_fields))\(?(\w+)?\)?/) {
 440     my ($nowplaying, $user) = ($1, $3);
 441     undef $nowplaying if ($nowplaying =~ /nowplaying|np/);
 442     $nowplaying = lastfm_nowplaying($user, $is_tabbed, $nowplaying);
 443     if (lastfm_print(Irssi::active_win(), $nowplaying, 1)) {
 444       push @$complist, "$nowplaying";
 445     }
 446   }
 447 };