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

use strict;
use warnings;
package Mixin::Linewise::Writers 0.111;
# ABSTRACT: get linewise writers for strings and filenames

use 5.008001; # PerlIO
use Carp ();
use IO::File;

use Sub::Exporter -setup => {
  exports => { map {; "write_$_" => \"_mk_write_$_" } qw(file string) },
  groups  => {
    default => [ qw(write_file write_string) ],
    writers => [ qw(write_file write_string) ],
  },
};

#pod =head1 SYNOPSIS
#pod
#pod   package Your::Pkg;
#pod   use Mixin::Linewise::Writers -writers;
#pod
#pod   sub write_handle {
#pod     my ($self, $data, $handle) = @_;
#pod
#pod     $handle->print("datum: $_\n") for @$data;
#pod   }
#pod
#pod Then:
#pod
#pod   use Your::Pkg;
#pod
#pod   Your::Pkg->write_file($data, $filename);
#pod
#pod   Your::Pkg->write_string($data, $string);
#pod
#pod   Your::Pkg->write_handle($data, $fh);
#pod
#pod =head1 EXPORTS
#pod
#pod C and C are exported by default.  Either can be
#pod requested individually, or renamed.  They are generated by
#pod L, so consult its documentation for more
#pod information.
#pod
#pod Both can be generated with the option "method" which requests that a method
#pod other than "write_handle" is called with the created IO::Handle.
#pod
#pod If given a "binmode" option, any C type functions will use
#pod that as an IO layer, otherwise, the default is C.
#pod
#pod   use Mixin::Linewise::Writers -writers => { binmode => "raw" };
#pod   use Mixin::Linewise::Writers -writers => { binmode => "encoding(iso-8859-1)" };
#pod
#pod =head2 write_file
#pod
#pod   Your::Pkg->write_file($data, $filename);
#pod   Your::Pkg->write_file($data, $options, $filename);
#pod
#pod This method will try to open a new file with the given name.  It will then call
#pod C with that handle.
#pod
#pod An optional hash reference may be passed before C<$filename> with options.
#pod The only valid option currently is C, which overrides any
#pod default set from C or the built-in C.
#pod
#pod Any arguments after C<$filename> are passed along after to C.
#pod
#pod =cut

sub _mk_write_file {
  my ($self, $name, $arg) = @_;
  my $method = defined $arg->{method} ? $arg->{method} : 'write_handle';
  my $dflt_enc = defined $arg->{binmode} ? $arg->{binmode} : 'encoding(UTF-8)';

  sub {
    my ($invocant, $data, $options, $filename);
    if ( ref $_[2] eq 'HASH' ) {
      # got options before filename
      ($invocant, $data, $options, $filename) = splice @_, 0, 4;
    }
    else {
      ($invocant, $data, $filename) = splice @_, 0, 3;
    }

    my $binmode = defined $options->{binmode} ? $options->{binmode} : $dflt_enc;
    $binmode =~ s/^://; # we add it later

    # Check the file
    Carp::croak "no filename specified"           unless $filename;
    Carp::croak "'$filename' is not a plain file" if -e $filename && ! -f _;

    # Write out the file
    my $handle = IO::File->new($filename, ">:$binmode")
      or Carp::croak "couldn't write to file '$filename': $!";

    $invocant->write_handle($data, $handle, @_);
  }
}

#pod =head2 write_string
#pod
#pod   my $string = Your::Pkg->write_string($data);
#pod   my $string = Your::Pkg->write_string(\%option, $data);
#pod
#pod C will create a new handle on the given string, then call
#pod C to write to that handle, and return the resulting string.
#pod Because handles on strings must be octet-oriented, the string B
#pod octets>.  It will be opened in the default binmode established by importing.
#pod (See L, above, and the options, below.)
#pod
#pod Any arguments after C<$data> are passed along after to C.
#pod
#pod Like C, this method can take a leading hashref with one valid
#pod argument: C.
#pod
#pod =cut

sub _mk_write_string {
  my ($self, $name, $arg) = @_;
  my $method = defined $arg->{method} ? $arg->{method} : 'write_handle';
  my $dflt_enc = defined $arg->{binmode} ? $arg->{binmode} : 'encoding(UTF-8)';

  sub {
    my ($opt) = @_ > 2 && ref $_[1] ? splice(@_, 1, 1) : undef;
    my ($invocant, $data) = splice @_, 0, 2;

    my $binmode = ($opt && $opt->{binmode}) ? $opt->{binmode} : $dflt_enc;
    $binmode =~ s/^://; # we add it later

    my $string = '';
    open my $handle, ">:$binmode", \$string
      or die "error opening string for output: $!";

    $invocant->write_handle($data, $handle, @_);
    close $handle or die "error closing string after output: $!";

    return $string;
  }
}

1;

__END__