/[cvs]/nfo/perl/scripts/giantdisc/bin/gdclient.pm
ViewVC logotype

Contents of /nfo/perl/scripts/giantdisc/bin/gdclient.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Tue Mar 8 20:53:46 2005 UTC (19 years, 4 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +88 -7 lines
preliminary working version

1 package gdclient;
2
3 use strict;
4 use warnings;
5
6 require Exporter;
7 use IO::Socket;
8 use Data::Dumper;
9
10 our @ISA = qw( Exporter );
11 our @EXPORT = qw( gd_connect gd_disconnect gd_command lcddi_parse_response );
12
13 my $DEBUG = 0;
14
15 my $sock;
16
17 sub gd_connect {
18 my $host = shift;
19 my $port = shift;
20
21 $host ||= `hostname -i`;
22 $port ||= 26468;
23 $sock = IO::Socket::INET->new(PeerAddr => $host,
24 PeerPort => $port,
25 Proto => 'tcp') or die($@);
26 }
27
28 sub gd_disconnect {
29 $sock->close();
30 }
31
32 sub gd_command {
33 my $cmd = shift;
34 my $args = shift;
35 my $read_response = shift;
36 my @args;
37 if ($args) { @args = @$args; }
38
39 my $command = join("\t", $cmd, @args);
40 print "command: '", $command, "'\n" if $DEBUG;
41 if ($sock->send($command . "\n")) {
42 if ($read_response) {
43 #print "read-response", "\n" if $DEBUG;
44 return gd_read_response();
45 }
46 }
47 }
48
49 sub gd_read_response {
50 my $buffer;
51
52 my $char = '';
53 my $doread = 1;
54 while ($doread) {
55 my $newchar;
56 $doread = $sock->read($newchar, 1);
57
58 # terminate socket if buffer is empty and one newline has arrived
59 last if (!$buffer && $newchar eq "\n");
60
61 # terminate socket read when two consecutive newlines have arrived
62 last if (!$doread || ($newchar eq $char and $char eq "\n"));
63
64 $char = $newchar;
65 $buffer .= $char;
66 }
67
68 chomp($buffer) if $buffer;
69 return $buffer;
70 }
71
72
73 =pod example payload:
74 my $payload = [
75 'Guano Apes',
76 'Open Your Eyes',
77 '',
78 '',
79 '',
80 '',
81 '0',
82 '0',
83 '189',
84 '0',
85 '1e0c1f12',
86 '1',
87 '',
88 '0',
89 '0',
90 '',
91 '',
92 'mp3 192'
93 ];
94
95 =pod field definition:
96 $columns = [qw( artist title genre1 genre2 year lang type rating length source sourceid tracknb audiofile condition voladjust created id bitrate )];
97
98 =cut
99
100
101 sub lcddi_parse_response {
102 my $payload = shift;
103 my @lines = split("\n", $payload);
104
105 # prepare album metadata
106 my $label = shift(@lines);
107 $label =~ s/\r//g;
108 my @title = split("\t", $label);
109
110 my $data = { 'artist' => $title[0], 'album' => $title[1], 'cddb_id' => $title[2], 'tracks' => [] };
111 foreach my $line (@lines) {
112 chomp($line);
113 #print $line, "\n";
114 my @entry = split("\t", $line);
115 splice(@entry, -3, 1);
116 push(@{$data->{'tracks'}}, \@entry);
117 }
118
119 return $data;
120 }
121
122
123 ###############################################################################
124 1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed