File Coverage

lib/IOMux/File/Write.pm
Criterion Covered Total %
statement 43 46 93.4
branch 13 20 65.0
condition 4 8 50.0
subroutine 9 10 90.0
pod 2 3 66.6
total 71 87 81.6


line stmt bran cond sub pod time code
1             # Copyrights 2011-2020 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.02.
5             # This code is part of distribution IOMux. Meta-POD processed with OODoc
6             # into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package IOMux::File::Write;
10 3     3   2227 use vars '$VERSION';
  3         6  
  3         141  
11             $VERSION = '1.01';
12              
13 3     3   16 use base 'IOMux::Handler::Write';
  3         7  
  3         843  
14              
15 3     3   19 use warnings;
  3         6  
  3         75  
16 3     3   14 use strict;
  3         4  
  3         69  
17              
18 3     3   12 use Log::Report 'iomux';
  3         6  
  3         15  
19 3     3   634 use Fcntl;
  3         4  
  3         655  
20 3     3   21 use File::Basename 'basename';
  3         5  
  3         1115  
21              
22              
23             sub init($)
24 4     4 0 7 { my ($self, $args) = @_;
25              
26             my $file = $args->{file}
27 4 50       13 or error __x"no file to open specified in {pkg}", pkg => __PACKAGE__;
28              
29 4         5 my $flags = $args->{modeflags};
30 4   100     15 my $mode = $args->{mode} || '>';
31 4 50 33     19 unless(ref $file || defined $flags)
32 4 100       24 { if($mode eq '>>') { $args->{append} = 1 }
  1 50       2  
33 3 100       11 elsif($mode eq '>') { $mode = '>>' if $args->{append} }
34             else
35 0         0 { error __x"unknown file mode '{mode}' for {fn} in {pkg}"
36             , mode => $mode, fn => $file, pkg => __PACKAGE__;
37             }
38            
39 4         6 $flags = O_WRONLY|O_NONBLOCK;
40 4 50 33     13 $flags |= O_CREAT unless exists $args->{create} && !$args->{create};
41 4 100       11 $flags |= O_APPEND if $args->{append};
42 4 50       13 $flags |= O_EXCL if $args->{exclusive};
43             }
44              
45 4         6 my $fh;
46 4 50       27 if(ref $file)
47 0         0 { $fh = $file;
48             }
49             else
50 4 50       326 { sysopen $fh, $file, $flags
51             or fault __x"cannot open file {fn} for {pkg}"
52             , fn => $file, pkg => __PACKAGE__;
53 4         32 $self->{IMFW_mode} = $flags;
54             }
55 4         203 $args->{name} = $mode.(basename $file);
56 4         12 $args->{fh} = $fh;
57              
58 4         30 $self->SUPER::init($args);
59 4         14 $self;
60             }
61              
62              
63             sub open($$@)
64 2     2 1 5 { my ($class, $mode, $file, %args) = @_;
65 2         8 $class->new(file => $file, mode => $mode, %args);
66             }
67              
68              
69             #-------------------
70              
71 0     0 1   sub mode() {shift->{IMFW_mode}}
72              
73             1;