Data-Validate-URI-0.07/0000755000175000017500000000000012647463007014374 5ustar vagrantvagrantData-Validate-URI-0.07/t/0000755000175000017500000000000012647463007014637 5ustar vagrantvagrantData-Validate-URI-0.07/t/is_uri.t0000644000175000017500000000537412647421415016324 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::URI::is_uri # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::URI qw(is_uri); my $t = ExtUtils::TBone->typical(); $t->begin(25); $t->msg("testing is_uri..."); # valid - from RFC 3986 for the most part $t->ok(defined(is_uri('http://localhost/')), 'http://localhost/'); $t->ok(defined(is_uri('http://example.w3.org/path%20with%20spaces.html')), 'http://example.w3.org/path%20with%20spaces.html'); $t->ok(defined(is_uri('http://example.w3.org/%20')), 'http://example.w3.org/%20'); $t->ok(defined(is_uri('ftp://ftp.is.co.za/rfc/rfc1808.txt')), 'ftp://ftp.is.co.za/rfc/rfc1808.txt'); $t->ok(defined(is_uri('ftp://ftp.is.co.za/../../../rfc/rfc1808.txt')), 'ftp://ftp.is.co.za/../../../rfc/rfc1808.txt'); $t->ok(defined(is_uri('http://www.ietf.org/rfc/rfc2396.txt')), 'http://www.ietf.org/rfc/rfc2396.txt'); $t->ok(defined(is_uri('ldap://[2001:db8::7]/c=GB?objectClass?one')), 'ldap://[2001:db8::7]/c=GB?objectClass?one'); $t->ok(defined(is_uri('mailto:John.Doe@example.com')), 'mailto:John.Doe@example.com'); $t->ok(defined(is_uri('news:comp.infosystems.www.servers.unix')), 'news:comp.infosystems.www.servers.unix'); $t->ok(defined(is_uri('tel:+1-816-555-1212')), 'tel:+1-816-555-1212'); $t->ok(defined(is_uri('telnet://192.0.2.16:80/')), 'telnet://192.0.2.16:80/'); $t->ok(defined(is_uri('urn:oasis:names:specification:docbook:dtd:xml:4.1.2')), 'urn:oasis:names:specification:docbook:dtd:xml:4.1.2'); # invalid $t->ok(!defined(is_uri('')), "bad: ''"); $t->ok(!defined(is_uri('foo')), 'bad: foo'); $t->ok(!defined(is_uri('foo@bar')), 'bad: foo@bar'); $t->ok(!defined(is_uri('http://')), 'bad: http://'); # illegal characters $t->ok(!defined(is_uri('://bob/')), 'bad: ://bob/'); # empty schema $t->ok(!defined(is_uri('1http://bob')), 'bad: 1http://bob/'); # bad schema $t->ok(!defined(is_uri('1http:////foo.html')), 'bad: 1http://bob/'); # bad path $t->ok(!defined(is_uri('http://example.w3.org/%illegal.html')), 'http://example.w3.org/%illegal.html'); $t->ok(!defined(is_uri('http://example.w3.org/%a')), 'http://example.w3.org/%a'); # partial escape $t->ok(!defined(is_uri('http://example.w3.org/%a/foo')), 'http://example.w3.org/%a/foo'); # partial escape $t->ok(!defined(is_uri('http://example.w3.org/%at')), 'http://example.w3.org/%at'); # partial escape # as an object my $v = Data::Validate::URI->new(); $t->ok(defined($v->is_uri('http://www.richardsonnen.com/')), 'http://www.richardsonnen.com/ (object)'); $t->ok(!defined($v->is_uri('foo')), 'bad: foo (object)'); # we're done $t->end(); Data-Validate-URI-0.07/t/is_web_uri.t0000644000175000017500000000667212647442344017167 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::URI::is_web_uri # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::URI qw(is_web_uri); my $t = ExtUtils::TBone->typical(); $t->begin(26); $t->msg("testing is_web_uri..."); # invalid $t->ok(!defined(is_web_uri('')), "bad: ''"); $t->ok(!defined(is_web_uri('ftp://ftp.richardsonnen.com')), "bad: 'ftp://ftp.richardsonnen.com'"); $t->ok(!defined(is_web_uri('https:www.richardsonnen.com')), "bad: 'http:www.richardsonnen.com'"); $t->ok(!defined(is_web_uri('http:www.richardsonnen.com')), "bad: 'http:www.richardsonnen.com'"); $t->ok(!defined(is_web_uri('http://under_scored.richardsonnen.com/')), "bad: 'http://under_scored.richardsonnen.com/'"); $t->ok(!defined(is_web_uri('https://under_scored.richardsonnen.com/')), "bad: 'https://under_scored.richardsonnen.com/'"); # valid $t->ok(defined(is_web_uri('https://www.richardsonnen.com/')), 'https://www.richardsonnen.com/'); $t->ok(defined(is_web_uri('https://www.richardsonnen.com')), 'https://www.richardsonnen.com'); $t->ok(defined(is_web_uri('https://www.richardsonnen.com/foo/bar/test.html')), 'https://www.richardsonnen.com/foo/bar/test.html'); $t->ok(defined(is_web_uri('https://www.richardsonnen.com/?foo=bar')), 'https://www.richardsonnen.com/?foo=bar'); $t->ok(defined(is_web_uri('https://www.richardsonnen.com:8080/test.html')), 'https://www.richardsonnen.com:8080/test.html'); $t->ok(defined(is_web_uri('http://www.richardsonnen.com/')), 'http://www.richardsonnen.com/'); $t->ok(defined(is_web_uri('http://www.richardsonnen.com')), 'http://www.richardsonnen.com'); $t->ok(defined(is_web_uri('http://www.richardsonnen.com/foo/bar/test.html')), 'http://www.richardsonnen.com/foo/bar/test.html'); $t->ok(defined(is_web_uri('http://www.richardsonnen.com/?foo=bar')), 'http://www.richardsonnen.com/?foo=bar'); $t->ok(defined(is_web_uri('http://www.richardsonnen.com:8080/test.html')), 'http://www.richardsonnen.com:8080/test.html'); $t->ok(defined(is_web_uri('http://example.w3.org/path%20with%20spaces.html')), 'http://example.w3.org/path%20with%20spaces.html'); $t->ok(defined(is_web_uri('http://192.168.0.1/')), 'http://192.168.0.1/'); $t->ok(defined(is_web_uri('http://under_scored.richardsonnen.com/', {domain_allow_underscore=>1})), 'http://under_scored.richardsonnen.com/'); $t->ok(defined(is_web_uri('https://under_scored.richardsonnen.com/', {domain_allow_underscore=>1})), 'https://under_scored.richardsonnen.com/'); # as an object my $v = Data::Validate::URI->new(); $t->ok(defined($v->is_web_uri('http://www.richardsonnen.com/')), 'http://www.richardsonnen.com/ (object)'); $t->ok(!defined($v->is_web_uri('foo')), 'bad: foo (object)'); $t->ok(!defined($v->is_web_uri('http://under_scored.richardsonnen.com/')), "bad: 'http://under_scored.richardsonnen.com/' (object)"); $t->ok(!defined($v->is_web_uri('https://under_scored.richardsonnen.com/')), "bad: 'https://under_scored.richardsonnen.com/' (object)"); $v = Data::Validate::URI->new(domain_allow_underscore=>1); $t->ok(defined($v->is_web_uri('http://under_scored.richardsonnen.com/')), 'http://under_scored.richardsonnen.com/ (object)'); $t->ok(defined($v->is_web_uri('https://under_scored.richardsonnen.com/')), 'https://under_scored.richardsonnen.com/ (object)'); # we're done $t->end(); Data-Validate-URI-0.07/t/ExtUtils/0000755000175000017500000000000012647463007016420 5ustar vagrantvagrantData-Validate-URI-0.07/t/ExtUtils/TBone.pm0000444000175000017500000003044412647421415017765 0ustar vagrantvagrantpackage ExtUtils::TBone; =head1 NAME ExtUtils::TBone - a "skeleton" for writing "t/*.t" test files. =head1 SYNOPSIS Include a copy of this module in your t directory (as t/ExtUtils/TBone.pm), and then write your t/*.t files like this: use lib "./t"; # to pick up a ExtUtils::TBone use ExtUtils::TBone; # Make a tester... here are 3 different alternatives: my $T = typical ExtUtils::TBone; # standard log my $T = new ExtUtils::TBone; # no log my $T = new ExtUtils::TBone "testout/Foo.tlog"; # explicit log # Begin testing, and expect 3 tests in all: $T->begin(3); # expect 3 tests $T->msg("Something for the log file"); # message for the log # Run some tests: $T->ok($this); # test 1: no real info logged $T->ok($that, # test 2: logs a comment "Is that ok, or isn't it?"); $T->ok(($this eq $that), # test 3: logs comment + vars "Do they match?", This => $this, That => $that); # That last one could have also been written... $T->ok_eq($this, $that); # does 'eq' and logs operands $T->ok_eqnum($this, $that); # does '==' and logs operands # End testing: $T->end; =head1 DESCRIPTION This module is intended for folks who release CPAN modules with "t/*.t" tests. It makes it easy for you to output syntactically correct test-output while at the same time logging all test activity to a log file. Hopefully, bug reports which include the contents of this file will be easier for you to investigate. =head1 OUTPUT =head2 Standard output Pretty much as described by C, with a special "# END" comment placed at the very end: 1..3 ok 1 not ok 2 ok 3 # END =head1 Log file A typical log file output by this module looks like this: 1..3 ** A message logged with msg(). ** Another one. 1: My first test, using test(): how'd I do? 1: ok 1 ** Yet another message. 2: My second test, using test_eq()... 2: A: The first string 2: B: The second string 2: not ok 2 3: My third test. 3: ok 3 # END Each test() is logged with the test name and results, and the test-number prefixes each line. This allows you to scan a large file easily with "grep" (or, ahem, "perl"). A blank line follows each test's record, for clarity. =head1 PUBLIC INTERFACE =cut # Globals: use strict; use vars qw($VERSION); use FileHandle; use File::Basename; # The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = substr q$Revision: 1.124 $, 10; #------------------------------ =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Create a new tester. Any arguments are sent to log_open(). =cut sub new { my $self = bless { OUT =>\*STDOUT, Begin=>0, End =>0, Count=>0, }, shift; $self->log_open(@_) if @_; $self; } #------------------------------ =item typical I Create a typical tester. Use this instead of new() for most applicaitons. The directory "testout" is created for you automatically, to hold the output log file, and log_warnings() is invoked. =cut sub typical { my $class = shift; my ($tfile) = basename $0; unless (-d "testout") { mkdir "testout", 0755 or die "Couldn't create a 'testout' subdirectory: $!\n"; ### warn "$class: created 'testout' directory\n"; } my $self = $class->new($class->catfile('.', 'testout', "${tfile}log")); $self->log_warnings; $self; } #------------------------------ # DESTROY #------------------------------ # Class method, destructor. # Automatically closes the log. # sub DESTROY { $_[0]->log_close; } #------------------------------ =back =head2 Doing tests =over 4 =cut #------------------------------ =item begin NUMTESTS I Start testing. This outputs the 1..NUMTESTS line to the standard output. =cut sub begin { my ($self, $n) = @_; return if $self->{Begin}++; $self->l_print("1..$n\n\n"); print {$self->{OUT}} "1..$n\n"; } #------------------------------ =item end I Indicate the end of testing. This outputs a "# END" line to the standard output. =cut sub end { my ($self) = @_; return if $self->{End}++; $self->l_print("# END\n"); print {$self->{OUT}} "# END\n"; } #------------------------------ =item ok BOOL, [TESTNAME], [PARAMHASH...] I Do a test, and log some information connected with it. This outputs the test result lines to the standard output: ok 12 not ok 13 Use it like this: $T->ok(-e $dotforward); Or better yet, like this: $T->ok((-e $dotforward), "Does the user have a .forward file?"); Or even better, like this: $T->ok((-e $dotforward), "Does the user have a .forward file?", User => $ENV{USER}, Path => $dotforward, Fwd => $ENV{FWD}); That last one, if it were test #3, would be logged as: 3: Does the user have a .forward file? 3: User: "alice" 3: Path: "/home/alice/.forward" 3: Fwd: undef 3: ok You get the idea. Note that defined quantities are logged with delimiters and with all nongraphical characters suitably escaped, so you can see evidence of unexpected whitespace and other badnasties. Had "Fwd" been the string "this\nand\nthat", you'd have seen: 3: Fwd: "this\nand\nthat" And unblessed array refs like ["this", "and", "that"] are treated as multiple values: 3: Fwd: "this" 3: Fwd: "and" 3: Fwd: "that" =cut sub ok { my ($self, $ok, $test, @ps) = @_; ++($self->{Count}); # next test # Report to harness: my $status = ($ok ? "ok " : "not ok ") . $self->{Count}; print {$self->{OUT}} $status, "\n"; # Log: $self->ln_print($test, "\n") if $test; while (@ps) { my ($k, $v) = (shift @ps, shift @ps); my @vs = ((ref($v) and (ref($v) eq 'ARRAY'))? @$v : ($v)); foreach (@vs) { if (!defined($_)) { # value not defined: output keyword $self->ln_print(qq{ $k: undef\n}); } else { # value defined: output quoted, encoded form s{([\n\t\x00-\x1F\x7F-\xFF\\\"])} {'\\'.sprintf("%02X",ord($1)) }exg; s{\\0A}{\\n}g; $self->ln_print(qq{ $k: "$_"\n}); } } } $self->ln_print($status, "\n"); $self->l_print("\n"); 1; } #------------------------------ =item ok_eq ASTRING, BSTRING, [TESTNAME], [PARAMHASH...] I Convenience front end to ok(): test whether C, and logs the operands as 'A' and 'B'. =cut sub ok_eq { my ($self, $this, $that, $test, @ps) = @_; $self->ok(($this eq $that), ($test || "(Is 'A' string-equal to 'B'?)"), A => $this, B => $that, @ps); } #------------------------------ =item ok_eqnum ANUM, BNUM, [TESTNAME], [PARAMHASH...] I Convenience front end to ok(): test whether C, and logs the operands as 'A' and 'B'. =cut sub ok_eqnum { my ($self, $this, $that, $test, @ps) = @_; $self->ok(($this == $that), ($test || "(Is 'A' numerically-equal to 'B'?)"), A => $this, B => $that, @ps); } #------------------------------ =back =head2 Logging messages =over 4 =cut #------------------------------ =item log_open PATH I Open a log file for messages to be output to. This is invoked for you automatically by C and C. =cut sub log_open { my ($self, $path) = @_; $self->{LogPath} = $path; $self->{LOG} = FileHandle->new(">$path") || die "open $path: $!"; $self; } #------------------------------ =item log_close I Close the log file and stop logging. You shouldn't need to invoke this directly; the destructor does it. =cut sub log_close { my $self = shift; close(delete $self->{LOG}) if $self->{LOG}; } #------------------------------ =item log_warnings I Invoking this redefines $SIG{__WARN__} to log to STDERR and to the tester's log. This is automatically invoked when using the C constructor. =cut sub log_warnings { my ($self) = @_; $SIG{__WARN__} = sub { print STDERR $_[0]; $self->log("warning: ", $_[0]); }; } #------------------------------ =item log MESSAGE... I Log a message to the log file. No alterations are made on the text of the message. See msg() for an alternative. =cut sub log { my $self = shift; print {$self->{LOG}} @_ if $self->{LOG}; } #------------------------------ =item msg MESSAGE... I Log a message to the log file. Lines are prefixed with "** " for clarity, and a terminating newline is forced. =cut sub msg { my $self = shift; my $text = join '', @_; chomp $text; $text =~ s{^}{** }gm; $self->l_print($text, "\n"); } #------------------------------ # # l_print MESSAGE... # # Instance method, private. # Print to the log file if there is one. # sub l_print { my $self = shift; print { $self->{LOG} } @_ if $self->{LOG}; } #------------------------------ # # ln_print MESSAGE... # # Instance method, private. # Print to the log file, prefixed by message number. # sub ln_print { my $self = shift; foreach (split /\n/, join('', @_)) { $self->l_print("$self->{Count}: $_\n"); } } #------------------------------ =back =head2 Utilities =over 4 =cut #------------------------------ =item catdir DIR, ..., DIR I Concatenate several directories into a path ending in a directory. Lightweight version of the one in C; this method dates back to a more-innocent time when File::Spec was younger and less ubiquitous. Paths are assumed to be absolute. To signify a relative path, the first DIR must be ".", which is processed specially. On Mac, the path I end in a ':'. On Unix, the path I end in a '/'. =cut sub catdir { my $self = shift; my $relative = shift @_ if ($_[0] eq '.'); if ($^O eq 'Mac') { return ($relative ? ':' : '') . (join ':', @_) . ':'; } else { return ($relative ? './' : '/') . join '/', @_; } } #------------------------------ =item catfile DIR, ..., DIR, FILE I Like catdir(), but last element is assumed to be a file. Note that, at a minimum, you must supply at least a single DIR. =cut sub catfile { my $self = shift; my $file = pop; if ($^O eq 'Mac') { return $self->catdir(@_) . $file; } else { return $self->catdir(@_) . "/$file"; } } #------------------------------ =back =head1 VERSION $Id: TBone.pm,v 1.124 2001/08/20 20:30:07 eryq Exp $ =head1 CHANGE LOG =over 4 =item Version 1.124 (2001/08/20) The terms-of-use have been placed in the distribution file "COPYING". Also, small documentation tweaks were made. =item Version 1.122 (2001/08/20) Changed output of C<"END"> to C<"# END">; apparently, "END" is not a directive. Maybe it never was. I The storyteller need not say "the end" aloud; Silence is enough. Automatically invoke C when constructing via C. =item Version 1.120 (2001/08/17) Added log_warnings() to support the logging of SIG{__WARN__} messages to the log file (if any). =item Version 1.116 (2000/03/23) Cosmetic improvements only. =item Version 1.112 (1999/05/12) Added lightweight catdir() and catfile() (a la File::Spec) to enhance portability to Mac environment. =item Version 1.111 (1999/04/18) Now uses File::Basename to create "typical" logfile name, for portability. =item Version 1.110 (1999/04/17) Fixed bug in constructor that surfaced if no log was being used. =back Created: Friday-the-13th of February, 1998. =head1 AUTHOR Eryq (F). President, ZeeGee Software Inc. (F). Go to F for the latest downloads and on-line documentation for this module. Enjoy. Yell if it breaks. =cut #------------------------------ 1; __END__ my $T = new ExtUtils::TBone "testout/foo.tlog"; $T->begin(3); $T->msg("before 1\nor 2"); $T->ok(1, "one"); $T->ok(2, "Two"); $T->ok(3, "Three", Roman=>'III', Arabic=>[3, '03'], Misc=>"3\nor 3"); $T->end; 1; Data-Validate-URI-0.07/t/is_https_uri.t0000644000175000017500000000466312647441574017556 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::URI::is_https_uri # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::URI qw(is_https_uri); my $t = ExtUtils::TBone->typical(); $t->begin(17); $t->msg("testing is_https_uri..."); # invalid $t->ok(!defined(is_https_uri('')), "bad: ''"); $t->ok(!defined(is_https_uri('http://www.richardsonnen.com/')), 'http://www.richardsonnen.com/'); $t->ok(!defined(is_https_uri('ftp://ftp.richardsonnen.com')), "bad: 'ftp://ftp.richardsonnen.com'"); $t->ok(!defined(is_https_uri('https:www.richardsonnen.com')), "bad: 'https:www.richardsonnen.com'"); $t->ok(!defined(is_https_uri('https://under_scored.richardsonnen.com/')), "bad: 'https://under_scored.richardsonnen.com/'"); # valid $t->ok(defined(is_https_uri('https://www.richardsonnen.com/')), 'https://www.richardsonnen.com/'); $t->ok(defined(is_https_uri('https://www.richardsonnen.com')), 'https://www.richardsonnen.com'); $t->ok(defined(is_https_uri('https://www.richardsonnen.com/foo/bar/test.html')), 'https://www.richardsonnen.com/foo/bar/test.html'); $t->ok(defined(is_https_uri('https://www.richardsonnen.com/?foo=bar')), 'https://www.richardsonnen.com/?foo=bar'); $t->ok(defined(is_https_uri('https://www.richardsonnen.com:8080/test.html')), 'https://www.richardsonnen.com:8080/test.html'); $t->ok(defined(is_https_uri('https://example.w3.org/path%20with%20spaces.html')), 'http://example.w3.org/path%20with%20spaces.html'); $t->ok(defined(is_https_uri('https://192.168.0.1/')), 'http://192.168.0.1/'); $t->ok(defined(is_https_uri('https://under_scored.richardsonnen.com/', {domain_allow_underscore=>1})), 'https://under_scored.richardsonnen.com/'); # as an object my $v = Data::Validate::URI->new(); $t->ok(defined($v->is_https_uri('https://www.richardsonnen.com/')), 'https://www.richardsonnen.com/ (object)'); $t->ok(!defined($v->is_https_uri('foo')), 'bad: foo (object)'); $t->ok(!defined($v->is_https_uri('https://under_scored.richardsonnen.com/')), "bad: 'https://under_scored.richardsonnen.com/' (object)"); $v = Data::Validate::URI->new(domain_allow_underscore=>1); $t->ok(defined($v->is_https_uri('https://under_scored.richardsonnen.com/')), 'https://under_scored.richardsonnen.com/ (object)'); # we're done $t->end(); Data-Validate-URI-0.07/t/is_tel_uri.t0000644000175000017500000000644412647421415017167 0ustar vagrantvagrant#!/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(); Data-Validate-URI-0.07/t/is_http_uri.t0000644000175000017500000000461712647441601017361 0ustar vagrantvagrant#!/usr/bin/perl # ------------------------------------------------------------------------------- # test harness for Data::Validate::URI::is_http_uri # # Author: Richard Sonnen (http://www.richardsonnen.com/) # ------------------------------------------------------------------------------- use lib './t'; use ExtUtils::TBone; use lib './blib'; use Data::Validate::URI qw(is_http_uri); my $t = ExtUtils::TBone->typical(); $t->begin(17); $t->msg("testing is_http_uri..."); # invalid $t->ok(!defined(is_http_uri('')), "bad: ''"); $t->ok(!defined(is_http_uri('ftp://ftp.richardsonnen.com')), "bad: 'ftp://ftp.richardsonnen.com'"); $t->ok(!defined(is_http_uri('http:www.richardsonnen.com')), "bad: 'http:www.richardsonnen.com'"); $t->ok(!defined(is_http_uri('https://www.richardsonnen.com')), "bad: 'https://www.richardsonnen.com'"); $t->ok(!defined(is_http_uri('http://under_scored.richardsonnen.com/')), "bad: 'http://under_scored.richardsonnen.com/'"); # valid $t->ok(defined(is_http_uri('http://www.richardsonnen.com/')), 'http://www.richardsonnen.com/'); $t->ok(defined(is_http_uri('http://www.richardsonnen.com')), 'http://www.richardsonnen.com'); $t->ok(defined(is_http_uri('http://www.richardsonnen.com/foo/bar/test.html')), 'http://www.richardsonnen.com/foo/bar/test.html'); $t->ok(defined(is_http_uri('http://www.richardsonnen.com/?foo=bar')), 'http://www.richardsonnen.com/?foo=bar'); $t->ok(defined(is_http_uri('http://www.richardsonnen.com:8080/test.html')), 'http://www.richardsonnen.com:8080/test.html'); $t->ok(defined(is_http_uri('http://example.w3.org/path%20with%20spaces.html')), 'http://example.w3.org/path%20with%20spaces.html'); $t->ok(defined(is_http_uri('http://192.168.0.1/')), 'http://192.168.0.1/'); $t->ok(defined(is_http_uri('http://under_scored.richardsonnen.com/', {domain_allow_underscore=>1})), 'https://under_scored.richardsonnen.com/'); # as an object my $v = Data::Validate::URI->new(); $t->ok(defined($v->is_http_uri('http://www.richardsonnen.com/')), 'http://www.richardsonnen.com/ (object)'); $t->ok(!defined($v->is_http_uri('foo')), 'bad: foo (object)'); $t->ok(!defined($v->is_http_uri('http://under_scored.richardsonnen.com/')), "bad: 'http://under_scored.richardsonnen.com/' (object)"); $v = Data::Validate::URI->new(domain_allow_underscore=>1); $t->ok(defined($v->is_http_uri('http://under_scored.richardsonnen.com/')), 'http://under_scored.richardsonnen.com/ (object)'); # we're done $t->end(); Data-Validate-URI-0.07/META.yml0000644000175000017500000000110112647421514015633 0ustar vagrantvagrant--- #YAML:1.0 name: Data-Validate-URI version: 0.07 abstract: ~ author: - Richard Sonnen (sonnen@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 Data-Validate-URI-0.07/Changes0000644000175000017500000000076612647462641015703 0ustar vagrantvagrantRevision history for Perl extension Data::Validate::URI 0.07 20160119 - Adding Josef Toman's underscore patch 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. 0.04 20071125 - Allowing IPs in authority section of http/https URLs 0.03 20071029 - fixed hex encoding bug. Thanks to Frank Wiles. 0.02 20071016 - fixed typo in POD. Thanks to Tadghe Danu. 0.01 20050915 - original version Data-Validate-URI-0.07/MANIFEST0000644000175000017500000000036212647421415015523 0ustar vagrantvagrantChanges Makefile.PL MANIFEST INSTALL README 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) Data-Validate-URI-0.07/INSTALL0000644000175000017500000000040312647421415015417 0ustar vagrantvagrantINSTALLATION ============ First unpack the kit, if you have not already done so: tar -xzvf Data-Validate-URI-x.xx.tar.gz cd Data-Validate-URI-x.xx Data::Validate::URI can be installed with: perl Makefile.PL make make test make install Data-Validate-URI-0.07/lib/0000755000175000017500000000000012647463007015142 5ustar vagrantvagrantData-Validate-URI-0.07/lib/Data/0000755000175000017500000000000012647463007016013 5ustar vagrantvagrantData-Validate-URI-0.07/lib/Data/Validate/0000755000175000017500000000000012647463007017544 5ustar vagrantvagrantData-Validate-URI-0.07/lib/Data/Validate/URI.pm0000644000175000017500000003473012647443631020551 0ustar vagrantvagrantpackage Data::Validate::URI; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); require Exporter; use AutoLoader 'AUTOLOAD'; use Data::Validate::Domain; use Data::Validate::IP; @ISA = qw(Exporter); # no functions are exported by default. See EXPORT_OK @EXPORT = qw(); @EXPORT_OK = qw( is_uri is_http_uri is_https_uri is_web_uri is_tel_uri ); %EXPORT_TAGS = (); $VERSION = '0.07'; # No preloads 1; __END__ =head1 NAME Data::Validate::URI - common url validation methods =head1 SYNOPSIS use Data::Validate::URI qw(is_uri); if(is_uri($suspect)){ print "Looks like an URI\n"; } else { print "Not a URI\n"; } # or as an object my $v = Data::Validate::URI->new(); die "not a URI" unless ($v->is_uri('foo')); =head1 DESCRIPTION This module collects common URI validation routines to make input validation, and untainting easier and more readable. All functions return an untainted value if the test passes, and undef if it fails. This means that you should always check for a defined status explicitly. Don't assume the return will be true. The value to test is always the first (and often only) argument. There are a number of other URI validation modules out there as well (see below.) This one focuses on being fast, lightweight, and relatively 'real-world'. i.e. it's good if you want to check user input, and don't need to parse out the URI/URL into chunks. Right now the module focuses on HTTP URIs, since they're arguably the most common. If you have a specialized scheme you'd like to have supported, let me know. =head1 FUNCTIONS =cut # ------------------------------------------------------------------------------- =pod =over 4 =item B - constructor for OO usage new(%options); =over 4 =item I Returns a Data::Validator::URI object. This lets you access all the validator function calls as methods without importing them into your namespace or using the clumsy Data::Validate::URI::function_name() format. =item I =over 4 =item %options Options to be passed into the underlying Data::Validate::Domain module =back =item I Returns a Data::Validate::URI object =back =cut sub new{ my $class = shift; return bless {@_}, $class; } # ------------------------------------------------------------------------------- =pod =item B - is the value a well-formed uri? is_uri($value); =over 4 =item I Returns the untainted URI if the test value appears to be well-formed. Note that you may really want one of the more practical methods like is_http_uri or is_https_uri, since the URI standard (RFC 3986) allows a lot of things you probably don't want. =item I =over 4 =item $value The potential URI to test. =back =item I Returns the untainted URI on success, undef on failure. =item I 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_uri{ my $self = shift if ref($_[0]); my $value = shift; return unless defined($value); # check for illegal characters return if $value =~ /[^a-z0-9\:\/\?\#\[\]\@\!\$\&\'\(\)\*\+\,\;\=\.\-\_\~\%]/i; # check for hex escapes that aren't complete return if $value =~ /%[^0-9a-f]/i; return if $value =~ /%[0-9a-f](:?[^0-9a-f]|$)/i; # from RFC 3986 my($scheme, $authority, $path, $query, $fragment) = _split_uri($value); # scheme and path are required, though the path can be empty return unless (defined($scheme) && length($scheme) && defined($path)); # if authority is present, the path must be empty or begin with a / if(defined($authority) && length($authority)){ return unless(length($path) == 0 || $path =~ m!^/!); } else { # if authority is not present, the path must not start with // return if $path =~ m!^//!; } # scheme must begin with a letter, then consist of letters, digits, +, ., or - return unless lc($scheme) =~ m!^[a-z][a-z0-9\+\-\.]*$!; # re-assemble the URL per section 5.3 in RFC 3986 my $out = $scheme . ':'; if(defined $authority && length($authority)){ $out .= '//' . $authority; } $out .= $path; if(defined $query && length($query)){ $out .= '?' . $query; } if(defined $fragment && length($fragment)){ $out .= '#' . $fragment; } return $out; } # ------------------------------------------------------------------------------- sub _test_uri { # 1 = HTTP only # 2 = HTTPS only # 3 = both HTTP and HTTPS are allowed my $allowed_scheme = shift; my $value = shift; my $options = shift // {}; return unless is_uri($value); my($scheme, $authority, $path, $query, $fragment) = _split_uri($value); return unless $scheme; if($allowed_scheme == 1) { return unless lc($scheme) eq 'http'; } elsif ($allowed_scheme == 2) { return unless lc($scheme) eq 'https' } elsif ($allowed_scheme == 3) { return unless lc($scheme) =~ m/^https?$/; } else { return; } # fully-qualified URIs must have an authority section that is # a valid host return unless($authority); # allow a port component my($port) = $authority =~ /:(\d+)$/; $authority =~ s/:\d+$//; # modifying this to allow the (discouraged, but still legal) use of IP addresses unless(Data::Validate::Domain::is_domain($authority, $options) || Data::Validate::IP::is_ipv4($authority)){ return; } # re-assemble the URL per section 5.3 in RFC 3986 my $out = $scheme . ':'; $out .= '//' . $authority; $out .= ':' . $port if $port; $out .= $path; if(defined $query && length($query)){ $out .= '?' . $query; } if(defined $fragment && length($fragment)){ $out .= '#' . $fragment; } return $out; } =pod =item B - is the value a well-formed HTTP uri? is_http_uri($value, \%options); =over 4 =item I Specialized version of is_uri() that only likes http:// urls. As a result, it can also do a much more thorough job validating. Also, unlike is_uri() it is more concerned with only allowing real-world URIs through. Things like relative hostnames are allowed by the standards, but probably aren't wise. Conversely, null paths aren't allowed per RFC 2616 (should be '/' instead), but are allowed by this function. This function only works for fully-qualified URIs. /bob.html won't work. See RFC 3986 for the appropriate method to turn a relative URI into an absolute one given its context. Returns the untainted URI if the test value appears to be well-formed. Note that you probably want to either call this in combo with is_https_uri(). i.e. print "Good" if(is_http_uri($uri) || is_https_uri($uri)); or use the convenience method is_web_uri which is equivalent and faster, because it does the work only once. =item I =over 4 =item $value The potential URI to test. =item \%options Options to be passed into the underlying Data::Validate::Domain module. If called as a method, the options are ignored. =back =item I Returns the untainted URI on success, undef on failure. =item I 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_http_uri{ my $self = shift if ref($_[0]); my $value = shift; $self //= shift; return _test_uri(1, $value, $self); } # ------------------------------------------------------------------------------- =pod =item B - is the value a well-formed HTTPS uri? is_https_uri($value. \%options); =over 4 =item I See is_http_uri() for details. This version only likes the https URI scheme. Otherwise it's identical to is_http_uri() =item I =over 4 =item $value The potential URI to test. =item \%options Options to be passed into the underlying Data::Validate::Domain module. If called as a method, the options are ignored. =back =item I Returns the untainted URI on success, undef on failure. =item I 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_https_uri{ my $self = shift if ref($_[0]); my $value = shift; $self //= shift; return _test_uri(2, $value, $self); } # ------------------------------------------------------------------------------- =pod =item B - is the value a well-formed HTTP or HTTPS uri? is_web_uri($value, \%options); =over 4 =item I This is just a convinience method that combines is_http_uri and is_https_uri to accept most common real-world URLs. But it's faster, because it does the work only once. =item I =over 4 =item $value The potential URI to test. =item \%options Options to be passed into the underlying Data::Validate::Domain module. If called as a method, the options are ignored. =back =item I Returns the untainted URI on success, undef on failure. =item I 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_web_uri{ my $self = shift if ref($_[0]); my $value = shift; $self //= shift; return _test_uri(3, $value, $self); } # ------------------------------------------------------------------------------- =pod =item B - is the value a well-formed telephone uri? is_tel_uri($value); =over 4 =item I 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 =over 4 =item $value The potential URI to test. =back =item I Returns the untainted URI on success, undef on failure. =item I 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{ my $value = shift; my @bits = $value =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; return @bits; } =pod =back =head1 SEE ALSO L, RFC 3986, RFC 3966, RFC 4694, RFC 4759, RFC 4904 =head1 AUTHOR Richard Sonnen >. is_tel_uri by David Dick >. =head1 COPYRIGHT Copyright (c) 2005 Richard Sonnen. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Data-Validate-URI-0.07/Makefile.PL0000644000175000017500000000116012647421415016341 0ustar vagrantvagrantuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Data::Validate::URI', 'VERSION_FROM' => 'lib/Data/Validate/URI.pm', # finds $VERSION 'DISTNAME' => 'Data-Validate-URI', 'AUTHOR' => 'Richard Sonnen (sonnen@richardsonnen.com)', 'PREREQ_PM' => { 'Data::Validate::Domain' => 0, 'Data::Validate::IP' => 0, }, 'dist' => { 'COMPRESS' => 'gzip -9f', 'SUFFIX' => 'gz', 'ZIP' => '/usr/bin/zip', 'ZIPFLAGS' => '-rl', }, ); Data-Validate-URI-0.07/README0000644000175000017500000001464512647421415015263 0ustar vagrantvagrantNAME Data::Validate::URI - common url validation methods SYNOPSIS use Data::Validate::URI qw(is_uri); if(is_uri($suspect)){ print "Looks like an URI\n"; } else { print "Not a URI\n"; } # or as an object my $v = Data::Validate::URI->new(); die "not a URI" unless ($v->is_uri('foo')); DESCRIPTION This module collects common URI validation routines to make input validation, and untainting easier and more readable. All functions return an untainted value if the test passes, and undef if it fails. This means that you should always check for a defined status explicitly. Don't assume the return will be true. The value to test is always the first (and often only) argument. There are a number of other URI validation modules out there as well (see below.) This one focuses on being fast, lightweight, and relatively 'real-world'. i.e. it's good if you want to check user input, and don't need to parse out the URI/URL into chunks. Right now the module focuses on HTTP URIs, since they're arguably the most common. If you have a specialized scheme you'd like to have supported, let me know. FUNCTIONS new - constructor for OO usage new(); *Description* Returns a Data::Validator::URI object. This lets you access all the validator function calls as methods without importing them into your namespace or using the clumsy Data::Validate::URI::function_name() format. *Arguments* None *Returns* Returns a Data::Validate::URI object is_uri - is the value a well-formed uri? is_uri($value); *Description* Returns the untainted URI if the test value appears to be well-formed. Note that you may really want one of the more practical methods like is_http_uri or is_https_uri, since the URI standard (RFC 3986) allows a lot of things you probably don't want. *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. is_http_uri - is the value a well-formed HTTP uri? is_http_uri($value); *Description* Specialized version of is_uri() that only likes http:// urls. As a result, it can also do a much more thorough job validating. Also, unlike is_uri() it is more concerned with only allowing real-world URIs through. Things like relative hostnames are allowed by the standards, but probably aren't wise. Conversely, null paths aren't allowed per RFC 2616 (should be '/' instead), but are allowed by this function. This function only works for fully-qualified URIs. /bob.html won't work. See RFC 3986 for the appropriate method to turn a relative URI into an absolute one given its context. Returns the untainted URI if the test value appears to be well-formed. Note that you probably want to either call this in combo with is_https_uri(). i.e. print "Good" if(is_http_uri($uri) || is_https_uri($uri)); or use the convenience method is_web_uri which is equivalent. *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. is_https_uri - is the value a well-formed HTTPS uri? is_https_uri($value); *Description* See is_http_uri() for details. This version only likes the https URI scheme. Otherwise it's identical to is_http_uri() *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. is_web_uri - is the value a well-formed HTTP or HTTPS uri? is_web_uri($value); *Description* This is just a convinience method that combines is_http_uri and is_https_uri to accept most common real-world URLs. *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. 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, RFC 3966, RFC 4694, RFC 4759, RFC 4904 AUTHOR Richard Sonnen . is_tel_uri by David Dick . COPYRIGHT Copyright (c) 2005 Richard Sonnen. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.