view release on metacpan or  search on metacpan

t/URI-AnyService.t  view on Meta::CPAN

    is $u->path, '/home/user',         'Initial path';

    $u->host('new.example.com');
    is $u->host, 'new.example.com', 'Host changed';

    $u->path('/new/path');
    is $u->path, '/new/path', 'Path changed';

    is "$u", 'ssh://new.example.com/new/path', 'Full URI updated';
};

subtest 'Case-Insensitive Scheme Handling' => sub {
    # Test uppercase scheme acceptance (URI module normalizes scheme to lowercase only)
    my $u = URI::AnyService->new('FTP://FTP.EXAMPLE.COM/PATH');
    isa_ok $u, ['URI::AnyService'], 'Uppercase scheme creates valid object';
    is $u->scheme,       'ftp',             'URI module normalizes scheme to lowercase';
    is $u->host,         'FTP.EXAMPLE.COM', 'Host case preserved (not normalized by URI)';
    is $u->default_port, 21,                'Default port lookup works with uppercase scheme';

    # Test mixed case
    my $u2 = URI::AnyService->new('SmTp://mail.example.com/test');
    is $u2->scheme,       'smtp', 'Mixed case scheme normalized to lowercase by URI module';
    is $u2->default_port, 25,     'Mixed case scheme port lookup works';

    # Verify string representation preserves original case from input
    like "$u", qr/^FTP:/,              'String representation preserves original scheme case from input';
    like "$u", qr/FTP\.EXAMPLE\.COM/, 'And preserves original host case';
};

subtest 'Stringification and Canonical Form' => sub {
    # Test basic string representation
    my $u = URI::AnyService->new('smtp://mail.example.com/path');
    is "$u", 'smtp://mail.example.com/path', 'Basic string representation';

    # Test with encoded characters
    my $u2 = URI::AnyService->new('smtp://mail.example.com/path with spaces');
    like "$u2", qr/path%20with%20spaces/, 'Spaces encoded in path';

    # Test with query parameters
    my $u3 = URI::AnyService->new('ftp://ftp.example.com/file?type=binary');
    like "$u3", qr/\?type=binary/, 'Query parameters preserved';
};

# NOTE: This is mostly to test compatibility/changes from the parent base modules.
subtest 'Other misc URI::_* method tests' => sub {
    my $full_url = 'https://user@www.example.com/path?query=value#fragment';
    my $uri = URI::AnyService->new($full_url);

    my @tests = (
        # Base URI methods
        scheme    => 'https',
        has_recognized_scheme => !!1,
        opaque    => '//user@www.example.com/path?query=value',
        fragment  => 'fragment',
        as_string => $full_url,
        TO_JSON   => $full_url,

        # _query methods
        query           => 'query=value',
        query_form      => [qw< query value >],
        query_keywords  => undef,
        query_param     => [qw< query >],
        query_form_hash => { query => 'value' },

        # _generic methods
        authority     => 'user@www.example.com',
        path          => '/path',
        path_query    => '/path?query=value',
        path_segments => ['', 'path'],
        # XXX: I have no idea why they called these methods reserved function names...
        #abs          => 'https://user@www.example.com/path',
        #rel          => 'path',

        # _server methods
        host      => 'www.example.com',
        ihost     => 'www.example.com',
        port      => 443,
        host_port => 'www.example.com:443',
        # NOTE: Not using URI::_login as a base class, so user/password isn't available
        userinfo  => 'user',
        as_iri    => $full_url,
        canonical => $full_url,
    );

    foreach my $pair (pairs @tests) {
        my ($method, $value) = @$pair;
        is(
            ( ref $value eq 'ARRAY' ? [ $uri->$method ] : $uri->$method ),
            $value,
            "\$uri->$method returns correct value",
        );
    }
};

subtest 'SERVICE_PORTS Hash Population' => sub {
    ok exists $URI::AnyService::SERVICE_PORTS{smtp}, 'SMTP service loaded';
    ok exists $URI::AnyService::SERVICE_PORTS{http}, 'HTTP service loaded';
    ok exists $URI::AnyService::SERVICE_PORTS{ftp},  'FTP service loaded';

    is $URI::AnyService::SERVICE_PORTS{smtp},  25,  'SMTP port correct';
    is $URI::AnyService::SERVICE_PORTS{http},  80,  'HTTP port correct';
    is $URI::AnyService::SERVICE_PORTS{ftp},   21,  'FTP port correct';
    is $URI::AnyService::SERVICE_PORTS{ssh},   22,  'SSH port correct';
    is $URI::AnyService::SERVICE_PORTS{https}, 443, 'HTTPS port correct';
};

done_testing;