GUI в Perl (Tk)

This is a simple example of Tk module usage for GUI creation in Perl. Here is the script to download mp3 files from Last.fm (available only if you're a paid or recently registered member).
A final version of the script will look like this:

Let's start. First of all - modules import:

use strict;                     #Restricting unsafe constructions
use warnings;                   #Displaying warnings
use IO::Socket;                 #Networking
use Tk;                         #The primary Tk module
use Tk::ProgressBar;            #The progress bar module

use Tk::HList;                  #The hierarchical list module
use Tk::LabFrame;               #The frame module

use Digest::MD5 qw(md5_hex);    #The MD5 calculation module (cause we're sending a password hash to the last.fm server)
use encoding 'utf-8';           #UTF8 support (e.g. for Japanese songs :3 )

use strict; #Restricting unsafe constructions

use warnings; #Displaying warnings

use IO::Socket; #Networking

use Tk; #The primary Tk module

use Tk::ProgressBar; #The progress bar module

use Tk::HList; #The hierarchical list module

use Tk::LabFrame; #The frame module

use Digest::MD5 qw(md5_hex); #The MD5 calculation module (cause we're sending a password hash to the last.fm server)

use encoding 'utf-8'; #UTF8 support (e.g. for Japanese songs :3 )

Variables definition for further usage:

$|=1;
my $percent_done;     #A progress bar counter
my %buf = ();         #A hash for the track list

$|=1;

my $percent_done; #A progress bar counter

my %buf = (); #A hash for the track list

Now let's create a window and control elements:

#Creating a window and defining its title
my $main = MainWindow->new(title => "LastFM library downloader");

#No resize
$main->resizable(0,0);
#Window dimensions
$main->geometry("378x230");


#A frame for the track list
my $lframe = $main->LabFrame
(
	-label => "Tracklist", #A frame title

	-height => 130,        #Frame height
	-width  => 353,        #Frame width
)->place( -x => 8, -y => 28);  #Location on the main window


#A frame for the progress bar
my $pframe = $main->LabFrame
(
	-label => "Progress",

	-height => 20,
	-width 	=> 283,
)->place( -x => 8, -y => 185); 


#The progress bar object
my $progress = $pframe->ProgressBar
(
	-width => 15,

	-length => 282,
	-from => 0,                  #Progress bar minimal value

	-to => 500,                  #Maximal value
	-blocks => 25,               #Number of progress bar blocks (which it will be split to)

	-gap => 1,                   #A gap between blocks
	-variable => \$percent_done, #A pointer to the percentage storing variable

	-colors => [0, 'green'],     #Progress bar filling color
)->place(-x => 1, -y => 0);

#Creating a window and defining its title

my $main = MainWindow->new(title => "LastFM library downloader");

#No resize

$main->resizable(0,0);

#Window dimensions

$main->geometry("378x230");

#A frame for the track list

my $lframe = $main->LabFrame

(

-label => "Tracklist", #A frame title

-height => 130, #Frame height

-width => 353, #Frame width

)->place( -x => 8, -y => 28); #Location on the main window

#A frame for the progress bar

my $pframe = $main->LabFrame

(

-label => "Progress",

-height => 20,

-width => 283,

)->place( -x => 8, -y => 185);

#The progress bar object

my $progress = $pframe->ProgressBar

(

-width => 15,

-length => 282,

-from => 0, #Progress bar minimal value

-to => 500, #Maximal value

-blocks => 25, #Number of progress bar blocks (which it will be split to)

-gap => 1, #A gap between blocks

-variable => \$percent_done, #A pointer to the percentage storing variable

-colors => [0, 'green'], #Progress bar filling color

)->place(-x => 1, -y => 0);

Creating and filling a table containing tracks information:

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


#Table itself
my $grid = $lframe->Scrolled
(
	'HList',

	-head       => 1,               #Enabling columns headers
	-columns    => scalar @headers, #Number of columns

	-scrollbars => 0,               #A scrollbar is enabled
	-width      => 58,

	-height     => 10,
	-background => 'white',         #Background color

)->grid(-column => 1, -row => 0)->place(-x => 0, -y => 0);


#Placing headers to the table
for(0..scalar @headers - 1)
{
	$grid->header
	(
		'create',
		$_,                          #Index number
		-text => $headers[$_],       #A header text

		-headerbackground => 'gray', #Header background color
	);
}

#Columns headers

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

#Table itself

my $grid = $lframe->Scrolled

(

'HList',

-head => 1, #Enabling columns headers

-columns => scalar @headers, #Number of columns

-scrollbars => 0, #A scrollbar is enabled

-width => 58,

-height => 10,

-background => 'white', #Background color

)->grid(-column => 1, -row => 0)->place(-x => 0, -y => 0);

#Placing headers to the table

for(0..scalar @headers - 1)

{

$grid->header

(

'create',

$_, #Index number

-text => $headers[$_], #A header text

-headerbackground => 'gray', #Header background color

);

}

Okay, now let's place control elements, login and password input fields.

#Labels for input fields
$main->Label
(
	-text => 'Login:',
)->place( -x => 10, -y => 10);


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


#Login input field
my $log = $main->Entry
(
	-width => 15,
)->place( -x => 45, -y => 10);


#A password input field
my $pwd = $main->Entry
(
	-width => 15,

	-show =>'*', #A password masking symbol
)->place( -x => 200, -y => 10);


#A button for track list retrieving
$main->Button
(
	-text => 'Get list',                           #Text on the button

	-command => sub {dopre($log->get, $pwd->get)}, #Onclick function

	#Data from login, password input fields is transferred to 'dopre' function
)->place(-x => 327, -y => 8);


#Button to download a track
$main->Button
(
	-text => 'Download', #Text on the button

	-command => sub {getit($grid->selectionGet())},
	#Index number of the selected element is transferred to the 'getit' function
)->place(-x => 310, -y => 200);

MainLoop;

#Labels for input fields

$main->Label

(

-text => 'Login:',

)->place( -x => 10, -y => 10);

$main->Label

(

-text => 'Password:',

)->place( -x => 145, -y => 10);

#Login input field

my $log = $main->Entry

(

-width => 15,

)->place( -x => 45, -y => 10);

#A password input field

my $pwd = $main->Entry

(

-width => 15,

-show =>'*', #A password masking symbol

)->place( -x => 200, -y => 10);

#A button for track list retrieving

$main->Button

(

-text => 'Get list', #Text on the button

-command => sub {dopre($log->get, $pwd->get)}, #Onclick function

#Data from login, password input fields is transferred to 'dopre' function

)->place(-x => 327, -y => 8);

#Button to download a track

$main->Button

(

-text => 'Download', #Text on the button

-command => sub {getit($grid->selectionGet())},

#Index number of the selected element is transferred to the 'getit' function

)->place(-x => 310, -y => 200);

MainLoop;

Functions used in the program:

#Generally this function can be merged with the 'getmp3' function, but who cares ^_^
sub getit
{
	my $id = $_[0];                  #Assign the first parameter passed to the function to the $id variable

	if(defined $id && $id =~ /^\d+/) #Check existence and validate the obtained value
	{
		#It's probably better to use fork()...
		getmp3($buf{$id});       #Passing the selected item from an associative array to the 'getmp3' function
	}
}

#The table tracks filling function

sub dopre
{
	my $session = doauth($_[0], $_[1]); #Login-password authorization to obtain a session value for further usage

	pre($session); #
	my %list = list($session);        #Get a list of tracks

	my $lnum = 0;                     #The variable for numbering rows in the table
	$grid->delete('all');             #Clear the table

	foreach my $key (keys %list)      #Loop through items in the list
	{
		$lnum++;

		$grid->add($lnum);                                #Add a string with the $lnum identifier
		my ($name, $size) = split /::/, $key;             #Dividing the track id and it's size

		#print "$lnum - $name [$size kb]\n";
		$buf{$lnum} = $list{$key}."::".$key;              #Placing parameters to the hash

		my ($artist, $track) = split / - /, $name;        #Dividing the track id to an artist and a track title

		my @list = ($lnum, $artist, $track, $size." kb"); #Creating an array for further usage

		for(0..scalar @list - 1)
		{
			$grid->itemCreate( $lnum, $_, -text => $list[$_] ); #Adding elements to the table
		} 

	}
}

#The Last.fm authorization function
sub doauth
{
	my $login = $_[0];

	my $passw = $_[1];

	my $sock = sock("ws.audioscrobbler.com"); #Connecting to 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";    #Forming the necessary request
	
	print $sock $request;                     #Making the necessary request

	read $sock, my $answ, 1024;               #Reading a part of the server answer
	

	if($answ =~ /Set-Cookie: Session=(.+?);/) #Parsing the session id
	{
		return $1;                        #Returning the session id from the subroutine
	}
	else
	{
		return 0;
	}
}


#The function to connect to the server
sub sock
{
	my $sock = new IO::Socket::INET

	(
		PeerAddr => $_[0], #The server address
   		PeerPort => 80, #The server port

   		PeerProto => 'tcp', #The protocol type
   		TimeOut => 10, 	#The connection timeout

   		) or die "Can't connect\n";
	return $sock;
}


#The function to download an mp3 file from the server
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; #Parsing the response to get an mp3 download url

	$rurl =~ /http:\/\/(.+?)\//; my $host = $1; #Parsing the response to get a server url

	
	$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;                  #Number of bytes read in a time from a socket
	my $step = $size / 500;              #The progress bar step size

	my $cnt = 0;                         #The variable to control the download progress
	
	open F, ">", $name.".mp3" || die $!; #Open a file

	binmode F;                           #Switching to the binary mode
	while(read $sock, my $buf, $bufsize) #Reading from socket
	{
		my $progress = ($cnt * $bufsize / 1024);

		$percent_done = int $progress / $step; #Calculating the progress bar filling percentage
		$main->update;                         #Refreshing the main window

		$cnt++;
		print F $buf;                          #Writing received data to the file
		print "[Received: ".$progress." of ".$size." kb]\r";

	}

	print "\nDownload Complete!";
	close F;
}


