#!/usr/bin/perl -w

=head1 NAME

getrmp.pl

=head1 SYNOPSIS

Pass it a local filename:

  getrmp.pl /path/to/somefile.rmp
  getrmp.pl C:\path\to\somefile.rmp

Or a URL:

  getrmp.pl http://server.com/path/to/somefile.rmp

NOTE that URL support is primitive, if the server needs cookies, 
authentication, or redirects, the program will die.

=head1 ABSTRACT

RMP is an XML format for playlists, begun initially by RealNetworks I think.
eMusic.com uses it to allow customers to download full albums with one click.
	
Freeamp/zinf support RMP, but WinAMP does not. And since eMusic.com changed
things around recently, it's harder to use dowload managers because the mp3
links are given broken names and then redirected. My mouse was getting tired
of clicking each song, so this is quick and dirty an RMP processor that, when
passed an RMP file, will download the album and save it somewhere.

Be sure to look over the configuration section for customizations.

Of course all corporate names used herein are trademarked and copyrighted by
their respective owners. And this software is free, with no warranty. Yeah.

=cut

use XML::Simple;
use LWP::UserAgent;
use LWP::Simple;
use File::Copy;
use strict;

## CONFIGURATION

## Where to put files
my $dlpath = "d:\\music\\";

## Make directories for each artist?
my $artistdir = 1;

## Make sub-artist directories for each album?
my $albumdir = 0;

## How to name the new music files.
my $naming = '[##ARTIST## - ##ALBUM##] ##TRACK## ##TITLE##';

### Other configs

## User agent to report
my $agent = 'Mozilla/8.0';

### END OF CONFIGURATION

my $ua = LWP::UserAgent->new;
$ua->agent($agent);

my $rmpfilename = $ARGV[0] || die q|
  Usage:
    getrmp.pl path/or/URL/to/file.rmp
    getrmp.pl C:\path\to\somefile.rmp
    getrmp.pl http://server.com/path/to/somefile.rmp
|;

my $rmpfile;

#### This IF construct may not work if it needs authentication,
#### cookie, or redirect support.
if ($rmpfilename =~ m|^\w+://|) { # we've got a URL
	print "Getting rmp file: ";
	my $res = $ua->request( HTTP::Request->new(GET=>$rmpfilename) );

	# Check the outcome of the response
	if ($res->is_success) {
		$rmpfile = $res->content;
		print "OK\n";
	} else {
		die "Can't get remote $rmpfilename";
	}
} else { #it's a regular /path/to/file on disk
	$rmpfile = $rmpfilename;
}

my $xmlref = XMLin($rmpfile) || die "Something bad happened with XML::Simple";

my $baseurl = 'http://'.
			$xmlref->{SERVER}{NETNAME}.
			$xmlref->{SERVER}{LOCATION};

# got these from http://docs.real.com/docs/rn/realone/RMP_Creation_Guide.pdf
my %parsecodes = (
	fid	=> 'TRACKID',
	f	=> 'FILENAME',
# Note, emusic.com does not use these two, and I don't know what they are. see above URL.
	lid	=> 'UNUSED',
	pid	=> 'UNUSED',
);

my $total = scalar @{$xmlref->{TRACKLIST}{TRACK}};
my $tcount;

print "Downloading '$xmlref->{TITLE}' from $xmlref->{SERVER}{NETNAME}\n\n";

foreach my $track (@{$xmlref->{TRACKLIST}{TRACK}}) {

	# Weed out some bad characters
	for (qw(ARTIST ALBUM TITLE)) {
		$track->{$_} =~ s([\*\?\/\\])(-)g;
	}


	my $TRACKNO = sprintf("%02d",++$tcount);
	# Here's where we make any new dirs
	if ($artistdir) {
		makedir($dlpath.$track->{ARTIST})
			or die "Can't make directory $dlpath.$track->{ARTIST}";
		if ($albumdir) {
			makedir($dlpath.$track->{ARTIST}."\\".$track->{ALBUM})
				or die "Can't make directory $dlpath.$track->{ARTIST}.$track->{ALBUM}";
		}
	}

	# Figure out the new filename
	(my $newfile = $naming) =~ s/##TRACK##/$TRACKNO/g;
	for (qw(ARTIST ALBUM TITLE)) {
		$newfile =~ s/##$_##/$track->{$_}/ge;
	}

	my $fullpath = $dlpath .
			($artistdir ? "$track->{ARTIST}\\" : '') .
			($albumdir ? "$track->{ALBUM}\\" : '') .
			$newfile;
	
	my ($expected_length, $bytes_received);
	
	open FH, "> $fullpath.getrmp" or die "Can't open file $fullpath.getrmp";
	binmode (FH);
	print "$tcount/$total: $newfile\n";

	my $url = $baseurl;

	# Interpolate the path codes
	for (qw(fid f lid pid)) {
		$url =~ s/\%$_/$track->{ $parsecodes{$_} }/g;
	}

	my ($extension) = ($track->{FILENAME} =~ /(\.\S*)$/);

	my $tracktime = time;

	my $res = $ua->request( HTTP::Request->new(GET => $url),
			sub  {
				my($chunk, $res) = @_;
				$bytes_received += length($chunk);
				unless (defined $expected_length) {
					$expected_length = $res->content_length || 0;
				}
				print FH $chunk;
				progress($bytes_received, $expected_length);
			},1024);

	close FH;

	my $ttime = time - $tracktime;
	my $kbps = int ($bytes_received / 1024 / $ttime);
	print " - $bytes_received bytes OK at $kbps KBps\n";
	move("$fullpath.getrmp", $fullpath.$extension)
		or print "  ERROR Moving File. Temp file left.\n";

} #END foreach

print "Finished\n";


sub progress {
	my ($val, $tot) = @_;
	printf("\b" x 4 . "%3d%%", int(100 * $val / $tot));
}

sub makedir {
	my $dir = shift;
	if (-e $dir) {
		return 1;
	}else{
		return mkdir $dir;
	}
}