File Coverage

lib/POSIX/1003/FdIO.pm
Criterion Covered Total %
statement 39 48 81.2
branch 4 14 28.5
condition n/a
subroutine 12 20 60.0
pod 13 13 100.0
total 68 95 71.5


line stmt bran cond sub pod time code
1             # Copyrights 2011-2015 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.01.
5 6     6   41718 use warnings;
  6         9  
  6         144  
6 6     6   18 use strict;
  6         6  
  6         163  
7              
8             package POSIX::1003::FdIO;
9 6     6   16 use vars '$VERSION';
  6         6  
  6         238  
10             $VERSION = '0.99_07';
11              
12 6     6   18 use base 'POSIX::1003::Module';
  6         6  
  6         1410  
13              
14             # Blocks resp from unistd.h, limits.h, and stdio.h
15             my (@constants, @seek, @mode);
16             my @functions = qw/closefd creatfd dupfd dup2fd openfd pipefd
17             readfd seekfd writefd tellfd truncfd fdopen/;
18              
19             our %EXPORT_TAGS =
20             ( constants => \@constants
21             , functions => \@functions
22             , seek => \@seek
23             , mode => \@mode
24             , tables => [ qw/%seek %mode/ ]
25             );
26              
27             my $fdio;
28             our (%fdio, %seek, %mode);
29              
30             BEGIN {
31 6     6   164 $fdio = fdio_table;
32 6         51 push @constants, keys %$fdio;
33              
34             # initialize the :seek export tag
35 6         65 push @seek, grep /^SEEK_/, keys %$fdio;
36 6         11 my %seek_subset;
37 6         605 @seek_subset{@seek} = @{$fdio}{@seek};
  6         21  
38 6         28 tie %seek, 'POSIX::1003::ReadOnlyTable', \%seek_subset;
39              
40             # initialize the :mode export tag
41 6         77 push @mode, grep /^O_/, keys %$fdio;
42 6         11 my %mode_subset;
43 6         4 @mode_subset{@mode} = @{$fdio}{@mode};
  6         37  
44 6         14 tie %mode, 'POSIX::1003::ReadOnlyTable', \%mode_subset;
45             }
46              
47              
48 5     5 1 2086 sub seekfd($$$) { goto &POSIX::lseek }
49 4     4 1 581 sub openfd($$;$) { goto &POSIX::open }
50 5     5 1 2055 sub closefd($) { goto &POSIX::close }
51 1 50   1 1 5 sub readfd($$;$) { push @_, SSIZE_MAX() if @_==2; goto &POSIX::read }
  1         14  
52 0 0   0 1 0 sub writefd($$;$) { push @_, length $_[1] if @_==2; goto &POSIX::write }
  0         0  
53 0     0 1 0 sub pipefd() { goto &POSIX::pipe }
54 0     0 1 0 sub dupfd($) { goto &POSIX::dup }
55 0     0 1 0 sub dup2fd($$) { goto &POSIX::dup2 }
56 0     0 1 0 sub statfd($) { goto &POSIX::fstat }
57 0     0 1 0 sub creatfd($$) { openfd $_[0], O_WRONLY()|O_CREAT()|O_TRUNC(), $_[1] }
58              
59              
60             # This is implemented via CORE::open, because we need an Perl FH, not a
61             # FILE *.
62              
63             sub fdopen($$)
64 1     1 1 3 { my ($fd, $mode) = @_;
65            
66 1 50       6 $mode =~ m/^([rwa]\+?|\<|\>|\>>)$/
67             or die "illegal fdopen() mode '$mode'\n";
68              
69 1 0       7 my $m = $1 eq 'r' ? '<' : $1 eq 'w' ? '>' : $1 eq 'a' ? '>>' : $1;
    0          
    50          
70              
71 1 50       3 die "fdopen() mode '$mode' (both read and write) is not supported\n"
72             if substr($m,-1) eq '+';
73              
74 1         29 open my($fh), "$m&=", $fd;
75 1         2 $fh;
76             }
77              
78              
79             #------------------
80              
81 1     1 1 5 sub tellfd($) {seekfd $_[0], 0, SEEK_CUR() }
82 0     0 1 0 sub rewindfd() {seekfd $_[0], 0, SEEK_SET() }
83              
84              
85             sub _create_constant($)
86 50     50   50 { my ($class, $name) = @_;
87 50         38 my $val = $fdio->{$name};
88 50     0   183 sub() {$val};
  0            
89             }
90              
91             1;