File Coverage

File:blib/lib/Text/LTSV.pm
Coverage:97.7%

linestmtbrancondsubtimecode
1package Text::LTSV;
2
4
4
4
53180
3
101
use strict;
3
4
4
4
12
2
97
use warnings;
4
5our $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
11sub 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
21sub ignore_fields {
22
14
20
    my ($self, @keys) = @_;
23
14
32
    @keys ? $self->{_ignores} = \@keys : return $self->{_ignores};
24}
25
26sub want_fields {
27
14
24
    my ($self, @keys) = @_;
28
14
41
    @keys ? $self->{_wants} = \@keys : return $self->{_wants};
29}
30
31sub ordered {
32
13
16
    my $self = shift;
33
13
24
    @_ ? $self->{_ordered} = shift : return $self->{_ordered};
34}
35
36sub has_wants {
37
12
12
3
15
    @{shift->want_fields} ? 1 : 0;
38}
39
40sub has_ignores {
41
12
12
9
7
    @{shift->ignore_fields} ? 1 : 0;
42}
43
44sub 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
73sub 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
85sub parse_file_utf8 {
86
1
13
    my ($self, $path) = @_;
87
1
3
    return $self->parse_file($path, { utf8 => 1 });
88}
89
90sub 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
97sub parse_file_iter_utf8 {
98
1
514
    my ($self, $path) = @_;
99
1
7
    return $self->parse_file_iter($path, { utf8 => 1 });
100}
101
102sub 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
1141;