File Coverage

blib/lib/Mixin/Linewise/Writers.pm
Criterion Covered Total %
statement 41 51 80.3
branch 10 26 38.4
condition 4 9 44.4
subroutine 11 12 91.6
pod n/a
total 66 98 67.3


line stmt bran cond sub pod time code
1 1     1   14354 use strict;
  1         4  
  1         32  
2 1     1   6 use warnings;
  1         3  
  1         46  
3             package Mixin::Linewise::Writers 0.110;
4             # ABSTRACT: get linewise writers for strings and filenames
5              
6 1     1   24 use 5.008001; # PerlIO
  1         5  
7 1     1   7 use Carp ();
  1         2  
  1         36  
8 1     1   7 use IO::File;
  1         2  
  1         220  
9              
10             use Sub::Exporter -setup => {
11 1         3 exports => { map {; "write_$_" => \"_mk_write_$_" } qw(file string) },
  2         24  
12             groups => {
13             default => [ qw(write_file write_string) ],
14             writers => [ qw(write_file write_string) ],
15             },
16 1     1   9 };
  1         2  
17              
18             #pod =head1 SYNOPSIS
19             #pod
20             #pod package Your::Pkg;
21             #pod use Mixin::Linewise::Writers -writers;
22             #pod
23             #pod sub write_handle {
24             #pod my ($self, $data, $handle) = @_;
25             #pod
26             #pod $handle->print("datum: $_\n") for @$data;
27             #pod }
28             #pod
29             #pod Then:
30             #pod
31             #pod use Your::Pkg;
32             #pod
33             #pod Your::Pkg->write_file($data, $filename);
34             #pod
35             #pod Your::Pkg->write_string($data, $string);
36             #pod
37             #pod Your::Pkg->write_handle($data, $fh);
38             #pod
39             #pod =head1 EXPORTS
40             #pod
41             #pod C and C are exported by default. Either can be
42             #pod requested individually, or renamed. They are generated by
43             #pod L, so consult its documentation for more
44             #pod information.
45             #pod
46             #pod Both can be generated with the option "method" which requests that a method
47             #pod other than "write_handle" is called with the created IO::Handle.
48             #pod
49             #pod If given a "binmode" option, any C type functions will use
50             #pod that as an IO layer, otherwise, the default is C.
51             #pod
52             #pod use Mixin::Linewise::Writers -writers => { binmode => "raw" };
53             #pod use Mixin::Linewise::Writers -writers => { binmode => "encoding(iso-8859-1)" };
54             #pod
55             #pod =head2 write_file
56             #pod
57             #pod Your::Pkg->write_file($data, $filename);
58             #pod Your::Pkg->write_file($data, $options, $filename);
59             #pod
60             #pod This method will try to open a new file with the given name. It will then call
61             #pod C with that handle.
62             #pod
63             #pod An optional hash reference may be passed before C<$filename> with options.
64             #pod The only valid option currently is C, which overrides any
65             #pod default set from C or the built-in C.
66             #pod
67             #pod Any arguments after C<$filename> are passed along after to C.
68             #pod
69             #pod =cut
70              
71             sub _mk_write_file {
72 1     1   267 my ($self, $name, $arg) = @_;
73 1 50       5 my $method = defined $arg->{method} ? $arg->{method} : 'write_handle';
74 1 50       3 my $dflt_enc = defined $arg->{binmode} ? $arg->{binmode} : 'encoding(UTF-8)';
75              
76             sub {
77 0     0   0 my ($invocant, $data, $options, $filename);
78 0 0       0 if ( ref $_[2] eq 'HASH' ) {
79             # got options before filename
80 0         0 ($invocant, $data, $options, $filename) = splice @_, 0, 4;
81             }
82             else {
83 0         0 ($invocant, $data, $filename) = splice @_, 0, 3;
84             }
85              
86 0 0       0 my $binmode = defined $options->{binmode} ? $options->{binmode} : $dflt_enc;
87 0         0 $binmode =~ s/^://; # we add it later
88              
89             # Check the file
90 0 0       0 Carp::croak "no filename specified" unless $filename;
91 0 0 0     0 Carp::croak "'$filename' is not a plain file" if -e $filename && ! -f _;
92              
93             # Write out the file
94 0 0       0 my $handle = IO::File->new($filename, ">:$binmode")
95             or Carp::croak "couldn't write to file '$filename': $!";
96              
97 0         0 $invocant->write_handle($data, $handle, @_);
98             }
99 1         6 }
100              
101             #pod =head2 write_string
102             #pod
103             #pod my $string = Your::Pkg->write_string($data);
104             #pod my $string = Your::Pkg->write_string(\%option, $data);
105             #pod
106             #pod C will create a new handle on the given string, then call
107             #pod C to write to that handle, and return the resulting string.
108             #pod Because handles on strings must be octet-oriented, the string B
109             #pod octets>. It will be opened in the default binmode established by importing.
110             #pod (See L, above, and the options, below.)
111             #pod
112             #pod Any arguments after C<$data> are passed along after to C.
113             #pod
114             #pod Like C, this method can take a leading hashref with one valid
115             #pod argument: C.
116             #pod
117             #pod =cut
118              
119             sub _mk_write_string {
120 1     1   28 my ($self, $name, $arg) = @_;
121 1 50       4 my $method = defined $arg->{method} ? $arg->{method} : 'write_handle';
122 1 50       3 my $dflt_enc = defined $arg->{binmode} ? $arg->{binmode} : 'encoding(UTF-8)';
123              
124             sub {
125 2 100 66 2   5415 my ($opt) = @_ > 2 && ref $_[1] ? splice(@_, 1, 1) : undef;
126 2         10 my ($invocant, $data) = splice @_, 0, 2;
127              
128 2 100 66     13 my $binmode = ($opt && $opt->{binmode}) ? $opt->{binmode} : $dflt_enc;
129 2         8 $binmode =~ s/^://; # we add it later
130              
131 2         4 my $string = '';
132 1 50   1   9 open my $handle, ">:$binmode", \$string
  1     1   2  
  1         9  
  1         1016  
  1         2  
  1         5  
  2         69  
133             or die "error opening string for output: $!";
134              
135 2         1238 $invocant->write_handle($data, $handle, @_);
136 2 50       56 close $handle or die "error closing string after output: $!";
137              
138 2         13 return $string;
139             }
140 1         5 }
141              
142             1;
143              
144             __END__