File Coverage

blib/lib/Text/XLogfile.pm

Criterion	Covered	Total	%
statement	65	65	100.0
branch	20	26	76.9
condition	2	2	100.0
subroutine	10	10	100.0
pod	5	5	100.0
total	102	108	94.4

package Text::XLogfile; # git description: f0adf57
# ABSTRACT: Read and write xlogfiles

use strict;
use warnings;
use base 'Exporter';
use Carp 'croak';

our @EXPORT_OK = qw(read_xlogfile parse_xlogline each_xlogline write_xlogfile make_xlogline);
our %EXPORT_TAGS = (all => \@EXPORT_OK);
our $VERSION = '0.06';

sub read_xlogfile {
    my $filename = shift;
    my @entries;

    each_xlogline($filename => sub {
        push @entries, $_;
    });

    return @entries;
}

sub parse_xlogline {
    my $input = shift;
    my $output = {};

    chomp $input;

    my @fields = split /:/, $input;

    for my $field (@fields) {
        my ($key, $value) = split /=/, $field;
        return if !defined($value); # no = found

        $output->{$key} = $value;
    }

    return $output;
}

sub each_xlogline {
    my $filename = shift;
    my $code = shift;

    open my $handle, '<', $filename
        or croak "Unable to read $filename for reading: $!";

    while (<$handle>) {
        local $_ = parse_xlogline($_) || {};
        $code->($_);
    }

    close $handle
        or croak "Unable to close filehandle: $!";
}

sub write_xlogfile {
    my $entries = shift;
    my $filename = shift;

    open my $handle, '>', $filename
        or croak "Unable to open '$filename' for writing: $!";

    for my $entry (@$entries) {
        print {$handle} make_xlogline($entry, 1), "\n"
            or croak "Error occurred during print: $!";
    }

    close $handle
        or croak "Unable to close filehandle: $!";

    return;
}

sub make_xlogline {
    my $input = shift;
    my $correct = shift;
    my @fields;

    # code duplication is bad, but not that much is being duplicated
    if (!$correct) {
        while (my ($key, $value) = each %$input) {
            if ($key =~ /([=:\n])/) {
                my $bad = $1; $bad = $bad eq "\n" ? "newline" : "'$bad'";
                $key =~ s/\n/\\n/;
                croak "Key '$key' contains invalid character: $bad.";
            }

            if ($value =~ /([:\n])/) {
                my $bad = $1; $bad = $bad eq "\n" ? "newline" : "'$bad'";
                $key =~ s/\n/\\n/; $value =~ s/\n/\\n/;
                croak "Value '$value' (of key '$key') contains invalid character: $bad.";
            }

            push @fields, "$key=$value";
        }
    }
    elsif ($correct == -1) {
        while (my ($key, $value) = each %$input) {
            push @fields, "$key=$value";
        }
    }
    elsif ($correct == 1) {
        while (my ($key, $value) = each %$input) {
            $key   =~ y/\n:=/ __/;
            $value =~ y/\n:/ _/;
            push @fields, "$key=$value";
        }
    }

    return join ':', @fields;
}

1;

__END__