File Coverage

blib/lib/Metabrik/Network/Ssdp.pm
Criterion Covered Total %
statement 9 30 30.0
branch 0 8 0.0
condition 0 6 0.0
subroutine 3 5 60.0
pod 1 2 50.0
total 13 51 25.4


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # network::ssdp brik
5             #
6             package Metabrik::Network::Ssdp;
7 1     1   675 use strict;
  1         3  
  1         33  
8 1     1   5 use warnings;
  1         2  
  1         30  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         397  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(experimental) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             device => [ qw(device) ],
20             },
21             commands => {
22             discover => [ qw(device|OPTIONAL) ],
23             },
24             require_modules => {
25             'IO::Socket::Multicast' => [ ],
26             },
27             };
28             }
29              
30             sub discover {
31 0     0 0   my $self = shift;
32 0           my ($device) = @_;
33              
34 0   0       $device ||= $self->device;
35 0 0         $self->brik_help_run_undef_arg('discover', $device) or return;
36              
37 0           my $ssdpAddr = '239.255.255.250';
38 0           my $ssdpPort = 1900;
39              
40 0 0         my $m = IO::Socket::Multicast->new(
41             Proto => 'udp',
42             #LocalPort => 1900,
43             PeerDest => $ssdpAddr,
44             PeerPort => $ssdpPort,
45             ReuseAddr => 1,
46             ) or return $self->log->error("multicast: $!");
47 0           $m->mcast_if($device);
48              
49 0           my $ssdpSearch =
50             "M-SEARCH * HTTP/1.1\r\n".
51             "Host: $ssdpAddr:$ssdpPort\r\n".
52             "Man: \"ssdp:discover\"\r\n".
53             "ST: upnp:rootdevice\r\n".
54             "MX: 3\r\n".
55             "\r\n".
56             "";
57              
58             # XXX: use IO::Select to handle timeout
59              
60 0           my $data;
61 0           for (1..3) {
62 0 0         $m->mcast_send($ssdpSearch, "$ssdpAddr:$ssdpPort") or $self->log->error("mcast_send: $!");
63 0           print "[+] Request sent\n";
64 0           $m->recv($data, 1024);
65 0 0 0       if ($data && length($data)) {
66 0           print "[+] Answer received\n";
67 0           last;
68             }
69 0           sleep(1);
70             }
71              
72 0           print $data;
73              
74 0           return $data;
75             }
76              
77             1;
78              
79             __END__