[libtypes-uri-perl] 02/15: add an Iri type constraint; same as Uri but uses kasei's IRI class; coercions between Uri and Iri

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libtypes-uri-perl.

commit f23dded75bd4b0fbfba3c1a204b0b42667565c50
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Sat Sep 27 19:12:06 2014 +0100

    add an Iri type constraint; same as Uri but uses kasei's IRI class; coercions between Uri and Iri
---
 lib/Types/URI.pm | 44 ++++++++++++++++++++++++++++++++++++++++++--
 t/03iri.t        | 15 +++++++++++++++
 2 files changed, 57 insertions(+), 2 deletions(-)

diff --git a/lib/Types/URI.pm b/lib/Types/URI.pm
index 876e802..62cba22 100644
--- a/lib/Types/URI.pm
+++ b/lib/Types/URI.pm
@@ -13,7 +13,7 @@ use URI::data;
 use URI::WithBase;
 use URI::FromHash;
 
-use Type::Library -base, -declare => qw( Uri FileUri DataUri );
+use Type::Library -base, -declare => qw( Uri FileUri DataUri Iri );
 
 use Types::Path::Tiny  qw( Path );
 use Types::Standard    qw( InstanceOf ScalarRef HashRef Str );
@@ -24,6 +24,13 @@ my $TrineNS   = InstanceOf['RDF::Trine::Namespace'];
 my $XmlNS     = InstanceOf['XML::Namespace'];
 
 __PACKAGE__->meta->add_type({
+	name        => Iri,
+	parent      => InstanceOf['IRI'],
+	# Need to define coercions below to break circularity of
+	# Uri and Iri.
+});
+
+__PACKAGE__->meta->add_type({
 	name        => Uri,
 	parent      => InstanceOf[qw/ URI URI::WithBase /],
 	coercion    => [
@@ -35,9 +42,22 @@ __PACKAGE__->meta->add_type({
 		$TrineNode  ,=> q{ "URI"->new($_->uri_value) },
 		$TrineNS    ,=> q{ "URI"->new($_->uri->uri_value) },
 		$XmlNS      ,=> q{ "URI"->new($_->uri) },
+		Iri         ,=> q{ "URI"->new($_->as_string) },
 	],
 });
 
+Iri->coercion->add_type_coercions(
+	Uuid        ,=> q{ do { use IRI (); "IRI"->new("urn:uuid:$_") } },
+	Str         ,=> q{ do { use IRI (); "IRI"->new($_) } },
+	Path        ,=> q{ do { use IRI (); my $u = "URI::file"->new($_); "IRI"->new($u->as_string) } },
+	ScalarRef   ,=> q{ do { use IRI (); my $u = "URI"->new("data:"); $u->data($$_); "IRI"->new($u->as_string) } },
+	HashRef     ,=> q{ do { use IRI (); "IRI"->new(URI::FromHash::uri(%$_)) } },
+	$TrineNode  ,=> q{ do { use IRI (); "IRI"->new($_->uri_value) } },
+	$TrineNS    ,=> q{ do { use IRI (); "IRI"->new($_->uri->uri_value) } },
+	$XmlNS      ,=> q{ do { use IRI (); "IRI"->new($_->uri) } },
+	Uri         ,=> q{ do { use IRI (); "IRI"->new($_->as_string) } },
+);
+
 __PACKAGE__->meta->add_type({
 	name        => FileUri,
 	parent      => Uri,
@@ -50,6 +70,7 @@ __PACKAGE__->meta->add_type({
 		$TrineNode  ,=> q{ "URI"->new($_->uri_value) },
 		$TrineNS    ,=> q{ "URI"->new($_->uri->uri_value) },
 		$XmlNS      ,=> q{ "URI"->new($_->uri) },
+		Iri         ,=> q{ "URI"->new($_->as_string) },
 	],
 });
 
@@ -65,6 +86,7 @@ __PACKAGE__->meta->add_type({
 		$TrineNode  ,=> q{ "URI"->new($_->uri_value) },
 		$TrineNS    ,=> q{ "URI"->new($_->uri->uri_value) },
 		$XmlNS      ,=> q{ "URI"->new($_->uri) },
+		Iri         ,=> q{ "URI"->new($_->as_string) },
 	],
 });
 
@@ -132,6 +154,10 @@ Uses L<URI::data/new>.
 
 Coerces using L<URI::FromHash>.
 
+=item from C<Iri>
+
+Uses L<URI/new>.
+
 =item from L<RDF::Trine::Node::Resource>, L<RDF::Trine::Namespace>, L<XML::Namespace>
 
 Uses L<URI/new>.
@@ -156,6 +182,10 @@ Uses L<URI::file/new>. (See L<Types::Path::Tiny>.)
 
 Coerces using L<URI::FromHash>.
 
+=item from C<Iri>
+
+Uses L<URI/new>.
+
 =item from L<RDF::Trine::Node::Resource>, L<RDF::Trine::Namespace>, L<XML::Namespace>
 
 Uses L<URI/new>.
@@ -180,12 +210,21 @@ Uses L<URI::data/new>.
 
 Coerces using L<URI::FromHash>.
 
+=item from C<Iri>
+
+Uses L<URI/new>.
+
 =item from L<RDF::Trine::Node::Resource>, L<RDF::Trine::Namespace>, L<XML::Namespace>
 
 Uses L<URI/new>.
 
 =back
 
+=item C<Iri>
+
+A class type for L<IRI>. Coercions as per C<Uri> above, plus can coerce
+from C<Uri>.
+
 =back
 
 =head1 BUGS
@@ -201,7 +240,8 @@ L<URI>,
 L<URI::file>,
 L<URI::data>,
 L<URI::FromHash>,
-L<RDF::Trine::Node::Resource>.
+L<RDF::Trine::Node::Resource>,
+L<IRI>.
 
 L<Types::UUID>,
 L<Types::Path::Tiny>,
diff --git a/t/03iri.t b/t/03iri.t
new file mode 100644
index 0000000..cd47684
--- /dev/null
+++ b/t/03iri.t
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires { 'IRI' => '0.004' };
+use Types::URI qw( to_Uri to_Iri );
+
+my $uri = to_Uri("IRI"->new('http://www.example.net/'));
+isa_ok($uri, 'URI');
+is("$uri", 'http://www.example.net/');
+
+my $iri = to_Iri($uri);
+isa_ok($iri, 'IRI');
+is($iri->as_string, 'http://www.example.net/');
+
+done_testing;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libtypes-uri-perl.git