line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POE::Component::Client::AirTunes; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
267600
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
709
|
|
4
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
13
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
170
|
|
7
|
2
|
|
|
2
|
|
901
|
use POE; |
|
2
|
|
|
|
|
62308
|
|
|
2
|
|
|
|
|
19
|
|
8
|
2
|
|
|
2
|
|
113625
|
use POE qw( Wheel::Run Filter::Line ); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
10
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
11
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
12
|
0
|
0
|
|
|
|
|
croak "Usage: POE::Component::Client::AirTunes->new(\%param)" if @_ & 1; |
13
|
0
|
|
|
|
|
|
my %param = @_; |
14
|
|
|
|
|
|
|
|
15
|
0
|
|
|
|
|
|
my $self = bless \%param, $class; |
16
|
0
|
0
|
|
|
|
|
$self->{host} or croak "host parameter is missing"; |
17
|
0
|
|
0
|
|
|
|
$self->{alias} ||= 'airtunes'; |
18
|
0
|
|
0
|
|
|
|
$self->{parent} ||= 'main'; |
19
|
0
|
|
0
|
|
|
|
$self->{events} ||= {}; |
20
|
|
|
|
|
|
|
|
21
|
0
|
|
|
|
|
|
my $session = POE::Session->create( |
22
|
|
|
|
|
|
|
object_states => [ |
23
|
0
|
|
|
|
|
|
$self => { (map { $_ => 'request' } qw(play pause stop quit volume)) }, |
24
|
|
|
|
|
|
|
$self => [ qw(_start _stop wheel_close wheel_err wheel_out wheel_stderr ) ], |
25
|
|
|
|
|
|
|
], |
26
|
|
|
|
|
|
|
); |
27
|
0
|
|
|
|
|
|
$self->{session_id} = $session->ID; |
28
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
$self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub _start { |
33
|
0
|
|
|
0
|
|
|
my($kernel, $self) = @_[KERNEL, OBJECT]; |
34
|
|
|
|
|
|
|
|
35
|
0
|
0
|
|
|
|
|
if ($self->{alias}) { |
36
|
0
|
|
|
|
|
|
$kernel->alias_set($self->{alias}); |
37
|
|
|
|
|
|
|
} else { |
38
|
0
|
|
|
|
|
|
$kernel->refcount_increment($self->{session_id} => __PACKAGE__); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
|
$self->{wheel} = POE::Wheel::Run->new( |
42
|
|
|
|
|
|
|
Program => [ 'raop_play', '-i', $self->{host} ], |
43
|
|
|
|
|
|
|
StdioFilter => POE::Filter::Line->new(), |
44
|
|
|
|
|
|
|
StdoutEvent => 'wheel_out', |
45
|
|
|
|
|
|
|
StderrEvent => 'wheel_stderr', |
46
|
|
|
|
|
|
|
ErrorEvent => 'wheel_err', |
47
|
|
|
|
|
|
|
CloseEvent => 'wheel_close', |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
0
|
|
|
sub _stop { delete $_[OBJECT]->{wheel} } |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub request { |
54
|
0
|
|
|
0
|
0
|
|
my($kernel, $self, $state, $sender) = @_[KERNEL, OBJECT, STATE, SENDER]; |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
my $cmd = $state; |
57
|
0
|
0
|
|
|
|
|
$cmd .= " $_[ARG0]" if defined $_[ARG0]; |
58
|
0
|
0
|
|
|
|
|
warn "command $cmd\n" if $self->{debug}; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
|
$self->{wheel}->put($cmd); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub wheel_out { |
64
|
0
|
|
|
0
|
0
|
|
my($kernel, $self, $input) = @_[KERNEL,OBJECT,ARG0]; |
65
|
0
|
0
|
|
|
|
|
warn "OUT: $input\n" if $self->{debug}; |
66
|
0
|
0
|
|
|
|
|
if ($input eq 'connected') { |
|
|
0
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$self->post_parent('connected'); |
68
|
|
|
|
|
|
|
} elsif ($input eq 'done') { |
69
|
0
|
|
|
|
|
|
$self->post_parent('done'); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub wheel_stderr { |
74
|
0
|
|
|
0
|
0
|
|
my($kernel, $self, $input) = @_[KERNEL,OBJECT,ARG0]; |
75
|
0
|
0
|
|
|
|
|
warn "ERR: $input\n" if $self->{debug}; |
76
|
|
|
|
|
|
|
|
77
|
0
|
0
|
|
|
|
|
if ($input =~ /^DBG: Audio-Jack-Status: ((?:dis)?connected)(?:; type=(analog|digital))?/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
$self->{audio_jack}->{status} = $1; |
79
|
0
|
0
|
|
|
|
|
$self->{audio_jack}->{type} = $2 if $2; |
80
|
|
|
|
|
|
|
} elsif ($input =~ /ERR: exec_request: request failed, error 453/) { |
81
|
0
|
|
|
|
|
|
$self->post_parent('error' => 'Somebody is using this AirTunes speaker.'); |
82
|
|
|
|
|
|
|
} elsif ($input =~ /ERR: error:get_tcp_nconnect addr=/) { |
83
|
0
|
|
|
|
|
|
$self->post_parent('error' => 'TCP/IP connection failure.'); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub wheel_err { |
88
|
0
|
0
|
|
0
|
0
|
|
warn "Wheel $_[ARG3] generated $_[ARG0] error $_[ARG1]: $_[ARG2]\n" |
89
|
|
|
|
|
|
|
if $_[OBJECT]->{debug}; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
0
|
0
|
|
sub wheel_close { } |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub post_parent { |
95
|
0
|
|
|
0
|
0
|
|
my($self, $event, @args) = @_; |
96
|
0
|
|
|
|
|
|
$poe_kernel->post($self->{parent}, $event, @args); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
0
|
0
|
|
sub session_id { $_[0]->{session_id} } |
100
|
0
|
|
|
0
|
0
|
|
sub audio_jack { $_[0]->{audio_jack} } |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
1; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
__END__ |