in reply to Re: Perl/Tk while {1} and a responsive UI
in thread Perl/Tk while {1} and a responsive UI
#!/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
|
|---|