#!/usr/bin/perl -w
# polls what's current playing on radio KOIT in San Francisco,
# get the lyrics from lyricsbox.com
# TODO: (1) make the title search a little fuzzier
#       (2) search more sites for lyrics
#       (3) nicer interface? color, scrolling?
# ====================================================================
# Pragmas & Libs
use strict;
use LWP::Simple;
use URI::Escape;
use Time::Local;
use HTML::Entities;

# Main vars
my @lyrics = (\&lyrics_matrix, \&lyrics_seeklyrics, \&lyrics_musicsong
+);
my $rlyrics = \@lyrics;
my @channels = (
    ["TEST", \&nowplay_TEST],           
    ["KOIT", \&nowplay_KOIT],
    ["HITZ", \&nowplay_HITZ]
    );
my $TRACE = 1;


# ===================================================================
#                       Text UI (STDOUT)
# ===================================================================
select((select(STDOUT), $| = 1)[0]);                # Autoflush STDOUT
my $sleep = 60;                                     # Poll once/min
=cut
#print play_station(\&nowplay_TEST, $rlyrics);
while (1) {
    print play_station(\&nowplay_KOIT, $rlyrics);
    print play_station(\&nowplay_HITZ, $rlyrics);
    sleep $sleep;                                   # Wait & retry 
}
=cut

# ===================================================================
#                       GUI (TK)
# ===================================================================
use Tk;
my $mw = MainWindow->new();
    $mw->minsize(qw(100  20));                                        
    $mw->maxsize(qw(600 700));

my $list; $list= $mw->Scrolled("Listbox", -height=>5, -scrollbars=>"e"
+)
    ->pack(qw/-fill x/);
    $list->bind("<1>",  sub { do_lyrics($list->curselection()) });
    $list->bind("<3>",  sub { $rlyrics = ($rlyrics ? undef() : \@lyric
+s);
                        do_lyrics($list->curselection())} );
    for (@channels) { $list->insert("end", $_->[0]); }

my $detail; 
sub detail_add {
    $detail = $mw->Scrolled("Text", -height=>20, -width => 40,
    -scrollbars=>"se", -wrap=>'none')->pack(qw/-fill both -expand 1/);
}
# -------------------------------------------------------------------
    MainLoop;

sub do_lyrics {
    my $idx = shift;
    $detail->destroy if Tk::Exists($detail); detail_add();
    reset_station($idx); lyrics($idx);
    $detail->repeat(60000, sub { lyrics($idx); } );
}
sub lyrics {
    my $lyrics = play_station($channels[$_[0]]->[1], $rlyrics);
    $detail->insert("end", $lyrics); $detail->see("end");
}


# ===================================================================
#                       Play station
# ===================================================================
my %current;            # Map Statiom -> current $artist$title ("class
+ data")
sub play_station {
    my ($station, $rlyrics) = @_;
    my ($artist, $title, $tdif) = $station->(); # Now playing on $stat
+ion..
    unless ($artist and $title) { return "*"; }
    my $ret;
    if (!defined($current{$station}) or $current{$station} ne "$artist
+$title") {
        $ret = build_header($artist, $title, $tdif);
        $current{$station} = "$artist$title";
        for (@$rlyrics) {                       # Probe @lyrics sites 
+for texts
            if ( my $ly = $_->($artist,$title) )
            { $ret .= "$ly\n"; last unless ($TRACE or $ly =~ /Not Foun
+d/i); }
        }
    } else { $ret = "." }
    return $ret;
}
sub reset_station {
    delete($current{$channels[shift]->[1]});
}
    
# -------------------------------------------------------------------
sub build_header {
    my ($artist, $title, $tdif) = @_;
    my $hdr = "\n" . "-"x50 . "\n";
    my $LOC=time(); $tdif ||= 0;
    my $STA=$LOC+($tdif*60*60);
    $hdr .= "LocalTm: " .  scalar(localtime($LOC)) . "\n";
    $tdif and $hdr .= "Station: " . scalar(localtime($STA)) . "\n\n";
    $hdr .= "[$artist]: [$title]\n\n";
    return $hdr;
}

# ===================================================================
#                       Stations
# ===================================================================
sub nowplay_TEST {
    my @case = (
        ["Bryan Adams", "(everything I Do) I Do It For You"],
        ["Backstreet Boys", "I'll Never Break Your Heart"],
        ["Roxette", "It Must Have Been Love"],
    );
    my ($artist, $title) = ($case[0][0], $case[0][1]);
    for (\$artist, \$title) { clean_at($_); }
    return ($artist, $title);

}
# -------------------------------------------------------------------
sub nowplay_KOIT {
    my $url = "http://koit.com/nowplay_data.cfm";
    my $tdif = -9;   # cf Copenhagen
    my $data = get($url);
    my ($artist, $title) = $data =~ m|box=(.+) - (.+)&|;
    for (\$artist, \$title) { clean_at($_); }
    return ($artist,$title,$tdif);
}
# -------------------------------------------------------------------
sub nowplay_HITZ {
    my $url = "http://hitzradio.com/";
    my $data = get($url);
    my ($artist, $title) = $data =~ m|<span id="nowplaying">(.+) - (.+
+)</span>|;
    for (\$artist, \$title) { clean_at($_); }
    #??for ($artist,$title) {  s/\(.*?\)+//g; s/\(.*//g; }
    return ($artist,$title);
}

