use strict;
use warnings;
use IO::Socket;
use Tk;
use Tk::ProgressBar;
use Tk::HList;
use Tk::LabFrame;
use Digest::MD5 qw(md5_hex);
use encoding 'utf-8';
#############################################################
$|=1;
my $percent_done;
my %buf = ();
my $main = MainWindow->new(title => "LastFM library downloader");
$main->resizable(0,0);
$main->geometry("378x230");

my $lframe = $main->LabFrame(
		-label => "Tracklist",
		-height => 130,
		-width 	=> 353,
	)->place( -x => 8, -y => 28); 
	
my $pframe = $main->LabFrame(
		-label => "Progress",
		-height => 20,
		-width 	=> 283,
	)->place( -x => 8, -y => 185); 

my $progress = $pframe->ProgressBar(
		-width => 15,
		-length => 282,
		-from => 0,
		-to => 500,
		-blocks => 25,
		-gap => 1,
		-variable => \$percent_done,
		-colors => [0, 'green'],
		)->place(-x => 1, -y => 0);

#############################################################
my @headers = ( "ID", "Artist", "Track name", "Size");

my $grid = $lframe->Scrolled(
        'HList',
        -head       => 1,
        -columns    => scalar @headers,
        -scrollbars => 0,
        -width      => 58,
        -height     => 10,
        -background => 'white',
    )->place(-x => 0, -y => 0);

for(0..scalar @headers - 1)
{
 $grid->header(
            'create',
            $_,
            -text             => $headers[$_],
            -headerbackground => 'gray',);
}

#############################################################

$main->Label( 
		-text => 'Login:',
	)->place( -x => 10, -y => 10);

$main->Label( 
		-text => 'Password:',
	)->place( -x => 145, -y => 10);
	
my $log = $main->Entry( 
		-width => 15,
	)->place( -x => 45, -y => 10);
	
my $pwd = $main->Entry( 
		-width => 15,
		-show =>'*',
	)->place( -x => 200, -y => 10);
	
$main->Button(	
			 -text => 'Get list', 
			 -command => sub {dopre($log->get, $pwd->get)},
			 )->place(-x => 327, -y => 8);	 
$main->Button(
			 -text => 'Download', 
			 -command => sub {getit($grid->selectionGet())},
			 )->place(-x => 310, -y => 200);
	 
MainLoop;
#############################################################
sub getit
{
 my $id = $_[0];
 if(defined $id && $id =~ /^\d+/)
	{
		getmp3($buf{$id});
	}
}
#############################################################
sub dopre
{
 my $session = doauth($_[0], $_[1]);
 pre($session); 
 my %list = list($session);
 my $lnum = 0;
 $grid->delete('all');	
 foreach my $key (keys %list)
		{
		 $lnum++;
		 $grid->add($lnum);
		 my ($name, $size) = split /::/, $key;
		 #print "$lnum - $name [$size kb]\n";
		 $buf{$lnum} = $list{$key}."::".$key;
		 my ($artist, $track) = split / - /, $name;
		 my @list = ($lnum, $artist, $track, $size." kb");
		 for(0..scalar @list - 1)
			{
			 $grid->itemCreate( $lnum, $_, -text => $list[$_] );
			} 
		 
		}

}
#############################################################
sub doauth
{
 my $login = $_[0];
 my $passw = $_[1];
 
 my $sock = sock("ws.audioscrobbler.com");
 my $request =
 "GET /radio/handshake.php?version=1.5.4.24567&platform=win32&platformversion=Windows%20XP&username=".$login."&passwordmd5=".md5_hex($passw)."&language=ru&player=winamp HTTP/1.1\r\n".
 "Host: ws.audioscrobbler.com\r\n\r\n";
 
 print $sock $request;
 read $sock, my $answ, 1024;

 if($answ =~ /Set-Cookie: Session=(.+?);/)
	{
	 return $1;
	}
 else
	{
	 return 0;
	}
}
#############################################################
sub sock
{
 my $sock = new IO::Socket::INET 
		(
		PeerAddr => $_[0],
   		PeerPort => 80, 
   		PeerProto => 'tcp', 
   		TimeOut => 10
		) or die "Can't connect\n";
 return $sock;
}
#############################################################
sub getmp3
{
 my ($url, $name, $size) = split /::/, $_[0];
 my $sock = sock("play.last.fm");
 my $request = 
 "GET $url HTTP/1.1\r\n".
 "Host: play.last.fm\r\n".
 "User-Agent: Last.fm Client 1.5.4.24567 (Windows)\r\n\r\n";
 
 print $sock $request;
 read $sock, my $answ, 512;
 close $sock;
 $answ =~ /Location: (.+)/s;  my $rurl = $1;
 $rurl =~ /http:\/\/(.+?)\//; my $host = $1;
 
 $sock = sock($host);
 $request = 
 "GET $rurl HTTP/1.1\r\n".
 "Host: $host\r\n".
 "User-Agent: Last.fm Client 1.5.4.24567 (Windows)\r\n\r\n";
 print $sock $request;
 $answ = undef;
 
 print "Starting download: ".$name."\n";
 my $bufsize = 2048;
 my $step = $size / 500;
 my $cnt = 0;
 
 open F, ">", $name.".mp3" || die $!; 
 binmode F;
 while(read $sock, my $buf, $bufsize)
	{
	 my $progress = ($cnt * $bufsize / 1024);
	 $percent_done = int $progress / $step;
	 $main->update;
	 $cnt ++;
	 print F $buf;
	 print "[Received: ".$progress." of ".$size." kb]\r";
	}
 print "\nDownload Complete!";
 close F;
}
#############################################################
sub pre
{
 my $session = $_[0];
 my $sock = sock("ws.audioscrobbler.com");
 my $request = 
 "GET /radio/adjust.php?session=".$session." HTTP/1.1\r\n".
 "Host: ws.audioscrobbler.com\r\n".
 "User-Agent: Last.fm Client 1.5.4.24567 (Windows)\r\n\r\n";

 print $sock $request;
 read $sock, my $answ, 512;
 close $sock;
 if($answ =~ /response=(.+?)\n(.+?)stationname=(.+)/s)
	{
	if($1 eq "OK")
		{
		print "Response: $1 ; Station: $3\n";
		}
	else
		{
		print "Response: $1 \n";
		}
	}
}
###########################################################
sub list
{
 my $session = $_[0];
 my $sock = sock("ws.audioscrobbler.com");
 my $request = 
"GET /radio/xspf.php?sk=".$session."&discovery=1&desktop=1.5.4.24567 HTTP/1.1\r\n".
"Host: ws.audioscrobbler.com\r\n".
"User-Agent: Last.fm Client 1.5.4.24567 (Windows)\r\n\r\n";
 print $sock $request;
 my $answ = undef;
 while(read $sock, my $buf, 1024)
	{
	 $answ .= $buf;
	}
 my %list = ();
 close $sock;
 while($answ =~ /<location>(.+?)<\/location>(.+?)<title>(.+?)<\/title>(.+?)<creator>(.+?)<\/creator>(.+?)<duration>(.+?)<\/duration>/sg)
	{
	 #Посмотреть точный подсчет размера (погрешность +- 50 байт)
	 my $size = ($7 / 1000) * 16 - 50;
	 $list{"$5 - $3::$size"} = $1;
	}
 return %list;
}
#############################################################