view release on metacpan or  search on metacpan

lib/AnyEvent/ZeroMQ/Types.pm  view on Meta::CPAN

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
        return 1 if $proto eq 'inproc';
        return 1 if $proto eq 'ipc';
        return 1 if $proto eq 'tcp' && $rest =~ /^(?:$host|$ip|$interface|\*)$andport$/;
        return 1
            if ($proto eq 'pgm' || $proto eq 'epgm') &&
                $rest =~ /^(?:$interface|$ip);$ip$andport$/;
        return 0;
    }
    return 0;
 
}, message { 'An endpoint must be in the form "<transport>://<address>"' };
 
subtype Endpoints, as ArrayRef[Endpoint], message {
    'Each endpoint must be in the form "<transport>://<address>"';
};
 
sub fixup_endpoint() {
    s{(^[/])/$}{$1}g;
}
 
coerce Endpoint, from Str, via { fixup_endpoint };
 
coerce Endpoints, from ArrayRef[Str], via {
    my @array = @$_;
    fixup_endpoint for @array;
    $_ = [@array];
};
 
my %allowed_sockettype = map { ZeroMQ::Raw::Constants->$_ => $_ } @socket_constants;
subtype SocketType, as Int, where {
    exists $allowed_sockettype{$_};
}, message { 'A socket type must be one of: '. join(', ', @socket_constants) };
 
subtype IdentityStr, as Str, where {
    length $_ < 256 && length $_ >= 0;

t/types.t  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
use strict;
use warnings;
use AnyEvent::ZeroMQ::Types qw(Endpoint);
use Test::TableDriven (
    endpoint => {
        'foo'                          => 0,
        'tcp://127.0.0.1:123/'         => 0,
        'tcp://127.0.0.1:123'          => 1,
        'tcp://host-name.com:123'      => 1,
        'tcp://eth0:123'               => 1,
        'inproc://#1'                  => 1,
        'ipc://file/name.goes_here'    => 1,
        'pgm://eth0;239.1.1.1:123'     => 1,
        'epgm://1.2.3.4;239.1.1.1:123' => 1,
        'pgm://foo:123/'               => 0,
        'tcp://'                       => 0,
        'inproc://'                    => 0,
        'pgm://'                       => 0,
        'egpm://'                      => 0,
        'ipc://'                       => 0,
        'tcp://*:1234'                 => 1,
    },
);
 
sub endpoint {
    my $in = shift;
    return Endpoint()->validate($in) ? 0 : 1;
}
 
runtests;