Subversion Repositories DevTools

package JatsIniFile;

use strict;
use warnings;

our $VERSION = '0.01';

sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto || 'JatsIniFile';

        my $self = {
                __file__    => undef,
                __default__ => 'default',
                __eol__     => "\n",
                __append__  => 1,
                @_,
        };

        bless ($self,$class);
        return $self;
}

sub reset {
        my ($self) = @_;

        $self = {
                __file__    => $self->{__file__},
                __default__ => $self->{__default__},
                __eol__     => $self->{__eol__},
                __append__  => $self->{__append__},
        };
}

sub read {
        my ($self,$file,$section) = @_;

        if (!defined $file) {
                $file = $self->{__file__};
                return unless defined $file;
        }

        return unless -e $file;

        $self->{__file__} = $file;

        open (FILE, $file);
        my @lines = <FILE>;
        close (FILE);
        chomp @lines;

        my $data = {};
        my $block = $self->{__default__} || 'default';

        foreach my $line (@lines) {
                $line =~ s/\r//g;                          # Remove excess line endings
                $line =~ s/\n//g;
                $line =~ s/^\s+//;                         # Remove leading white space
                next if $line =~ /^\s*\;/;                 # Entire comment line
                next if $line =~ /^\s*\#/;
                $line =~ s/\s+;.*$//;                      # Trailing comments

                next if length $line == 0;                 # Anything to do ?
        
#print "Read:[$block] '$line'\n";
                if ($line =~ /\s*\[(.*?)\]\s*/) {
                        $block = $1;
                        next;
                }

        if ( $section )
        {
            next unless ( $section eq $block );
        }

                my ($what,$is) = split(/=/, $line, 2);
                $what =~ s/^\s*//g;
                $what =~ s/\s*$//g;
                $is =~ s/^\s*//g;
                $is =~ s/\s*$//g;

                $data->{$block}->{$what} = $is;
#print "Read:[$block] '$what' '$is'\n";
        }

    foreach my $block (keys %{$data}) {
            $self->{$block} = $data->{$block};
    }

        return 1;
}

sub write {
        my ($self,$file) = @_;

        if (!defined $file) {
                $file = $self->{__file__};
                return unless defined $file;
        }

        return unless -e $file;

        open (FILE, $file);
        my @lines = <FILE>;
        close (FILE);
        chomp @lines;

        my $block = $self->{__default__} || 'default';
        my @new = ();
        my $used = {};

        foreach my $line (@lines) {
                if ($line =~ /\s*\[(.*?)\]\s*/) {
                        $block = $1;
                        $line =~ s/^\s*//g;
                        $line =~ s/\s*$//g;
                        push (@new, $line);
                        next;
                }

                if ($line =~ /^\s*\;/ || $line =~ /^\s*\#/) {
                        push (@new, $line);
                        next;
                }

                if (length $line == 0) {
                        push (@new, '');
                        next;
                }

                my ($what,$is) = split(/=/, $line, 2);
                $what =~ s/^\s*//g;
                $what =~ s/\s*$//g;
                $is =~ s/^\s*//g;
                $is =~ s/\s*$//g;

                if (exists $self->{$block}->{$what}) {
                        $line = join ('=', $what, $self->{$block}->{$what});
                        $used->{$block}->{$what} = 1;
                }

                push (@new, $line);
        }

        # Add new config variables?
        if ($self->{__append__} == 1) {
                foreach my $key (keys %{$self}) {
                        next if $key =~ /^__.*?__$/i;
                        print "Checking key $key (ref = " . ref($key) . ")\n";

                        if (!exists $used->{$key}) {
                                print "Block doesn't exist!\n";
                                push (@new, "");
                                push (@new, "[$key]");
                        }

                        foreach my $lab (keys %{$self->{$key}}) {
                                if (!exists $used->{$key}->{$lab}) {
                                        print "Adding $lab=$self->{$key}->{$lab} to INI\n";
                                        push (@new, "$lab=$self->{$key}->{$lab}");
                                }
                        }
                }
        }

        my $eol = $self->{__eol__} || "\r\n";
        open (WRITE, ">$file");
        print WRITE join ($eol, @new);
        close (WRITE);

        return 1;
}

sub get
{
    my ($self, $section, $parameter, $default ) = @_;

    if ( exists ( $self->{$section}{$parameter}  ))
    {
        return $self->{$section}{$parameter};
    }

    return $default;
}

sub set
{
    my ($self, $section, $parameter, $value ) = @_;
    $self->{$section}{$parameter} = $value;
}


1;
__END__