File Coverage

blib/lib/Regexp/Common/URI/ftp.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 24 24 100.0


line stmt bran cond sub pod time code
1             package Regexp::Common::URI::ftp;
2              
3 72     72   265 use Regexp::Common qw /pattern clean no_defaults/;
  72         81  
  72         365  
4 72     72   271 use Regexp::Common::URI qw /register_uri/;
  72         82  
  72         2738  
5 72         6324 use Regexp::Common::URI::RFC2396 qw /$host $port $ftp_segments $userinfo
6 72     72   258 $userinfo_no_colon/;
  72         74  
7              
8 72     72   277 use strict;
  72         71  
  72         1301  
9 72     72   222 use warnings;
  72         67  
  72         1678  
10              
11 72     72   218 use vars qw /$VERSION/;
  72         133  
  72         14262  
12             $VERSION = '2017040401';
13              
14              
15             my $ftp_uri = "(?k:(?k:ftp)://(?:(?k:$userinfo)(?k:)\@)?(?k:$host)" .
16             "(?::(?k:$port))?(?k:/(?k:(?k:$ftp_segments)" .
17             "(?:;type=(?k:[AIai]))?))?)";
18              
19             my $ftp_uri_password =
20             "(?k:(?k:ftp)://(?:(?k:$userinfo_no_colon)" .
21             "(?::(?k:$userinfo_no_colon))?\@)?(?k:$host)" .
22             "(?::(?k:$port))?(?k:/(?k:(?k:$ftp_segments)" .
23             "(?:;type=(?k:[AIai]))?))?)";
24              
25             register_uri FTP => $ftp_uri;
26              
27             pattern name => [qw (URI FTP), "-type=[AIai]", "-password="],
28             create => sub {
29             my $uri = exists $_ [1] -> {-password} &&
30             !defined $_ [1] -> {-password} ? $ftp_uri_password
31             : $ftp_uri;
32             my $type = $_ [1] -> {-type};
33             $uri =~ s/\[AIai\]/$type/;
34             $uri;
35             }
36             ;
37              
38              
39             1;
40              
41             __END__