[libdata-validate-uri-perl] 08/16: Imported Upstream version 0.06
dom at earth.li
dom at earth.li
Sat Aug 26 13:38:57 UTC 2017
This is an automated email from the git hooks/post-receive script.
dom pushed a commit to branch master
in repository libdata-validate-uri-perl.
commit b83eedfc22544a28e469f8ac84dbec1124230f3e
Author: Dominic Hargreaves <dom at earth.li>
Date: Sun Mar 18 21:28:30 2012 +0000
Imported Upstream version 0.06
---
Changes | 3 +
MANIFEST | 1 +
META.yml | 32 +++++++----
README | 28 +++++++++-
lib/Data/Validate/URI.pm | 139 +++++++++++++++++++++++++++++++++++++++++++++--
t/is_tel_uri.t | 62 +++++++++++++++++++++
6 files changed, 248 insertions(+), 17 deletions(-)
diff --git a/Changes b/Changes
index a357745..8ea8b15 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
Revision history for Perl extension Data::Validate::URI
+0.06 20120211
+ - Adding David Dick's is_tel_uri patch
+
0.04 20080408
- Checking that hex escapes include two characters. Thanks to Steve West.
diff --git a/MANIFEST b/MANIFEST
index 983b776..be9fe30 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -7,6 +7,7 @@ lib/Data/Validate/URI.pm
t/ExtUtils/TBone.pm
t/is_uri.t
t/is_http_uri.t
+t/is_tel_uri.t
t/is_https_uri.t
t/is_web_uri.t
META.yml Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
index 841137d..4e5a874 100644
--- a/META.yml
+++ b/META.yml
@@ -1,15 +1,23 @@
--- #YAML:1.0
-name: Data-Validate-URI
-version: 0.05
-abstract: ~
-license: ~
-generated_by: ExtUtils::MakeMaker version 6.36
-distribution_type: module
-requires:
- Data::Validate::Domain: 0
- Data::Validate::IP: 0
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+name: Data-Validate-URI
+version: 0.06
+abstract: ~
author:
- Richard Sonnen (sonnen at richardsonnen.com)
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Data::Validate::Domain: 0
+ Data::Validate::IP: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
diff --git a/README b/README
index fe5a3b2..6f7dd13 100644
--- a/README
+++ b/README
@@ -152,12 +152,38 @@ FUNCTIONS
is accessible or 'makes sense' in any meaningful way. It just
checks that it is formatted correctly.
+ is_tel_uri - is the value a well-formed telephone uri?
+ is_tel_uri($value);
+
+ *Description*
+ Specialized version of is_uri() that only likes tel: urls. As a
+ result, it can also do a much more thorough job validating
+ according to RFC 3966.
+
+ Returns the untainted URI if the test value appears to be
+ well-formed.
+
+ *Arguments*
+
+ $value
+ The potential URI to test.
+
+ *Returns*
+ Returns the untainted URI on success, undef on failure.
+
+ *Notes, Exceptions, & Bugs*
+ This function does not make any attempt to check whether the URI
+ is accessible or 'makes sense' in any meaningful way. It just
+ checks that it is formatted correctly.
+
SEE ALSO
- URI, RFC 3986
+ URI, RFC 3986, RFC 3966, RFC 4694, RFC 4759, RFC 4904
AUTHOR
Richard Sonnen <sonnen at richardsonnen.com>.
+ is_tel_uri by David Dick <ddick at cpan.org>.
+
COPYRIGHT
Copyright (c) 2005 Richard Sonnen. All rights reserved.
diff --git a/lib/Data/Validate/URI.pm b/lib/Data/Validate/URI.pm
index 33e522f..b9966a6 100644
--- a/lib/Data/Validate/URI.pm
+++ b/lib/Data/Validate/URI.pm
@@ -21,11 +21,12 @@ use Data::Validate::IP;
is_http_uri
is_https_uri
is_web_uri
+ is_tel_uri
);
%EXPORT_TAGS = ();
-$VERSION = '0.05';
+$VERSION = '0.06';
# No preloads
@@ -73,14 +74,14 @@ If you have a specialized scheme you'd like to have supported, let me know.
=head1 FUNCTIONS
-=over 4
-
=cut
# -------------------------------------------------------------------------------
=pod
+=over 4
+
=item B<new> - constructor for OO usage
new();
@@ -400,6 +401,133 @@ sub is_web_uri{
return is_https_uri($value);
}
+# -------------------------------------------------------------------------------
+
+=pod
+
+=item B<is_tel_uri> - is the value a well-formed telephone uri?
+
+ is_tel_uri($value);
+
+=over 4
+
+=item I<Description>
+
+Specialized version of is_uri() that only likes tel: urls. As a result, it can
+also do a much more thorough job validating according to RFC 3966.
+
+Returns the untainted URI if the test value appears to be well-formed.
+
+=item I<Arguments>
+
+=over 4
+
+=item $value
+
+The potential URI to test.
+
+=back
+
+=item I<Returns>
+
+Returns the untainted URI on success, undef on failure.
+
+=item I<Notes, Exceptions, & Bugs>
+
+This function does not make any attempt to check whether the URI is accessible
+or 'makes sense' in any meaningful way. It just checks that it is formatted
+correctly.
+
+=back
+
+=cut
+
+sub is_tel_uri{
+ my $self = shift if ref($_[0]);
+ my $value = shift;
+
+ # extracted from http://tools.ietf.org/html/rfc3966#section-3
+
+ my $hex_digit = '[a-fA-F0-9]'; # strictly hex digit does not allow lower case letters according to http://tools.ietf.org/html/rfc2234#section-6.1
+ my $reserved = '[;/?:@&=+$,]';
+ my $alphanum = '[A-Za-z0-9]';
+ my $visual_separator = '[\-\.\(\)]';
+ my $phonedigit_hex = '(?:' . $hex_digit . '|\*|\#|' . $visual_separator . ')';
+ my $phonedigit = '(?:' . '\d' . '|' . $visual_separator . ')';
+ my $param_unreserved = '[\[\]\/:&+$]';
+ my $pct_encoded = '\\%' . $hex_digit . $hex_digit;
+ my $mark = "[\-_\.!~*'()]";
+ my $unreserved = '(?:' . $alphanum . '|' . $mark . ')';
+ my $paramchar = '(?:' . $param_unreserved . '|' . $unreserved . '|' . $pct_encoded . ')';
+ my $pvalue = $paramchar . '{1,}';
+ my $pname = '(?:' . $alphanum . '|\\-){1,}';
+ my $uric = '(?:' . $reserved . '|' . $unreserved . '|' . $pct_encoded . ')';
+ my $alpha = '[A-Za-z]';
+ my $toplabel = '(?:' . $alpha . '|' . $alpha . '(?:' . $alphanum . '|' . '\\-){0,}' . $alpha . ')';
+ my $domainlabel = '(?:' . $alphanum . '|' . $alphanum . '(?:' . $alphanum . '|\\-){0,}' . $alphanum . ')';
+ my $domainname = '(?:' . $domainlabel . '\\.){0,}' . $toplabel . '\\.{0,1}';
+
+ # extracted from http://tools.ietf.org/html/rfc4694#section-4
+ my $npdi = ';npdi';
+ my $hex_phonedigit = '(?:' . $hex_digit . '|' . $visual_separator . ')';
+ my $global_hex_digits = '\\+' . '\\d{1,3}' . $hex_phonedigit . '{0,}';
+ my $global_rn = $global_hex_digits;
+ my $rn_descriptor = '(?:' . $domainname . '|' . $global_hex_digits . ')';
+ my $rn_context = ';rn-context=' . $rn_descriptor;
+ my $local_rn = $hex_phonedigit . '{1,}' . $rn_context;
+ my $global_cic = $global_hex_digits;
+ my $cic_context = ';cic-context=' . $rn_descriptor;
+ my $local_cic = $hex_phonedigit . '{1,}' . $cic_context;
+ my $cic = ';cic=' . '(?:' . $global_cic . '|' . $local_cic . '){0,1}';
+ my $rn = ';rn=' . '(?:' . $global_rn . '|' . $local_rn . '){0,1}';
+
+ if ($value =~ /$rn.*$rn/xsm) {
+ return;
+ }
+ if ($value =~ /$npdi.*$npdi/xsm) {
+ return;
+ }
+ if ($value =~ /$cic.*$cic/xsm) {
+ return;
+ }
+ my $parameter = '(?:;' . $pname . '(?:=' . $pvalue . ')|' . $rn . '|' . $cic . '|' . $npdi . ')';
+
+ # end of http://tools.ietf.org/html/rfc4694#section-4
+
+ my $local_number_digits = '(?:' . $phonedigit_hex . '{0,}' . '(?:' . $hex_digit . '|\*|\#)' . $phonedigit_hex . '{0,})';
+ my $global_number_digits = '\+' . $phonedigit . '{0,}' . '[0-9]' . $phonedigit . '{0,}';
+ my $descriptor = '(?:' . $domainname . '|' . $global_number_digits . ')';
+ my $context = ';phone\-context=' . $descriptor;
+ my $extension = ';ext=' . $phonedigit . '{1,}';
+ my $isdn_subaddress = ';isub=' . $uric . '{1,}';
+
+ # extracted from http://tools.ietf.org/html/rfc4759
+ my $enum_dip_indicator = ';enumdi';
+ if ($value =~ /$enum_dip_indicator.*$enum_dip_indicator/xsm) { # http://tools.ietf.org/html/rfc4759#section-3
+ return;
+ }
+
+ # extracted from http://tools.ietf.org/html/rfc4904#section-5
+ my $trunk_group_unreserved = '[/&+$]';
+ my $escaped = '\\%' . $hex_digit . $hex_digit; # according to http://tools.ietf.org/html/rfc3261#section-25.1
+ my $trunk_group_label = '(?:' . $unreserved . '|' . $escaped . '|' . $trunk_group_unreserved . '){1,}';
+ my $trunk_group = ';tgrp=' . $trunk_group_label;
+ my $trunk_context = ';trunk\-context=' . $descriptor;
+
+
+ my $par = '(?:' . $parameter . '|' . $extension . '|' . $isdn_subaddress . '|' . $enum_dip_indicator . '|' . $trunk_context . '|' . $trunk_group . ')';
+ my $local_number = $local_number_digits . $par . '{0,}' . $context . $par . '{0,}';
+ my $global_number = $global_number_digits . $par . '{0,}';
+ my $telephone_subscriber = '(?:' . $global_number . '|' . $local_number . ')';
+ my $telephone_uri = 'tel:' . $telephone_subscriber;
+
+ if ($value =~ /^($telephone_uri)$/xsm) {
+ my ($untainted) = ($1);
+ return $untainted;
+ } else {
+ return;
+ }
+}
# internal URI spitter method - direct from RFC 3986
sub _split_uri{
@@ -417,12 +545,15 @@ sub _split_uri{
=head1 SEE ALSO
-L<URI>, RFC 3986
+L<URI>, RFC 3986, RFC 3966, RFC 4694, RFC 4759, RFC 4904
=head1 AUTHOR
Richard Sonnen <F<sonnen at richardsonnen.com>>.
+is_tel_uri by David Dick <F<ddick at cpan.org>>.
+
+
=head1 COPYRIGHT
Copyright (c) 2005 Richard Sonnen. All rights reserved.
diff --git a/t/is_tel_uri.t b/t/is_tel_uri.t
new file mode 100644
index 0000000..f1b0976
--- /dev/null
+++ b/t/is_tel_uri.t
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+# -------------------------------------------------------------------------------
+# test harness for Data::Validate::URI::is_tel_uri
+#
+# Author: David Dick
+# -------------------------------------------------------------------------------
+
+use lib './t';
+use ExtUtils::TBone;
+
+use lib './blib';
+use Data::Validate::URI qw(is_tel_uri);
+
+my $t = ExtUtils::TBone->typical();
+
+$t->begin(23);
+$t->msg("testing is_tel_uri...");
+
+# valid examples taken from http://tools.ietf.org/html/rfc3966#section-6
+$t->ok(defined(is_tel_uri('tel:+1-201-555-0123')), 'tel:+1-201-555-0123');
+$t->ok(defined(is_tel_uri('tel:7042;phone-context=example.com')), 'tel:7042;phone-context=example.com');
+$t->ok(defined(is_tel_uri('tel:863-1234;phone-context=+1-914-555')), 'tel:863-1234;phone-context=+1-914-555');
+
+# valid examples taken from http://tools.ietf.org/html/rfc4715#section-5
+$t->ok(defined(is_tel_uri('tel:+17005554141;isub=12345;isub-encoding=nsap-ia5')), 'tel:+17005554141;isub=12345;isub-encoding=nsap-ia5');
+
+# valid examples taken from http://tools.ietf.org/html/rfc4759#section-5
+$t->ok(defined(is_tel_uri('tel:+441632960038;enumdi')), 'tel:+441632960038;enumdi');
+
+# valid examples taken from http://tools.ietf.org/html/rfc4694#section-6
+$t->ok(defined(is_tel_uri('tel:+1-800-123-4567;cic=+1-6789')), 'tel:+1-800-123-4567;cic=+1-6789');
+$t->ok(defined(is_tel_uri('tel:+1-202-533-1234')), 'tel:+1-202-533-1234');
+$t->ok(defined(is_tel_uri('tel:+1-202-533-1234;npdi;rn=+1-202-544-0000')), 'tel:+1-202-533-1234;npdi;rn=+1-202-544-0000');
+$t->ok(defined(is_tel_uri('tel:+1-202-533-6789;npdi')), 'tel:+1-202-533-6789;npdi');
+
+# valid examples taken from http://tools.ietf.org/html/rfc4904#section-5
+$t->ok(defined(is_tel_uri('tel:5550100;phone-context=+1-630;tgrp=TG-1;trunk-context=example.com')), 'tel:5550100;phone-context=+1-630;tgrp=TG-1;trunk-context=example.com');
+$t->ok(defined(is_tel_uri('tel:+16305550100;tgrp=TG-1;trunk-context=example.com')), 'tel:+16305550100;tgrp=TG-1;trunk-context=example.com');
+$t->ok(defined(is_tel_uri('tel:+16305550100;tgrp=TG-1;trunk-context=+1-630')), 'tel:+16305550100;tgrp=TG-1;trunk-context=+1-630');
+
+# valid examples taken from http://tools.ietf.org/html/rfc2806#section-2.6
+$t->ok(defined(is_tel_uri('tel:+358-555-1234567')), 'tel:+358-555-1234567');
+
+# invalid
+$t->ok(!defined(is_tel_uri('')), "bad: ''");
+$t->ok(!defined(is_tel_uri('ftp://ftp.richardsonnen.com')), "bad: 'ftp://ftp.richardsonnen.com'");
+$t->ok(!defined(is_tel_uri('http://www.richardsonnen.com')), "bad: 'http://www.richardsonnen.com'");
+$t->ok(!defined(is_tel_uri('tels:863-1234;phone-context=+1-914-555')), 'tels:863-1234;phone-context=+1-914-555');
+$t->ok(!defined(is_tel_uri('tel:+441632960038;enumdi;enumdi')), 'tel:+441632960038;enumdi;enumdi');
+$t->ok(!defined(is_tel_uri('tel:+441632960038;rn=+1-202-544-0000;rn=+1-202-544-0000')), 'tel:+441632960038;rn=+1-202-544-0000;rn=+1-202-544-0000');
+$t->ok(!defined(is_tel_uri('tel:+441632960038;npdi;npdi')), 'tel:+441632960038;npdi;npdi');
+$t->ok(!defined(is_tel_uri('tel:+1-800-123-4567;cic=+1-6789;cic=+1-6789')), 'tel:+1-800-123-4567;cic=+1-6789;cic=+1-6789');
+
+# as an object
+my $v = Data::Validate::URI->new();
+$t->ok(defined($v->is_tel_uri('tel:+1-201-555-0111')), 'tel:+1-201-555-0111 (object)');
+$t->ok(!defined($v->is_tel_uri('foo')), 'bad: foo (object)');
+
+# we're done
+$t->end();
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libdata-validate-uri-perl.git
More information about the Pkg-perl-cvs-commits
mailing list