#The function to check availability of the service
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";

		}
	}
}

#The function to get a list of tracks
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;
	}
	close $sock;

	my %list = ();
	#URL, track name, singer ang length parsing
	while($answ =~ /(.+?)<\/location>(.+?)(.+?)<\/title>(.+?)(.+?)<\/creator>(.+?)(.+?)<\/duration>/sg)
	{
		#Approximate size calculation (an inaccurate result)
		my $size = ($7 / 1000) * 16 - 50;

		$list{"$5 - $3::$size"} = $1;
	}

	return %list;
}

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

#Generally this function can be merged with the 'getmp3' function, but who cares ^_^

sub getit

{

my $id = $_[0]; #Assign the first parameter passed to the function to the $id variable

if(defined $id && $id =~ /^\d+/) #Check existence and validate the obtained value

{

#It's probably better to use fork()...

getmp3($buf{$id}); #Passing the selected item from an associative array to the 'getmp3' function

}

#The table tracks filling function

sub dopre

{

my $session = doauth($_[0], $_[1]); #Login-password authorization to obtain a session value for further usage

pre($session); #

my %list = list($session); #Get a list of tracks

my $lnum = 0; #The variable for numbering rows in the table

$grid->delete('all'); #Clear the table

foreach my $key (keys %list) #Loop through items in the list

{

$lnum++;

$grid->add($lnum); #Add a string with the $lnum identifier

my ($name, $size) = split /::/, $key; #Dividing the track id and it's size

#print "$lnum - $name [$size kb]\n";

$buf{$lnum} = $list{$key}."::".$key; #Placing parameters to the hash

my ($artist, $track) = split / - /, $name; #Dividing the track id to an artist and a track title

my @list = ($lnum, $artist, $track, $size." kb"); #Creating an array for further usage

for(0..scalar @list - 1)

{

$grid->itemCreate( $lnum, $_, -text => $list[$_] ); #Adding elements to the table

}

#The Last.fm authorization function

sub doauth

{

my $login = $_[0];

my $passw = $_[1];

my $sock = sock("ws.audioscrobbler.com"); #Connecting to 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"; #Forming the necessary request

print $sock $request; #Making the necessary request

read $sock, my $answ, 1024; #Reading a part of the server answer

if($answ =~ /Set-Cookie: Session=(.+?);/) #Parsing the session id

{

return $1; #Returning the session id from the subroutine

}

else

{

return 0;

}

#The function to connect to the server

sub sock

{

my $sock = new IO::Socket::INET

(

PeerAddr => $_[0], #The server address

PeerPort => 80, #The server port

PeerProto => 'tcp', #The protocol type

TimeOut => 10, #The connection timeout

) or die "Can't connect\n";

return $sock;

}

#The function to download an mp3 file from the server

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; #Parsing the response to get an mp3 download url

$rurl =~ /http:\/\/(.+?)\//; my $host = $1; #Parsing the response to get a server url

$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; #Number of bytes read in a time from a socket

my $step = $size / 500; #The progress bar step size

my $cnt = 0; #The variable to control the download progress

open F, ">", $name.".mp3" || die $!; #Open a file

binmode F; #Switching to the binary mode

while(read $sock, my $buf, $bufsize) #Reading from socket

{

my $progress = ($cnt * $bufsize / 1024);

$percent_done = int $progress / $step; #Calculating the progress bar filling percentage

$main->update; #Refreshing the main window

$cnt++;

print F $buf; #Writing received data to the file

print "[Received: ".$progress." of ".$size." kb]\r";

}

print "\nDownload Complete!";

close F;

}

#The function to check availability of the service

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";

}

#The function to get a list of tracks

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;

}

close $sock;

my %list = ();

#URL, track name, singer ang length parsing

while($answ =~ /(.+?)<\/location>(.+?)(.+?)<\/title>(.+?)(.+?)<\/creator>(.+?)(.+?)<\/duration>/sg)

{

#Approximate size calculation (an inaccurate result)

my $size = ($7 / 1000) * 16 - 50;

$list{"$5 - $3::$size"} = $1;

}

return %list;

}

You can download the source code: here
P.S. This code is far from perfect

Leave a Reply Cancel reply