# ===================================================================
#                       Lyrics
# ===================================================================
sub lyrics_lyricsbox {  # Pt Broken...
    my ($artist, $title) = @_;
    my $lyricsbox   = "http://www.lyricsbox.com";
    my $lyrics_list = "$lyricsbox/cgi-exe/am.cgi?a=search&p=1&l=artist
+&s=";
    my $list = get($lyrics_list.uri_escape($artist));
    my ($song, $ly);
    my ($url) =  $list =~ m|<A href="([^"]+)">\Q$title\E.*?</A></td>|i
+;
    if ($url)  { $song = get($lyricsbox.$url); }
    if ($song) { ($ly) = $song =~ m|<PRE.*?>(.+)</PRE>|si; }
    return "LyricsBox: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_matrix {
    my ($artist, $title) = @_;
    for ($title) { s/\s/_/g; s/\'//g; }
    my $t = lc(substr($title,0,1));
    my ($url, $ly) = ("http://www.ntl.matrix.com.br", "");
    foreach my $try ("html/lyrics/$t", "oldies_list/top/lyrics") {
        $url .= lc("/pfilho/$try/${title}.txt");
        $TRACE and print "[$url]\n";
        $ly = get($url); last if $ly;
    }
    if ($ly) { $ly = clean_ly($ly); }
    return "Matrix: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_musicsong {
    my ($artist, $title) = @_;
    my $a = ($artist =~ /^\d+/ ? "0" : uc(substr($artist,0,1)));
    for ($artist,$title) { s/\s//g; s/ & //g; s/(.*)/\L$1/g; }
    my ($url, $song, $ly) = ("http://www.musicsonglyrics.com", "", "")
+;
    $url .= "/$a/${artist}lyrics/$artist${title}lyrics.htm";
    $TRACE and print "[$url]\n";
    $song = get($url);
       eval { if ($song) {
        ($ly) = $song =~ m|<span.*?>(.+)</span>|si; }
    };  $@ and warn $ly = "Parse error: $@ \n";
    if ($ly) { $ly = clean_ly($ly); }
    return "MusicSong: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_seeklyrics {
    my ($artist, $title) = @_;
    for ($artist,$title) { s/^\s+//; s/\s+$//; }
    my ($a, $t) = ($artist, $title);
    for ($artist,$title) { s/(['\w]+)/\u\L$1/g; s/('|\s)+/-/g; }
    my ($url, $song, $ly) = ("http://www.seeklyrics.com", "", "");
    for my $try ($artist, uc($artist)) {
        $url .= "/lyrics/$artist/$title.html";
        $song = get($url);
        $TRACE and print "[$url]\n"; last if $song;
    }
    eval { if ($song) {
        ($ly) = $song =~ m|<b>$a - $t Lyrics</b>\s*<pre>(.*?)</pre|si;
+ }
    };  $@ and warn $ly = "Parse error: $@ \n";
    if ($ly) { $ly = clean_ly($ly); }
    return "SeekLyrics: " . ($ly ? $ly : "Not Found...");
}
# -------------------------------------------------------------------
sub lyrics_007 {
#   <To-Be-Done>
    my $lyrics007 = "http://www.lyrics007.com";
#   http://www.lyrics007.com/<artist>%20Lyrics/<title>%20Lyrics.html
#   where <artist> & <title> spaces & specs are %20 encoded
}
# -------------------------------------------------------------------
#   <To-Be-Done>
#   http://www.lyricsspot.com/
# -------------------------------------------------------------------


# ===================================================================
#                       Utils
# ===================================================================
sub clean_at {
    my $rat = shift;
    for ($$rat) { s/^\W+//g; s/[()]//g; s/\W+$//g; }
}
# -------------------------------------------------------------------
sub clean_ly{
    my $ly = shift;
    for ($ly) {
        s/<.*?>//gi; decode_entities($_);       # HTML tags & char enc
+oding
        s/^\s+//; s/\s+$//;                     # Strip WS
        s/(\x0D)*\n/\n\t/g; s/\x92/\x27/g;      # Handle NL & '
        tr/\200-\377/*/s;                       # Zap 8bit chars
    }
     return $ly;
}

# END
[download]