view release on metacpan or  search on metacpan

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

                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) {
            $self->_emit( device_not_found => "No valid WANIP/PPP service" );
            return 0;
        }

        # Handle URL resolution
        if ( $ctrl_url !~ /^http/ ) {
            if ( $ctrl_url =~ m{^/} ) {
                if ( $found_location =~ m[^(https?:\/\/[^\/]+)] ) {
                    $ctrl_url = $1 . $ctrl_url;
                }
            }