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 71     71   242 use Regexp::Common qw /pattern clean no_defaults/;
  71         115  
  71         316  
4 71     71   254 use Regexp::Common::URI qw /register_uri/;
  71         113  
  71         2681  
5 71         6273 use Regexp::Common::URI::RFC2396 qw /$host $port $ftp_segments $userinfo
6 71     71   239 $userinfo_no_colon/;
  71         67  
7              
8 71     71   259 use strict;
  71         71  
  71         1141  
9 71     71   297 use warnings;
  71         78  
  71         1725  
10              
11 71     71   274 use vars qw /$VERSION/;
  71         80  
  71         13098  
12             $VERSION = '2016060801';
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__