Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 198 lines (174 sloc) 5.03 KB
#!/usr/bin/perl
#
# Fetches the latest .pls playlist files from di.fm and
# creates one big m3u playlist.
#
# Copyright (c) 2008, Benjamin Peter <BenjaminPeter@arcor.de>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# * Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# * Neither the name of the author nor the
# names of its contributors may be used to endorse or promote products
# derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY Benjamin Peter ''AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL Benjamin Peter BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
use LWP;
use HTTP::Request;
use HTTP::Response;
use HTTP::Headers;
use FileHandle;
use Cwd;
#
# I use this script to automatically fill amarok with the
# playlist, so just enter your player's command here, or
# leave it false.
#
# $application = 'amarok';
my $user_agent = "Mozilla/5.0 (;;;;) Gecko/2009021906 Firefox/3.0.7";
$tmp = '/tmp/diPlaylist';
$threads = 4;
$start=getcwd;
sub main {
print "+++ Creating temp directory.\n";
mkdir $tmp;
if ( ! -d $tmp )
{
print "Could not create temp dir '$tmp'\n";
exit;
}
chdir $tmp;
print "+++ Getting di.fm homepage.\n";
my $dipage = fetch_url('http://di.fm/');
die "Got an empty page from di.fm" unless $dipage;
print "+++ Finding .pls files.\n";
$OUTFILES = [];
$count = 0;
$outfile = 0;
foreach (split("\n", $dipage))
{
if (m/href="(.*?mp3.*?.pls)"/)
{
$a = $1;
if (substr($a,0,1) eq "/")
{
$a = "http://di.fm" . $a;
}
if ($outfile >= $threads) { $outfile = 0 };
push (@{$OUTFILES->[$outfile]}, $a);
++$outfile;
++$count;
}
}
print "+++ Download .pls files ($count) with $threads processes\n";
for ($t = 0; $t < $threads; ++$t)
{
if (fork == 0) {
print "*** download thread $t running.\n";
chdir $tmp;
get_files($OUTFILES->[$t]);
print "\n*** download thread $t done.\n";
exit;
}
}
get_files(["http://metal-only.de/listen.pls"]);
while (wait() != -1) {};
print "\n";
print "+++ Children done, creating m3u playlist.\n";
`merge_pls_to_m3u.pl distreams.m3u *.pls*`;
print "+++ Done.\n";
}
sub fetch_url {
my ($url) = @_;
# Create a user agent object
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->agent($user_agent);
# Create a request
my $req = HTTP::Request->new(GET => $url);
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
# Check the outcome of the response
if ($res->is_success) {
return $res->content;
}
else {
die "Could not fetch '$url':", $res->status_line, "\n";
}
}
sub get_files {
my ($urls) = @_;
# Create a user agent object
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
$ua->agent($user_agent);
foreach my $url (@$urls) {
# Create a request
my $req = HTTP::Request->new(GET => $url);
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
# Check the outcome of the response
if ($res->is_success) {
local $| = 1;
next unless $res->content;
my $filename;
if ($url =~ m#/([^/]+)$#) {
$filename = $1;
}
else {
$filename = "rand-". rand() . ".pls";
}
open(OUT, ">".$filename) or die "Could not write temporary playlist to: ".$filename;
print OUT $res->content;
close OUT;
print ".";
}
else {
die "Could not fetch '$url':", $res->status_line, "\n";
}
}
}
#
# Start
#
if ( -e $tmp)
{
print "Temp dir '$tmp' allready exists, exiting\n";
exit;
}
eval {
main();
};
if ($@) {
print STDERR "Exiting unexpectedly: $@\nSystem Error: $!\n";
}
else {
if ($application) {
eval {
`$application distreams.m3u`;
};
if ($@) {
print STDERR "Exiting unexpectedly: $@\nSystem Error: $!\n";
}
}
else {
`mv $tmp/distreams.m3u $start`
}
}
chdir "/tmp";
`rm -rf "$tmp"`;