Changeset 28138 for lang/perl/MouseX-Types-URI

Timestamp:

01/08/09 01:59:53 (4 years ago)

Author:

masaki

Message:

add tests

Location:

lang/perl/MouseX-Types-URI/trunk

Files:

• MANIFEST (modified) (1 diff)
• Makefile.PL (modified) (1 diff)
• lib/MouseX/Types/URI.pm (modified) (5 diffs)
• t/01_basic.t (added)
• xt/03_podspell.t (modified) (1 diff)

lang/perl/MouseX-Types-URI/trunk/MANIFEST

@@ -24 +24 @@
 README
 t/00_compile.t
+t/01_basic.t
 xt/01_pod.t
 xt/02_podcoverage.t

lang/perl/MouseX-Types-URI/trunk/Makefile.PL

@@ -10 +10 @@
 requires 'URI::FromHash';
 
+recommends 'MouseX::Getopt';
+
 tests 't/*.t';
 test_requires 'Test::More';

lang/perl/MouseX-Types-URI/trunk/lib/MouseX/Types/URI.pm

@@ -5 +5 @@
 use 5.8.1;
 use URI;
+use URI::WithBase;
+use URI::FromHash qw(uri);
+use URI::file;
 use URI::data;
-use URI::file;
-use URI::FromHash qw(uri);
-use URI::WithBase;
 use Mouse::TypeRegistry;
 use MouseX::Types::Mouse qw(Str ScalarRef HashRef);
@@ -15 +15 @@
 
 use MouseX::Types
-    -declare => [qw(Uri DataUri FileUri)]; # export Types
+    -declare => [qw(Uri FileUri DataUri)]; # export Types
 require Mouse;                             # for Mouse::TypeRegistry (Mouse::load_class)
 
 our $VERSION = '0.01';
 
-class_type $_ => { class => $_ }
-    for qw( URI URI::WithBase URI::data URI::file );
+subtype 'URI', # doesn't use class_type for 'URI'
+    where { $_->isa('URI') or $_->isa('URI::WithBase') };
+class_type $_ => { class => $_ } for qw( URI::file URI::data );
 
-subtype Uri,     where { $_->isa('URI') or $_->isa('URI::WithBase') };
+subtype Uri,     as 'URI';
+subtype FileUri, as 'URI::file';
 subtype DataUri, as 'URI::data';
-subtype FileUri, as 'URI::file';
 
 for my $type ( 'URI', Uri ) {
     coerce $type,
         from Str,                 via { URI->new($_) },
-        from ScalarRef,           via { my $u = URI->new("data:"); $u->data($$_); $u },
+        from ScalarRef,           via { my $u = URI->new('data:'); $u->data($$_); $u },
         from HashRef,             via { uri(%$_) },
         from 'Path::Class::Dir',  via { URI::file->new($_) },
         from 'Path::Class::File', via { URI::file->new($_) };
-}
-
-for my $type ( 'URI::data', DataUri ) {
-    coerce $type,
-        from Str,       via { my $u = URI->new("data:"); $u->data($_);  $u },
-        from ScalarRef, via { my $u = URI->new("data:"); $u->data($$_); $u };
 }
 
@@ -47 +42 @@
         from 'Path::Class::Dir',  via { URI::file->new($_) },
         from 'Path::Class::File', via { URI::file->new($_) };
+}
+
+for my $type ( 'URI::data', DataUri ) {
+    coerce $type,
+        from Str, via {
+            /^data:/ ? URI->new($_) : do { my $u = URI->new('data:'); $u->data($_); $u }
+        },
+        from ScalarRef, via {
+            $$_ =~ /^data:/ ? URI->new($$_) : do { my $u = URI->new('data:'); $u->data($$_); $u }
+        };
+}
+
+# optionally add Getopt option type
+eval { require MouseX::Getopt::OptionTypeMap };
+unless ($@) {
+    MouseX::Getopt::OptionTypeMap->add_option_type_to_map($_, '=s')
+        for ( 'URI', 'URI::data', 'URI::file', Uri, DataUri, FileUri );
 }
 
@@ -57 +69 @@
 =head1 SYNOPSIS
 
+=head2 CLASS TYPES
+
+  package MyApp;
+  use Mouse;
+  use MouseX::Types::URI;
+  with 'MouseX::Getopt'; # optional
+
+  has 'uri' => (
+      is     => 'rw',
+      isa    => 'URI',
+      coerce => 1,
+  );
+
+  has 'data' => (
+      is     => 'rw',
+      isa    => 'URI::data',
+      coerce => 1,
+  );
+
+  has 'file' => (
+      is     => 'rw',
+      isa    => 'URI::file',
+      coerce => 1,
+  );
+
+=head2 CUSTOM TYPES
+
   package MyApp;
   use Mouse;
   use MouseX::Types::URI qw(Uri DataUri FileUri);
+  with 'MouseX::Getopt'; # optional
 
   has 'uri' => (
@@ -84 +124 @@
 coercions and option specifications useful for dealing
 with L<URI>s as L<Mouse> attributes.
+
+Coercions (see L<Mouse::TypeRegistry>) are made from
+C<Str>, C<ScalarRef>, C<HashRef>,
+L<Path::Class::Dir> and L<Path::Class::File> to
+L<URI>, L<URI::data> and L<URI::file> objects.
+
+If you have L<MouseX::Getopt> installed,
+the Getopt option type ("=s") will be added
+for L<URI>, L<URI::data> and L<URI::file>.
 
 =head1 TYPES

lang/perl/MouseX-Types-URI/trunk/xt/03_podspell.t

@@ -22 +22 @@
 Yuval Kogman
 Uri DataUri FileUri
+Getopt