This script is used to display the current playing from wcpe.org, an online classical radio station.
This is my second version using LWP and sleep function.
My previous version uses "wget" and alarm signal handler.
I also had a Python version, doing the same thing.
I like this better because it is relatively simple and more clear.
The very first version was created 2+ years ago and I rewrote it couple of times for various reasons.
I added command line options support today and finally decide to publish it.
The html code is generated by PerlTidy, which is one of my favorite Perl tools, used to format your Perl code and generate readable HTML code for your Perl script for publishing.
btw: PerlTidy is named after the HTML Tidy tool, which is a similar tool to format the html source.
Another similar source code beautifier tool is BCPP, used to beautify your C/C++ code.
wcpe.pl
#!/usr/bin/perl -w
# Hao Chen (lcheu@cs.sfu.ca)
#
# The purpose of this script is to retrieve the current playing info. from wcpe.org's website.
# The default behavior is to retrieve the current playing each time it changes.
#
use strict;
use LWP::UserAgent;
my $url = 'http://theclassicalstation.org/music/';
my $weekdays = ['monday', 'tuesday', 'wednesday', 'thursday', 'friday', 'saturday', 'sunday'];
my $today;
my $debug = 0;
my $xmessage = 1;
my ($start_time, $composer, $title, $performer, $record);
my ($wait, $msg, $hour, $minute);
my ($ua, $req, $res);
$ua = LWP::UserAgent->new;
$ua->agent("LWP/0.1 ");
sub retrieve_playing
{
$req = HTTP::Request->new(GET => $today);
$res = $ua->request($req);
if ($res->is_success) {
foreach (split("\n", $res->content)) {
if ($_ =~ m@.*<td>(\d{1,2}):(\d\d)</td>.*Buy Now!</a></td> <td>(.*)</td> <td>(.*)</td> <td>(.*)</td> <td>(.*)</td> <td>[\d /\.\-CD]*</td> <td>\d*</td>@) {
if ($debug) {
print "..................\n";
print "start time: $1:$2\n";
print "composer: $3\n";
print "title: $4\n";
print "performers: $5\n";
print "record label: $6\n";
}
if (($hour*60 + $minute) <= ($1 * 60 + $2)) {
if ($debug) {
print "******************\n";
print "$1:$2\n";
printf "start time: %40s\n", $start_time;
printf "composer: %40s\n", $composer;
printf "title: %40s\n", $title;
printf "performers: %40s\n", $performer;
printf "record label: %40s\n", $record;
}
$wait = int(($1 - $hour) * 3600 + ($2 - $minute) * 60);
$msg = "$composer\n$title\n$performer\nRemaining:$wait seconds";
prompt_message($msg);
last;
}
$start_time = "$1:$2";
$composer = $3;
$title = $4;
$performer = $5;
$record = $6;
} else {
print "NOT MATCH: ". $_ . "\n" if ($debug);
}
}
} else {
print $res->status_line, "\n";
}
}
sub prompt_message
{
my ($msg) = @_;
if ($xmessage) {
my @cmd_line = ("/usr/X11R6/bin/xmessage", $msg, "-center", "-timeout", 10);
system(@cmd_line) == 0 or die "system @cmd_line failed: $?";
} else {
print $msg . "\n";
}
}
sub print_usage
{
print<<EOF;
Hao Chen (c) 2004-2006. All rights reserved.
Usage: perl wcpe.pl [Options]
Options:
-h | -help Print this help
-d | -debug In debug mode
-x | -xmessage Use xmessage to display info. (default)
-nox | -noxmessage Don't use xmessage, display info. to console
-1 | -once Run only once (default behavior is loop)
EOF
exit;
}
MAIN:
{
my $once = 0;
while ($ARGV[0]) {
if ($ARGV[0] eq "-h" || $ARGV[0] eq "-help") {
print_usage();
} elsif ($ARGV[0] eq "-d" || $ARGV[0] eq "-debug") {
$debug = 1;
} elsif ($ARGV[0] eq "-x" || $ARGV[0] eq "-xmessage") {
$xmessage = 1;
} elsif ($ARGV[0] eq "-nox" || $ARGV[0] eq "-noxmessage") {
$xmessage = 0;
} elsif ($ARGV[0] eq "-1" || $ARGV[0] eq "-once") {
$once = 1;
}
shift @ARGV;
}
while (1) {
$hour = int(`date +%k`+3);
$minute = `date +%M`;
$today = $url.$weekdays->[`date +%u`-1].'.shtml';
retrieve_playing();
last if ($once);
sleep $wait+180;
}
}
exit;
