Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add $uri->secure() method.

  • Loading branch information...
commit 445ec21b3801a3e1c5b9e8fee7117740378c0f81 1 parent 6a21081
Ville Skyttä scop authored
7 URI.pm
View
@@ -321,6 +321,8 @@ sub eq {
sub abs { $_[0]; }
sub rel { $_[0]; }
+sub secure { 0 }
+
# help out Storable
sub STORABLE_freeze {
my($self, $cloning) = @_;
@@ -569,6 +571,11 @@ Returns a relative URI reference if it is possible to
make one that denotes the same resource relative to $base_uri.
If not, then $uri is simply returned.
+=item $uri->secure
+
+Returns a TRUE value if the URI is considered to point to a resource on
+a secure channel, such as an SSL or TLS encrypted one.
+
=back
=head1 GENERIC METHODS
2  URI/https.pm
View
@@ -4,4 +4,6 @@ require URI::http;
sub default_port { 443 }
+sub secure { 1 }
+
1;
2  URI/ldaps.pm
View
@@ -4,4 +4,6 @@ require URI::ldap;
sub default_port { 636 }
+sub secure { 1 }
+
1;
2  URI/sips.pm
View
@@ -4,4 +4,6 @@ require URI::sip;
sub default_port { 5061 }
+sub secure { 1 }
+
1;
2  URI/snews.pm
View
@@ -5,4 +5,6 @@ require URI::news;
sub default_port { 563 }
+sub secure { 1 }
+
1;
2  URI/ssh.pm
View
@@ -6,4 +6,6 @@ require URI::_login;
sub default_port { 22 }
+sub secure { 1 }
+
1;
14 t/http.t
View
@@ -1,6 +1,6 @@
#!perl -w
-print "1..13\n";
+print "1..15\n";
use URI;
@@ -44,14 +44,20 @@ print "ok 9\n";
print "not " unless $u->path eq "/path";
print "ok 10\n";
+print "not " if $u->secure;
+print "ok 11\n";
+
$u->scheme("https");
print "not " unless $u->port == 443;
-print "ok 11\n";
+print "ok 12\n";
print "not " unless $u eq "https://www.perl.com/path?foo=bar&bar=baz";
-print "ok 12\n";
+print "ok 13\n";
+
+print "not " unless $u->secure;
+print "ok 14\n";
$u = URI->new("http://%77%77%77%2e%70%65%72%6c%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");
print "not " unless $u->canonical eq "http://www.perl.com/pub/a/2001/08/27/bjornstad.html";
-print "ok 13\n";
+print "ok 15\n";
21 t/ldap.t
View
@@ -1,6 +1,6 @@
#!perl -w
-print "1..22\n";
+print "1..24\n";
use strict;
use URI;
@@ -89,26 +89,31 @@ print "ok 15\n";
print "$uri\n";
print $uri->canonical, "\n";
+print "not " if $uri->secure;
+print "ok 16\n";
+
$uri = URI->new("ldaps://host/dn=base?cn,sn?sub?objectClass=*");
print "not " unless $uri->host eq "host";
-print "ok 16\n";
-print "not " unless $uri->port eq 636;
print "ok 17\n";
-print "not " unless $uri->dn eq "dn=base";
+print "not " unless $uri->port eq 636;
print "ok 18\n";
+print "not " unless $uri->dn eq "dn=base";
+print "ok 19\n";
+print "not " unless $uri->secure;
+print "ok 20\n";
$uri = URI->new("ldapi://%2Ftmp%2Fldap.sock/????x-mod=-w--w----");
print "not " unless $uri->authority eq "%2Ftmp%2Fldap.sock";
-print "ok 19\n";
+print "ok 21\n";
print "not " unless $uri->un_path eq "/tmp/ldap.sock";
-print "ok 20\n";
+print "ok 22\n";
$uri->un_path("/var/x\@foo:bar/");
print "not " unless $uri eq "ldapi://%2Fvar%2Fx%40foo%3Abar%2F/????x-mod=-w--w----";
-print "ok 21\n";
+print "ok 23\n";
%ext = $uri->extensions;
print "not " unless $ext{"x-mod"} eq "-w--w----";
-print "ok 22\n";
+print "ok 24\n";
Please sign in to comment.
Something went wrong with that request. Please try again.