File Coverage

blib/lib/Data/Printer/Filter/URI.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             package Data::Printer::Filter::URI;
2             # ABSTRACT: pretty-printing URI objects
3              
4 5     5   416715 use strict;
  5         11  
  5         187  
5 5     5   26 use utf8;
  5         9  
  5         38  
6 5     5   128 use warnings qw(all);
  5         11  
  5         196  
7              
8 5     5   4756 use Data::Printer::Filter;
  5         509490  
  5         34  
9 5     5   506 use Term::ANSIColor;
  5         9  
  5         2092  
10              
11             our $VERSION = '0.008'; # VERSION
12              
13              
14             our @schemes = qw(
15             URL
16             data
17             file
18             ftp
19             gopher
20             http
21             https
22             ldap
23             ldapi
24             ldaps
25             mailto
26             mms
27             news
28             nntp
29             pop
30             rlogin
31             rsync
32             rtsp
33             rtspu
34             sip
35             sips
36             snews
37             ssh
38             telnet
39             tn3270
40             urn
41             urn::oid
42             );
43              
44             filter $_ => sub {
45             my ($obj, $p) = @_;
46              
47             my $str = qq($obj);
48              
49             $str =~ s{^
50             \b
51             @{[$obj->scheme]}
52             \b
53             }{
54             colored(
55             $obj->scheme,
56             exists($p->{color}{uri_scheme})
57             ? $p->{color}{uri_scheme}
58             : q(bright_green)
59             )
60             }ex if defined $obj->scheme;
61              
62             $str =~ s{
63             \b
64             \Q@{[$obj->host]}\E
65             \b
66             }{
67             colored(
68             $obj->host,
69             exists($p->{color}{uri_host})
70             ? $p->{color}{uri_host}
71             : q(bold)
72             )
73             }ex if $obj->can(q(host))
74             and defined $obj->host;
75              
76             return $str;
77             } for qw(Mojo::URL), map +qq(URI::$_), @schemes, qw(
78             scp
79             sftp
80             urn::isbn
81             urn::uuid
82             );
83              
84             1;
85              
86             __END__