view release on metacpan or  search on metacpan

lib/Config/File/Simple.pm  view on Meta::CPAN

#!/usr/bin/env perl
##############################
# File: Simple.pm
# Copyright (C) by Kai Wilker <kaiw@cpan.org>
# $Id: Simple.pm,v 1.7 2008/02/16 18:49:25 foo Exp foo $
##############################

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.


package Config::File::Simple;

use 5.008;
use strict;
use warnings;
use Carp qw/ croak /;
use Tie::File;

our $VERSION = '1.00';

sub new {
    my ($class, $file) = @_;
    croak "Need a Configuration file! Usage: my \$object = new Config::File::Simple(\$config:file);" if !defined $file;
    my $self = bless { file => $file }, $class;
    return $self;
}

sub read {
    if (@_ > 2) { # If there are more than one variables given use multiple_read instead of read
        my $self = shift @_;
        my %values = $self->multiple_read(@_);
        return %values;
    }

    my ($self, $variable) = @_;
    my $value = 0; # This value will be returned

    # Tests: Is a variable given? Has the variable no special characters? Does the config file exist?
    croak "No variable is given! Usage: \$self->read(\$variable)" if !defined $variable;
    croak "The variable '$variable' has got special characters!" if $self->has_special_characters($variable);
    croak "The configuration file '$self->{'file'}' doesn't exist!" if ! -e $self->{'file'};

    open my $CONFIG, "<", $self->{'file'} or croak "Can't open file '$self->{'file'}': $!";
    while(my $line = <$CONFIG>) { # Now we parse the config file and search for the variable
        chomp $line;
        $line =~ s/ [^\\] \# .* //xms; # We don't need the comments
        $line =~ s/ ^ \s+ //xms; # Delete all space at the beginnig
        $line =~ s/ \s+ $//xms; # Delete all space at the end
        next if $line !~ / ^ $variable \s* = /xms; # Is this the right variable?
        $value = (split m/=/, $line)[1]; # We need the value
        $value =~ s/ ^ \s+ //xms; # Delete all space at the beginnig of the value
        $value =~ s/ \s+ $ //xms; # Delete all space at the end of the value
        $value =~ s/\\#/#/g; # Unescape the escaped hashs
    }
    
    close $CONFIG or croak "Can't close file '$self->{'file'}': $!";
    return $value;
}

sub multiple_read {
    my ($self, @variables) = @_;
    my %values; # This hash with the variables and values will be returned

    # Tests: Have the variables no special characters? Does the config file exist?
    foreach my $variable (@variables) { # Check all variables for special characters
        croak "The variable '$variable' has got special characters!" if $self->has_special_characters($variable);
    }
    croak "The configuration file '$self->{'file'}' doesn't exist!" if ! -e $self->{'file'};

    open my $CONFIG, "<", $self->{'file'} or croak "Can't open file '$self->{'file'}': $!";
    while(my $line = <$CONFIG>) {
        chomp $line;
        $line =~ s/ [^\\] \# .* //xms; # Delete all comments
        $line =~ s/ ^ \s+ //xms; # Delete all space at the beginnig
        $line =~ s/ \s+ $//xms; # Delete all space at the end

        foreach my $variable (@variables) {
            next if $line !~ / ^ $variable \s* = /xms; # Is this the right variable?
            my $value; # This value will be added to the hash: $values{$variable} = $value
            $value = (split m/=/, $line)[1]; # We need the value, not the variable
            $value =~ s/ ^ \s+ //xms; # Delete all space at the beginnig of the value
            $value =~ s/ \s+ $ //xms; # Delete all space at the end of the value
            $value =~ s/\\#/#/g; # Unescape the escaped hashs
            $values{$variable} = $value;
        }
    }

    close $CONFIG or croak "Can't close file '$self->{'file'}': $!";
    return %values;
}

sub variable_exists {
    my $self = shift @_;
    return 0 if ! -e $self->{'file'}; # If the config file doesn't exist, the variable doesn't exist, too.
    return $self->read(@_); # read() will return 0 if the variable doesn't exist, otherwise it'll return the value of the variable
}

sub has_special_characters {
    my ($self, $word) = @_;
    return ( $word !~ /^ \w+ $/xms );
}

sub set { # A wrapper for methods add() and change()
    my ($self, $variable, $value) = @_;

    croak "The variable '$variable' has got special charaters!"
        if $self->has_special_characters($variable);
    $value =~ s/#/\\#/g; # Escape the hashs in the value: # -> \#
    
    # If the variable exists change the value, otherwise add a new variable + value
    if($self->variable_exists($variable)) {
        $self->change($variable, $value);
    } else {
        $self->add($variable, $value);
    }
}

sub add {
    my ($self, $variable, $value) = @_;

    croak "The variable '$variable' has got special charaters!"
        if $self->has_special_characters($variable);

    # Add a new line at the end of the config file
    # variable = value
    open my $CONFIG, ">>", $self->{'file'} or croak "Can't open file $self->{'file'}: $!";
    print {$CONFIG} "$variable = $value\n"
        or croak "Can't write at file '$self->{'file'}': $!";
    close $CONFIG or croak "Can't close file $self->{'file'}: $!";
}

sub change { # Changes the value of a variable
    my ($self, $variable, $value) = @_;

    croak "The variable '$variable' has got special charaters!"
        if $self->has_special_characters($variable);

    my @config; # The content of the config file will be in this array
    tie @config, 'Tie::File', $self->{'file'}
        or croak "Can't tie file '$self->{'file'}': $!";