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.24';
4              
5 3     3   10679 use strict;
  3         8  
  3         101  
6 3     3   15 use Moo::Role;
  3         6  
  3         20  
7 3     3   1049 use Carp qw(croak);
  3         7  
  3         162  
8 3     3   1077 use Encode qw(find_encoding);
  3         28813  
  3         249  
9 3     3   25 use Scalar::Util qw(blessed openhandle);
  3         6  
  3         1428  
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   9 my ($self) = @_;
40              
41 1         25 my $encoding = $self->encoding;
42 1 50   1   29 open my $fh, ">:encoding($encoding)", $self->file
  1         40  
  1         2  
  1         7  
43             or croak 'could not open file!';
44 1         1023 $self->fh($fh);
45             }
46              
47             sub close_fh {
48 4     4 1 39 my ($self) = @_;
49              
50 4         449 close $self->{fh};
51             }
52              
53             sub write {
54 16     16 1 204 my ($self, @records) = @_;
55              
56 16         35 foreach my $record (@records) {
57 16 100       49 $record = $record->{record} if ref $record eq 'HASH';
58 16         53 $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