File Coverage

blib/lib/Regexp/Common/URI/gopher.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	28	28	100.0

package Regexp::Common::URI::gopher;

use Regexp::Common               qw /pattern clean no_defaults/;
use Regexp::Common::URI          qw /register_uri/;
use Regexp::Common::URI::RFC1738 qw /$host $port $uchars/;
use Regexp::Common::URI::RFC1808 qw /$pchars $pchar_range/;

use strict;
use warnings;

use vars qw /$VERSION/;
$VERSION = '2016060801';


my $pchars_notab      = "(?:(?:[$pchar_range]+|" .
                        "%(?:[1-9a-fA-F][0-9a-fA-F]|0[0-8a-fA-F]))*)";

my $gopherplus_string = $pchars;
my $search            = $pchars;
my $search_notab      = $pchars_notab;
my $selector          = $pchars;
my $selector_notab    = $pchars_notab;
my $gopher_type       = "(?:[0-9+IgT])";

my $scheme     = "gopher";
my $uri        = "(?k:(?k:$scheme)://(?k:$host)(?::(?k:$port))?" .
                 "/(?k:(?k:$gopher_type)(?k:$selector)))";
my $uri_notab  = "(?k:(?k:$scheme)://(?k:$host)(?::(?k:$port))?"              .
                 "/(?k:(?k:$gopher_type)(?k:$selector_notab)"                 .
                 "(?:%09(?k:$search_notab)(?:%09(?k:$gopherplus_string))?)?))";

register_uri $scheme => $uri;

pattern name    => [qw (URI gopher -notab=)],
        create  => sub { exists $_ [1] {-notab} &&
                       !defined $_ [1] {-notab} ? $uri_notab : $uri},
        ;

1;

__END__