| File: | blib/lib/Text/LTSV.pm |
| Coverage: | 97.7% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Text::LTSV; | |||||
| 2 | 4 4 4 | 53180 3 101 | use strict; | |||
| 3 | 4 4 4 | 12 2 97 | use warnings; | |||
| 4 | ||||||
| 5 | our $VERSION = '0.07'; | |||||
| 6 | ||||||
| 7 | 4 4 4 | 929 20407 324 | use IO::File; | |||
| 8 | 4 4 4 | 11 3 157 | use Carp qw/croak/; | |||
| 9 | 4 4 4 | 848 5 2022 | use Text::LTSV::Iterator; | |||
| 10 | ||||||
| 11 | sub new { | |||||
| 12 | 7 | 223770 | my ($self, @kv) = @_; | |||
| 13 | # bless \@kv, $self; | |||||
| 14 | 7 | 50 | return bless { | |||
| 15 | _kv => \@kv, | |||||
| 16 | _wants => [], | |||||
| 17 | _ignores => [], | |||||
| 18 | }, $self; | |||||
| 19 | } | |||||
| 20 | ||||||
| 21 | sub ignore_fields { | |||||
| 22 | 14 | 20 | my ($self, @keys) = @_; | |||
| 23 | 14 | 32 | @keys ? $self->{_ignores} = \@keys : return $self->{_ignores}; | |||
| 24 | } | |||||
| 25 | ||||||
| 26 | sub want_fields { | |||||
| 27 | 14 | 24 | my ($self, @keys) = @_; | |||
| 28 | 14 | 41 | @keys ? $self->{_wants} = \@keys : return $self->{_wants}; | |||
| 29 | } | |||||
| 30 | ||||||
| 31 | sub ordered { | |||||
| 32 | 13 | 16 | my $self = shift; | |||
| 33 | 13 | 24 | @_ ? $self->{_ordered} = shift : return $self->{_ordered}; | |||
| 34 | } | |||||
| 35 | ||||||
| 36 | sub has_wants { | |||||
| 37 | 12 12 | 3 15 | @{shift->want_fields} ? 1 : 0; | |||
| 38 | } | |||||
| 39 | ||||||
| 40 | sub has_ignores { | |||||
| 41 | 12 12 | 9 7 | @{shift->ignore_fields} ? 1 : 0; | |||
| 42 | } | |||||
| 43 | ||||||
| 44 | sub parse_line { | |||||
| 45 | 12 | 192 | my ($self, $line) = @_; | |||
| 46 | 12 | 10 | chomp $line; | |||
| 47 | 12 | 14 | my $has_wants = $self->has_wants; | |||
| 48 | 12 | 9 | my $has_ignores = $self->has_ignores; | |||
| 49 | ||||||
| 50 | 12 | 5 | my %wants; | |||
| 51 | 12 | 13 | if ($has_wants) { | |||
| 52 | 1 2 1 | 1 4 1 | %wants = map { $_ => 1 } @{$self->want_fields}; | |||
| 53 | } | |||||
| 54 | ||||||
| 55 | 12 | 4 | my %ignores; | |||
| 56 | 12 | 11 | if ($has_ignores) { | |||
| 57 | 1 1 1 | 1 2 1 | %ignores = map { $_ => 1 } @{$self->ignore_fields}; | |||
| 58 | } | |||||
| 59 | ||||||
| 60 | 12 | 4 | my %kv; | |||
| 61 | 12 | 11 | if ($self->ordered) { | |||
| 62 | 1 | 1041 | require Tie::IxHash; | |||
| 63 | 1 | 2432 | tie %kv, 'Tie::IxHash'; | |||
| 64 | } | |||||
| 65 | 12 34 | 50 78 | for (map { [ split ':', $_, 2 ] } split "\t", $line) { | |||
| 66 | 34 | 64 | next if $has_ignores and $ignores{$_->[0]}; | |||
| 67 | 33 | 43 | next if $has_wants and not $wants{$_->[0]}; | |||
| 68 | 32 | 92 | $kv{$_->[0]} = $_->[1]; | |||
| 69 | } | |||||
| 70 | 12 | 178 | return \%kv; | |||
| 71 | } | |||||
| 72 | ||||||
| 73 | sub parse_file { | |||||
| 74 | 2 | 1167 | my ($self, $path, $opt) = @_; | |||
| 75 | 2 | 6 | $opt ||= {}; | |||
| 76 | 2 | 40 | my $fh = IO::File->new($path, $opt->{utf8} ? '<:utf8' : 'r') or croak $!; | |||
| 77 | 1 | 137 | my @out; | |||
| 78 | 1 | 30 | while (my $line = $fh->getline) { | |||
| 79 | 3 | 142 | push @out, $self->parse_line($line); | |||
| 80 | } | |||||
| 81 | 1 | 64 | $fh->close; | |||
| 82 | 1 | 41 | return \@out; | |||
| 83 | } | |||||
| 84 | ||||||
| 85 | sub parse_file_utf8 { | |||||
| 86 | 1 | 13 | my ($self, $path) = @_; | |||
| 87 | 1 | 3 | return $self->parse_file($path, { utf8 => 1 }); | |||
| 88 | } | |||||
| 89 | ||||||
| 90 | sub parse_file_iter { | |||||
| 91 | 1 | 2 | my ($self, $path, $opt) = @_; | |||
| 92 | 1 | 2 | $opt ||= {}; | |||
| 93 | 1 | 19 | my $fh = IO::File->new($path, $opt->{utf8} ? '<:utf8' : 'r') or croak $!; | |||
| 94 | 1 | 143 | return Text::LTSV::Iterator->new($self, $fh); | |||
| 95 | } | |||||
| 96 | ||||||
| 97 | sub parse_file_iter_utf8 { | |||||
| 98 | 1 | 514 | my ($self, $path) = @_; | |||
| 99 | 1 | 7 | return $self->parse_file_iter($path, { utf8 => 1 }); | |||
| 100 | } | |||||
| 101 | ||||||
| 102 | sub to_s { | |||||
| 103 | 1 | 11 | my $self = shift; | |||
| 104 | 1 1 | 0 4 | my $n = @{$self->{_kv}}; | |||
| 105 | 1 | 1 | my @out; | |||
| 106 | ||||||
| 107 | 1 | 2 | for (my $i = 0; $i < $n; $i += 2) { | |||
| 108 | 2 | 9 | push @out, join ':', $self->{_kv}->[$i], $self->{_kv}->[$i+1]; | |||
| 109 | } | |||||
| 110 | 1 | 5 | return join "\t", @out; | |||
| 111 | } | |||||
| 112 | ||||||
| 113 | ||||||
| 114 | 1; | |||||