File Coverage

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