File Coverage

blib/lib/Socket/MsgHdr.pm
Criterion Covered Total %
statement 47 47 100.0
branch 13 16 81.2
condition n/a
subroutine 12 12 100.0
pod 3 3 100.0
total 75 78 96.1


line stmt bran cond sub pod time code
1             package Socket::MsgHdr;
2              
3 4     4   218443 use 5.006;
  4         34  
4 4     4   21 use strict;
  4         6  
  4         323  
5             #use bytes;
6              
7             our @EXPORT = qw( sendmsg recvmsg );
8             our @EXPORT_OK = qw( pack_cmsghdr unpack_cmsghdr ); # Undocumented!
9             our $VERSION = '0.05';
10              
11             # Forcibly export our sendmsg, recvmsg methods
12             BEGIN {
13 4     4   21 *IO::Socket::sendmsg = \&sendmsg;
14 4         335 *IO::Socket::recvmsg = \&recvmsg;
15             }
16              
17             # Define our simple accessor/mutator methods
18              
19             sub flags {
20 2     2 1 35 my $self = shift;
21 2 100       10 $self->{flags} = shift if @_;
22 2 50       6 $self->{flags} = 0 unless defined $self->{flags};
23 2         7 $self->{flags};
24             }
25              
26             BEGIN {
27 4     4   17 for my $attr (qw|name buf control|) {
28 4     4   26 no strict 'refs';
  4         8  
  4         385  
29              
30 12         71 *{$attr} = sub {
31 72     72   236 my $self = shift;
32 72 100       180 $self->{$attr} = shift if @_;
33 72 100       148 $self->{$attr} = '' unless defined $self->{$attr};
34 72         182 $self->{$attr};
35 12         51 };
36             }
37              
38 4         16 foreach my $attr (qw|name buf control|) {
39 4     4   37 no strict 'refs';
  4         8  
  4         678  
40 12         961 *{$attr . "len"} = sub {
41 28     28   49 my $self = shift;
42 28         65 my $olen = length($self->$attr);
43 28 100       77 return $olen unless @_;
44 19         26 my $nlen = shift;
45              
46 19 50       40 if ($nlen != $olen) {
47             $self->{$attr} = $olen > $nlen ?
48 19 50       93 substr($self->{$attr}, 0, $nlen) :
49             "\x00" x $nlen;
50             }
51 19         51 $nlen;
52 12         69 };
53             }
54              
55             }
56              
57             # XS functions
58             # ============
59             #
60             # -- sendmsg, recvmsg, pack_cmsghdr, unpack_cmsghdr
61             #
62             require XSLoader;
63             XSLoader::load('Socket::MsgHdr', $VERSION);
64              
65             # Module import
66             # =============
67             #
68             sub import {
69 3     3   29 require Exporter;
70 3         2965 goto &Exporter::import;
71             }
72              
73             # Constructor
74             # ===========
75             #
76             sub new {
77 27     27 1 13989 my $class = shift;
78 27         98 my $self = { name => '',
79             control => '',
80             buf => '',
81             flags => 0 };
82              
83 27         53 bless $self, $class;
84              
85 27         71 my %args = @_;
86 27         88 foreach my $m (keys %args) {
87 38         116 $self->$m($args{$m});
88             }
89              
90 27         99 return $self;
91             }
92              
93             # Methods
94             # =======
95             #
96             # -- cmsghdr
97             #
98             sub cmsghdr {
99 6     6 1 80 my $self = shift;
100 6 100       31 unless (@_) { return &unpack_cmsghdr($self->{control}); }
  2         17  
101 4         32 $self->{control} = &pack_cmsghdr(@_);
102             }
103              
104             # -- name, buf, control, flags
105             # -- namelen, buflen, controllen
106             # (loaded in INIT)
107              
108             1;
109             __END__