File Coverage

blib/lib/IO/Socket/UNIX.pm
Criterion Covered Total %
statement 25 32 78.1
branch 12 24 50.0
condition 6 11 54.5
subroutine 5 7 71.4
pod 3 4 75.0
total 51 78 65.3


line stmt bran cond sub pod time code
1             # IO::Socket::UNIX.pm
2             #
3             # Copyright (c) 1997-8 Graham Barr . All rights reserved.
4             # This program is free software; you can redistribute it and/or
5             # modify it under the same terms as Perl itself.
6              
7             package IO::Socket::UNIX;
8              
9 17     17   102 use strict;
  17         26  
  17         436  
10 17     17   67 use IO::Socket;
  17         26  
  17         88  
11 17     17   106 use Carp;
  17         30  
  17         8055  
12              
13             our @ISA = qw(IO::Socket);
14             our $VERSION = "1.51";
15              
16             IO::Socket::UNIX->register_domain( AF_UNIX );
17              
18             sub new {
19 9     9 1 1608905 my $class = shift;
20 9 50       107 unshift(@_, "Peer") if @_ == 1;
21 9         125 return $class->SUPER::new(@_);
22             }
23              
24             sub configure {
25 7     7 0 19 my($sock,$arg) = @_;
26 7         17 my($bport,$cport);
27              
28 7   100     87 my $type = $arg->{Type} || SOCK_STREAM;
29              
30 7 50       85 $sock->socket(AF_UNIX, $type, 0) or
31             return undef;
32              
33 7 50       26 if(exists $arg->{Blocking}) {
34 0 0       0 $sock->blocking($arg->{Blocking}) or
35             return undef;
36             }
37 7 100       23 if(exists $arg->{Local}) {
38 5         27 my $addr = sockaddr_un($arg->{Local});
39 5 50       84 $sock->bind($addr) or
40             return undef;
41             }
42 7 100 66     72 if(exists $arg->{Listen} && $type != SOCK_DGRAM) {
    100          
43 4 50 100     64 $sock->listen($arg->{Listen} || 5) or
44             return undef;
45             }
46             elsif(exists $arg->{Peer}) {
47 2         62 my $addr = sockaddr_un($arg->{Peer});
48 2 50       247 $sock->connect($addr) or
49             return undef;
50             }
51              
52 7         77 $sock;
53             }
54              
55             sub hostpath {
56 0 0   0 1   @_ == 1 or croak 'usage: $sock->hostpath()';
57 0   0       my $n = $_[0]->sockname || return undef;
58 0           (sockaddr_un($n))[0];
59             }
60              
61             sub peerpath {
62 0 0   0 1   @_ == 1 or croak 'usage: $sock->peerpath()';
63 0   0       my $n = $_[0]->peername || return undef;
64 0           (sockaddr_un($n))[0];
65             }
66              
67             1; # Keep require happy
68              
69             __END__