Adding WebSocket (ws) URI

Author: david-dick

dist.ini

@@ -142,6 +142,7 @@ stopword = Miyagawa
 stopword = OIDs
 stopword = OpenLDAP
 stopword = Punycode
+stopword = WebSocket
 stopword = relativize
 stopword = Tatsuhiko
 stopword = TCP

lib/URI.pm

@@ -1223,6 +1223,18 @@ separated by dots.  A C<URI> object belonging to this namespace has an
 additional method called $uri->oid that can be used to get/set the oid
 value.  In a list context, oid numbers are returned as separate elements.
 
+=item B<ws>:
+
+The <ws> URI scheme is specified in L<RFC 6455|http://tools.ietf.org/html/rfc6455>.
+The C<WebSocket> Protocol enables two-way communication between a client
+running untrusted code in a controlled environment to a remote host
+that has opted-in to communications from that code.
+
+=item B<wss>:
+
+The I<wss> URI scheme is specified in L<RFC 6455|http://tools.ietf.org/html/rfc6455> as well.
+The scheme is used to reference C<WebSocket> servers through SSL connections.
+
 =back
 
 =head1 CONFIGURATION VARIABLES

lib/URI/ws.pm

@@ -0,0 +1,71 @@
+package URI::ws;
+
+use strict;
+use warnings;
+
+our $VERSION = '5.33';
+
+use parent 'URI::http';
+
+1;
+__END__
+
+=head1 NAME
+
+URI::ws - URI scheme for WebSocket Identifiers
+
+=head1 VERSION
+
+Version 5.20
+
+=head1 SYNOPSIS
+
+    use URI::ws;
+
+    my $uri = URI->new('ws://example.com/');
+
+=head1 DESCRIPTION
+
+This module implements the C<ws:> URI scheme defined in L<RFC 6455|http://tools.ietf.org/html/rfc6455>.
+
+=head1 SUBROUTINES/METHODS
+
+This module inherits the behaviour of L<URI::http|URI::http>.
+
+=head1 DIAGNOSTICS
+
+See L<URI|URI>
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+See L<URI|URI#CONFIGURATION-VARIABLES> and L<URI|URI#ENVIRONMENT-VARIABLES>
+
+=head1 DEPENDENCIES
+
+None
+
+=head1 INCOMPATIBILITIES
+
+None reported
+
+=head1 BUGS AND LIMITATIONS
+
+See L<URI|URI#BUGS>
+
+=head1 SEE ALSO
+
+L<RFC 3507|http://tools.ietf.org/html/rfc3507>
+
+=head1 AUTHOR
+
+David Dick, C<< <ddick at cpan.org> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2016 David Dick.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See L<http://dev.perl.org/licenses/> for more information.

lib/URI/wss.pm

@@ -0,0 +1,71 @@
+package URI::wss;
+
+use strict;
+use warnings;
+
+our $VERSION = '5.33';
+
+use parent 'URI::https';
+
+1;
+__END__
+
+=head1 NAME
+
+URI::wss - URI scheme for WebSocket Identifiers
+
+=head1 VERSION
+
+Version 5.20
+
+=head1 SYNOPSIS
+
+    use URI::wss;
+
+    my $uri = URI->new('wss://example.com/');
+
+=head1 DESCRIPTION
+
+This module implements the C<wss:> URI scheme defined in L<RFC 6455|http://tools.ietf.org/html/rfc6455>.
+
+=head1 SUBROUTINES/METHODS
+
+This module inherits the behaviour of L<URI::https|URI::https>.
+
+=head1 DIAGNOSTICS
+
+See L<URI|URI>
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+See L<URI|URI#CONFIGURATION-VARIABLES> and L<URI|URI#ENVIRONMENT-VARIABLES>
+
+=head1 DEPENDENCIES
+
+None
+
+=head1 INCOMPATIBILITIES
+
+None reported
+
+=head1 BUGS AND LIMITATIONS
+
+See L<URI|URI#BUGS>
+
+=head1 SEE ALSO
+
+L<RFC 3507|http://tools.ietf.org/html/rfc3507>
+
+=head1 AUTHOR
+
+David Dick, C<< <ddick at cpan.org> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2016 David Dick.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See L<http://dev.perl.org/licenses/> for more information.

t/ws.t

@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+
+use URI ();
+
+my $u = URI->new("<ws://www.example.com/path?q=fôo>");
+
+#print "$u\n";
+is($u, "ws://www.example.com/path?q=f%F4o");
+
+is($u->port, 80);
+
+# play with port
+my $old = $u->port(8080);
+ok($old == 80 && $u eq "ws://www.example.com:8080/path?q=f%F4o");
+
+$u->port(80);
+is($u, "ws://www.example.com:80/path?q=f%F4o");
+
+$u->port("");
+ok($u eq "ws://www.example.com:/path?q=f%F4o" && $u->port == 80);
+
+$u->port(undef);
+is($u, "ws://www.example.com/path?q=f%F4o");
+
+my @q = $u->query_form;
+is_deeply(\@q, ["q", "fôo"]);
+
+$u->query_form(foo => "bar", bar => "baz");
+is($u->query, "foo=bar&bar=baz");
+
+is($u->host, "www.example.com");
+
+is($u->path, "/path");
+
+ok(!$u->secure);
+
+$u->scheme("wss");
+is($u->port, 443);
+
+is($u, "wss://www.example.com/path?foo=bar&bar=baz");
+
+ok($u->secure);
+
+$u = URI->new("ws://%65%78%61%6d%70%6c%65%2e%63%6f%6d/%70%75%62/%61/%32%30%30%31/%30%38/%32%37/%62%6a%6f%72%6e%73%74%61%64%2e%68%74%6d%6c");
+is($u->canonical, "ws://example.com/pub/a/2001/08/27/bjornstad.html");
+
+ok($u->has_recognized_scheme);