File Coverage

blib/lib/BW/Config.pm

Criterion	Covered	Total	%
statement	15	58	25.8
branch	0	12	0.0
condition	0	9	0.0
subroutine	5	13	38.4
pod	5	6	83.3
total	25	98	25.5

# BW::Config.pm
# by Bill Weinman Support for config files
# Based upon bwConfig by Bill Weinman
#
# Copyright (c) 1995-2010 The BearHeart Group, LLC
#

package BW::Config;
use strict;
use warnings;

use IO::File;
use BW::Constants;
use base qw( BW::Base );

our $VERSION = 1.0;
sub version { $VERSION }

sub _init
{
    my $self = shift;
    $self->SUPER::_init(@_);

    # arrange the room
    $self->{raw_lines} = [];
    $self->{keywords}  = [];
    $self->{values}    = {};
    $self->{arrays}    = {};
    $self->{me}        = ref($self);

    # shall we parse?
    $self->parse() if $self->{filename};

    return SUCCESS;
}

# _setter_getter entry points
sub filename { BW::Base::_setter_getter(@_); }

### getters only

# get the keywords arrayref
sub keywords
{
  my $self = shift;
  return $self->{keywords} || [];
}

# get the values hash
sub values
{
  my $self = shift;
  return $self->{values} || {};
}

# get the arrays hash
sub arrays
{
  my $self = shift;
  return $self->{arrays} || {};
}

### worker bees

# parse the file
sub parse
{
    my $sn   = 'parse';
    my $self = shift;
    my $args = shift;

    # find the filename
    my $filename = $args->{filename} || $self->filename;

    return $self->_error("$sn: No filename.") unless $filename;

    # set the filename property while opening the file
    my $fh = new IO::File( $filename, 'r' )
      or return $self->_error("$sn: Cannot open config file ($filename): $!");

    while (<$fh>) {
        s/#.*//;    # trim end-of-line comments
        $_ = $self->_trim($_);    # trim surrounding whitespace
        next if /^$/;             # skip semantically empty lines

        push @{ $self->{raw_lines} }, $_;
        my ( $lh, $rh ) = split( /=/, $_, 2 );
        $lh = $self->_trim($lh);    # trim them up
        $rh = $self->_trim($rh);
        push @{ $self->{keywords} }, $lh;
        $rh = '' unless $rh;        # avoid undef
        $self->{values}{$lh} = $rh;
        @{ $self->{arrays}{$lh} } = split( /:/, $rh );
    }
    return TRUE;
}

# trim leading/trailing space from a string
sub _trim
{
    my $self = shift;
    my $string = shift or return '';

    $string =~ /\s*(.*?)\s*$/;
    return $1;
}

1;

__END__