#! /usr/bin/perl

#   Copyright (c) 2007,9,10,13  Joey Schulze <joey@infodrom.org>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc.,59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use strict;
use warnings;

use LWP::UserAgent;
use Getopt::Long;
use Config::IniFiles;

my %config = (
	      'config' => $ENV{HOME}.'/etc/netradio.conf',
	      'agent' => undef,
	      'outdir' => '/var/lib/mpd/playlists',
	      'verbose' => 0,
	      );

my %options = (
	       'config=s' => \$config{config},
	       'agent|useragent|ua=s' => \$config{agent},
	       'outdir=s' => \$config{outdir},
	       'verbose+' => \$config{verbose},
	       'help' => \&help,
	       );
my $radiolist;

sub help
{
    print<<EOT;
netradio-list [OPTIONS]
 --config f      Use config file f instead of $config{config}
 --useragent ua  Use UserAgent ua
 --outdir d      Write data to d
 --verbose       Increase verbosity level
 --help          This help screen
EOT
    exit;
}

sub fetch_file
{
    my $url = shift;
    my $ua = new LWP::UserAgent;
    $ua->agent ($config{agent}) if defined $config{agent};
    $ua->timeout (20);
    $ua->env_proxy;

    my $request = new HTTP::Request ('GET', $url);
    my $response = $ua->request ($request);

    return $response->content if ($response->is_success);

    return undef;	
}

sub discover_streams
{
    my $station = shift;
    my $info = {'name' => $station,
		'url' => $radiolist->val($station, 'url'),
		'streams' => []};

    foreach my $playlist ($radiolist->val($station, 'stream')) {
	printf "  Fetch %s\n", $playlist if $config{verbose};
	if (my $pl = fetch_file $playlist) {
	    foreach (split /\r?\n/, $pl) {
		if (m,^\s*(File1=)?(http://.*)$,) {	# pls / m3u
		    push @{$info->{streams}}, $2;
		} elsif (m,^\s*<ref\s+href\s*=\s*"(http://[^"]*)"\s*/>,) {
		    push @{$info->{streams}}, $1;
		}
	    }
	}
    }

    if (!scalar @{$info->{streams}}) {
	print "Nothing found for %s\n", $station if $config{verbose};
	printf STDERR "Nothing found for %s\n", $station;
	return;
    }

    return $info;
}

sub write_m3u
{
    my $info = shift;

    my $fname = $config{outdir} . '/' . $info->{name} . '.m3u';

    printf "  Write file %s\n", $fname if $config{verbose};
    open my $out, '>', $fname or return;

    if (exists $info->{url}) {
	printf $out "# %s <%s>\n", $info->{name}, $info->{url};
    } else {
	printf $out "# %s\n", $info->{name};
    }
    print $out "#\n";
    foreach my $stream (@{$info->{streams}}) {
	printf $out "%s\n", $stream;
    }
    close $out;
}

GetOptions %options;

$radiolist = new Config::IniFiles(-file => $config{config});

foreach my $station ($radiolist->Sections) {
    printf "Discover %s\n", $station if $config{verbose};
    my $info = discover_streams $station;
    next unless $info;
    do {printf "    %s\n", $_ foreach @{$info->{streams}}} if $config{verbose} > 1;
    write_m3u $info;
}