File Coverage

blib/lib/Data/Sah/Coerce/perl/obj/str_url.pm
Criterion Covered Total %
statement 18 19 94.7
branch 2 4 50.0
condition 2 4 50.0
subroutine 5 5 100.0
pod 0 2 0.0
total 27 34 79.4


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::obj::str_url;
2              
3             our $DATE = '2019-07-25'; # DATE
4             our $VERSION = '0.010'; # VERSION
5              
6 1     1   22274 use 5.010001;
  1         5  
7 1     1   9 use strict;
  1         3  
  1         25  
8 1     1   6 use warnings;
  1         2  
  1         205  
9              
10             sub meta {
11             +{
12 1     1 0 14 v => 4,
13             might_fail => 1,
14             prio => 50,
15             };
16             }
17              
18             sub coerce {
19 1     1 0 16 my %args = @_;
20              
21 1         3 my $dt = $args{data_term};
22 1   50     7 my $coerce_to = $args{coerce_to} // 'URI';
23              
24 1         3 my $res = {};
25              
26 1   50     7 $res->{modules}{'URI'} //= 0;
27 1         3 $res->{expr_match} = "!ref($dt)";
28 1 50       5 if ($coerce_to eq 'str') {
    50          
29 0         0 $res->{expr_coerce} = $dt;
30             } elsif ($coerce_to eq 'URI') {
31 1         3 $res->{expr_coerce} = join(
32             "",
33             "do { my \$url = URI->new($dt); if (!\$url) { ['Invalid URL'] } else { [undef, \$url] } }",
34             );
35             }
36 1         4 $res;
37             }
38              
39             1;
40             # ABSTRACT: Coerce URL object (URI) from string
41              
42             __END__
43              
44             =pod
45              
46             =encoding UTF-8
47              
48             =head1 NAME
49              
50             Data::Sah::Coerce::perl::obj::str_url - Coerce URL object (URI) from string
51              
52             =head1 VERSION
53              
54             This document describes version 0.010 of Data::Sah::Coerce::perl::obj::str_url (from Perl distribution Sah-Schemas-URL), released on 2019-07-25.
55              
56             =head1 DESCRIPTION
57              
58             =for Pod::Coverage ^(meta|coerce)$
59              
60             =head1 HOMEPAGE
61              
62             Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-URL>.
63              
64             =head1 SOURCE
65              
66             Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-URL>.
67              
68             =head1 BUGS
69              
70             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-URL>
71              
72             When submitting a bug or request, please include a test-file or a
73             patch to an existing test-file that illustrates the bug or desired
74             feature.
75              
76             =head1 AUTHOR
77              
78             perlancar <perlancar@cpan.org>
79              
80             =head1 COPYRIGHT AND LICENSE
81              
82             This software is copyright (c) 2019, 2018, 2017, 2016 by perlancar@cpan.org.
83              
84             This is free software; you can redistribute it and/or modify it under
85             the same terms as the Perl 5 programming language system itself.
86              
87             =cut