view release on metacpan or  search on metacpan

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

use v5.40;
use feature 'class';
no warnings 'experimental::class';
#
class Acme::UPnP v1.0.0 {
    use Carp qw[carp croak];
    use IO::Socket::INET;
    use HTTP::Tiny;
    use Time::HiRes qw[time];
    use Socket      qw[inet_aton pack_sockaddr_in];
    #
    field $control_url;
    field $service_type;
    field %on;
    field $http;
    field $upnp_available : reader(is_available) = 1;
    field $upnp_device : reader;    # For compatibility, just holds a dummy object or undef

    #
    method on ( $event, $cb ) { push $on{$event}->@*, $cb }

    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') ) );
        my $rin = '';
        vec( $rin, $sock->fileno, 1 ) = 1;
        my $rout;
        my $found_location;
        my $end_time = time + 2.5;

        while ( time < $end_time ) {
            my $left = $end_time - time;
            last if $left <= 0;
            if ( select( $rout = $rin, undef, undef, $left ) ) {
                my $data;
                my $addr = $sock->recv( $data, 4096 );
                if ( defined $data && $data =~ /Location:\s*(https?:\/\/[^\s\r\n]+)/i ) {
                    $found_location = $1;
                    last;
                }
            }
            else {
                last;
            }
        }
        unless ($found_location) {
            $self->_emit('device_not_found');
            return 0;
        }

        # Fetch Description
        my $res = $http->get($found_location);
        unless ( $res->{success} ) {
            $self->_emit( device_not_found => 'Failed to fetch description' );
            return 0;
        }
        my $content = $res->{content};

        # Parse for Service
        my $svc_type;
        my $ctrl_url;

        # Simple regex extraction
        while ( $content =~ m[<service>(.*?)</service>]sg ) {
            my $svc_block = $1;
            if ( $svc_block =~ m[<serviceType>(urn:schemas-upnp-org:service:WAN(?:IP|PPP)Connection:1)</serviceType>]s ) {
                $svc_type = $1;
                if ( $svc_block =~ m[<controlURL>(.*?)</controlURL>]s ) {
                    $ctrl_url = $1;
                    last;
                }
            }
        }
        unless ($ctrl_url) {