view release on metacpan or  search on metacpan

lib/Acme/UPnP.pm  view on Meta::CPAN

    method _emit ( $event, @args ) {
        for my $cb ( $on{$event}->@* ) {
            try { $cb->(@args) } catch ($e) {
                carp 'Acme::UPnP callback error: ' . $e;
            }
        }
    }
    ADJUST {
        $http = HTTP::Tiny->new( agent => 'Acme-UPnP/1.0', timeout => 3 );
        $upnp_device = bless {}, 'Acme::UPnP::Device';    # Dummy
    }

    method discover_device () {

        # SSDP Search
        my $sock = IO::Socket::INET->new( Proto => 'udp', Broadcast => 1, LocalPort => 0, ) or
            do { carp 'Failed to create UDP socket: ' . $!; return 0 };
        my $msg = join "\r\n", 'M-SEARCH * HTTP/1.1', 'HOST: 239.255.255.250:1900', 'MAN: "ssdp:discover"', 'MX: 2',
            'ST: urn:schemas-upnp-org:device:InternetGatewayDevice:1', '';
        $sock->send( $msg, 0, pack_sockaddr_in( 1900, inet_aton('239.255.255.250') ) );

t/basics.t  view on Meta::CPAN

# Mock Socket and HTTP::Tiny
my $socket_recv_data;
my $http_content;

BEGIN {
    *CORE::GLOBAL::select = sub { return 1 }
}
no warnings qw[experimental::class redefine once];
#
*IO::Socket::INET::new = sub { return bless {}, 'MockSocket' };

package MockSocket {
    sub send       {1}
    sub fileno     {1}
    sub sockdomain {2}
    sub sockhost   {'127.0.0.1'}
    sub mcast_add  {1}

    sub recv {
        return unless $main::socket_recv_data;
        $_[1] = $main::socket_recv_data;
        $main::socket_recv_data = undef;
        return "fake_addr";
    }
};
*HTTP::Tiny::new = sub { return bless {}, 'MockHTTP' };

package MockHTTP {

    sub get {
        my ( $self, $url ) = @_;
        if ( $url eq 'http://192.168.1.1:5000/desc.xml' ) {
            return { success => 1, content => $main::http_content };
        }
        return { success => 0 };
    }