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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by joko, Tue Mar 8 16:00:57 2005 UTC revision 1.2 by joko, Tue Mar 8 20:53:46 2005 UTC
# Line 8  use IO::Socket; Line 8  use IO::Socket;
8  use Data::Dumper;  use Data::Dumper;
9    
10  our @ISA = qw( Exporter );  our @ISA = qw( Exporter );
11  our @EXPORT = qw( gd_connect gd_disconnect gd_command );  our @EXPORT = qw( gd_connect gd_disconnect gd_command lcddi_parse_response );
12    
13    my $DEBUG = 0;
14    
15  my $sock;  my $sock;
16    
# Line 30  sub gd_disconnect { Line 31  sub gd_disconnect {
31    
32  sub gd_command {  sub gd_command {
33    my $cmd = shift;    my $cmd = shift;
34    my @args = @_;    my $args = shift;
35      my $read_response = shift;
36    $sock->send(join("\t", $cmd, @args) . "\n");    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  #my $data;  sub gd_read_response {
50  #$sock->read(1024,$data) until $sock->atmark;    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  ###############################################################################  ###############################################################################
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed