File Coverage

blib/lib/Colon/Config.pm

Criterion	Covered	Total	%
statement	57	59	96.6
branch	34	36	94.4
condition	9	9	100.0
subroutine	7	7	100.0
pod	2	2	100.0
total	109	113	96.4

# Copyright (c) 2018, cPanel, LLC.
# All rights reserved.
# http://cpanel.net
#
# This is free software; you can redistribute it and/or modify it under the
# same terms as Perl itself. See L.

package Colon::Config;

use 5.010;
use strict;
use warnings;

# ABSTRACT: XS helper to read a configuration file using ':' as separator


our $BACKEND;

BEGIN {

    our $VERSION = '0.005'; # VERSION: generated by DZP::OurPkgVersion

    eval {
        require XSLoader;
        XSLoader::load(__PACKAGE__);
    };
    if ($@) {
        *read = \&read_pp;
        $BACKEND = 'pp';
    }
    else {
        $BACKEND = 'xs';
    }
}

sub read_pp {
    my ( $config, $field, $sep ) = @_;

    if ( defined $field ) {
        die "Colon::Config::read_pp - Second argument must be one integer.\n"
            unless $field =~ /\A\s*[+-]?(?:\d+\.?\d*|\.\d+)(?:[eE][+-]?\d+)?\s*\z/;
        $field = do { no warnings; int($field) };
        die "Colon::Config::read_pp - field must be >= 0\n"
            if $field < 0;
    }
    else {
        $field = 0;
    }

    if ( defined $sep ) {
        die "Colon::Config::read_pp - Third argument must be a string.\n"
            unless !ref($sep);
        die "Colon::Config::read_pp - separator must be a single character.\n"
            unless length($sep) == 1;
        die "Colon::Config::read_pp - separator cannot be a newline, carriage return, or null character.\n"
            if $sep eq "\n" || $sep eq "\r" || $sep eq "\0";
    }
    else {
        $sep = ':';
    }

    my $sep_re = quotemeta($sep);

    my @result;
    for my $line ( split( m{\n}, $config ) ) {
        $line =~ s/\0//g;
        $line =~ s/\r+$//;
        $line =~ s/^[ \t\r\0]+//;
        next if $line eq '';
        next if $line =~ /^#/;

        my @parts = split( /$sep_re/, $line, -1 );
        next unless @parts > 1;

        my $key = $parts[0];
        next unless length $key;
        my $value;

        if ( $field == 0 ) {
            $value = join( $sep, @parts[ 1 .. $#parts ] );
            $value =~ s/^[ \t\r\0]+//;
            $value =~ s/[ \t\r]+$//;
        }
        elsif ( $field <= $#parts ) {
            $value = $parts[$field];
            $value =~ s/^[ \t\r\0]+//;
            $value =~ s/[ \t\r]+$//;
        }

        $value = undef if defined $value && !length $value;

        push @result, $key, $value;
    }

    return \@result;
}

sub read_as_hash {
    my ( $config, $field, $sep ) = @_;

    $field = 0 unless defined $field;

    my $av = defined $sep
        ? Colon::Config::read($config, $field, $sep)
        : Colon::Config::read($config, $field);
    return {} unless $av;

    return { @$av };
}


1;

__END__