File Coverage

blib/lib/MAB2/Writer/Handle.pm
Criterion Covered Total %
statement 28 28 100.0
branch 3 4 75.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 42 43 97.6


line stmt bran cond sub pod time code
1             package MAB2::Writer::Handle;
2              
3             our $VERSION = '0.23';
4              
5 3     3   8080 use strict;
  3         7  
  3         79  
6 3     3   13 use Moo::Role;
  3         6  
  3         18  
7 3     3   911 use Carp qw(croak);
  3         6  
  3         122  
8 3     3   855 use Encode qw(find_encoding);
  3         22135  
  3         205  
9 3     3   17 use Scalar::Util qw(blessed openhandle);
  3         6  
  3         1180  
10              
11             has encoding => (
12             is => 'rw',
13             isa => sub {
14             find_encoding($_[0]) or croak "encoding \"$_[0]\" is not a valid encoding";
15             },
16             default => sub { 'UTF-8' },
17             );
18              
19             has file => (
20             is => 'rw',
21             isa => sub {
22             croak 'expect file!' unless defined $_[0];
23             },
24             trigger => \&_set_fh,
25             );
26              
27             has fh => (
28             is => 'rw',
29             isa => sub {
30             my $ishandle = eval { fileno( $_[0] ); };
31             croak 'expect filehandle or object with method print!'
32             unless !$@ and defined $ishandle
33             or ( blessed $_[0] && $_[0]->can('print') );
34             },
35             default => sub { \*STDOUT }
36             );
37              
38             sub _set_fh {
39 1     1   6 my ($self) = @_;
40              
41 1         20 my $encoding = $self->encoding;
42 1 50   1   36 open my $fh, ">:encoding($encoding)", $self->file
  1         32  
  1         2  
  1         5  
43             or croak 'could not open file!';
44 1         815 $self->fh($fh);
45             }
46              
47             sub close_fh {
48 4     4 1 31 my ($self) = @_;
49              
50 4         346 close $self->{fh};
51             }
52              
53             sub write {
54 16     16 1 156 my ($self, @records) = @_;
55              
56 16         29 foreach my $record (@records) {
57 16 100       37 $record = $record->{record} if ref $record eq 'HASH';
58 16         42 $self->_write_record($record);
59             }
60             }
61              
62              
63             1;
64              
65             __END__
66              
67             =pod
68              
69             =encoding UTF-8
70              
71             =head1 NAME
72              
73             MAB2::Writer::Handle - Utility class for common MAB2::Writer arguments and methods.
74              
75             =head1 Arguments
76              
77             =over
78              
79             =item C<file>
80              
81             Path to file.
82              
83             =item C<fh>
84              
85             Open filehandle.
86              
87             =item C<encoding>
88              
89             Set encoding.
90              
91             =back
92              
93             =head1 METHODS
94              
95             =head2 _set_fh()
96              
97             Open filehandle (with specified encoding) from file.
98              
99             =head2 close_fh()
100              
101             Close filehandle.
102              
103             =head2 write()
104              
105             Write record to filehandle.
106              
107             =head1 AUTHOR
108              
109             Johann Rolschewski <jorol@cpan.org>
110              
111             =head1 COPYRIGHT AND LICENSE
112              
113             This software is copyright (c) 2013 by Johann Rolschewski.
114              
115             This is free software; you can redistribute it and/or modify it under
116             the same terms as the Perl 5 programming language system itself.
117              
118             =cut