[Openinteract-commits] CVS: OpenInteract/OpenInteract/Config Ini.pm,NONE,1.1 IniFile.pm,NONE,1.1

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/openinteract/OpenInteract/OpenInteract/Config
In directory usw-pr-cvs1:/tmp/cvs-serv6219

Added Files:
	Ini.pm IniFile.pm 
Log Message:
add (yet another) .ini configuration file reader; very simple right
now (which is a good thing), but this one enables multi-level sections
(e.g., [db_info main]) as well as multivalue keys
(e.g. 'param=this\nparam=that')

--- NEW FILE: Ini.pm ---
package OpenInteract::Config::Ini;

# $Id: Ini.pm,v 1.1 2001/10/17 02:58:22 lachoy Exp $

use strict;

# Stuff in metadata (_m):
#   sections (\@): all full sections, in the order they were read
#   comments (\%): key is full section name, value is comment scalar
#   filename ($):  file read from

sub new {
    my ( $pkg, $params ) = @_;
    my $class = ref $pkg || $pkg;
    my $self = bless( {}, $class );
    if ( $self->{_m}{filename} = $params->{filename} ) {
        $self->read_file( $self->{_m}{filename} );
    }
    return $self;
}

sub get {
    my ( $self, $section, @p ) = @_;
    my ( $sub_section, $param ) = ( $p[1] ) ? ( $p[0], $p[1] ) : ( undef, $p[0] );
    return $self->{ $section }{ $sub_section }{ $param }  if ( $sub_section );
    return $self->{ $section }{ $param };
}

sub set {
    my ( $self, $section, @p ) = @_;
    my ( $sub_section, $param, $value ) = ( $p[2] ) ? ( $p[0], $p[1], $p[2] ) : ( undef, $p[0], $p[1] );
    return $self->{ $section }{ $sub_section }{ $param } = $value  if ( $sub_section );
    return $self->{ $section }{ $param } = $value
}

sub delete {
    my ( $self, $section, @p ) = @_;
    my ( $sub_section, $param ) = ( $p[1] ) ? ( $p[0], $p[1] ) : ( undef, $p[0] );
    delete $self->{ $section }{ $sub_section }{ $param } if ( $sub_section );
    delete $self->{ $section }{ $param };
}

########################################
# INPUT
########################################

sub read_file {
    my ( $self, $filename ) = @_;

    warn "Trying to read file ($filename)\n";

    open( CONF, $filename ) || die "Cannot open ($filename) for reading: $!";

    # Temporary holding for comments

    my @comments = ();
    my ( $section, $sub_section );

    # Cycle through the file: skip blanks; accumulate comments for
    # each section; register section/subsection; add parameter/value

    while ( <CONF> ) {
        chomp;
        next if ( /^\s*$/ );
        if ( /^\s*\#/ ) {
            push @comments, $_;
            next;
        }
        if ( /^\s*\[\s*(\S|\S.*\S)\s*\]\s*$/) {
            warn "--Found section ($1)\n";
            ( $section, $sub_section ) = $self->read_section_head( $1, \@comments );
            @comments = ();
            next;
        }
        my ( $param, $value ) = /^\s*([^=]+?)\s*=\s*(.*)\s*$/;
        warn "--Setting ($param) to ($value)\n";
        $self->read_item( $section, $sub_section, $param, $value );
    }
    close( CONF );
    $self->{_m}{filename} = $filename;
    return $self;
}

sub read_section_head {
    my ( $self, $full_section, $comments ) = @_;
    push @{ $self->{_m}{order} }, $full_section;
    $self->{_m}{comments}{ $full_section } = join "\n", @{ $comments };
    if ( $full_section =~ /^(\w+)\s+(\w+)$/ ) {
        my ( $section, $sub_section ) = ( $1, $2 );
        $self->{ $section }{ $sub_section } ||= {};
        return ( $section, $sub_section );
    }
    $self->{ $full_section } ||= {};
    return ( $full_section, undef );
}

sub read_item {
    my ( $self, $section, $sub_section, $param, $value ) = @_;
    my $set_value_in = ( $sub_section )
                         ? $self->{ $section }{ $sub_section }
                         : $self->{ $section };
    my $existing = $set_value_in->{ $param };
    if ( $existing and ref $set_value_in eq 'ARRAY' ) {
        push @{ $set_value_in->{ $param } }, $value;
    }
    elsif ( $existing ) {
        push @{ $set_value_in->{ $param } }, $existing, $value
    }
    else {
        $set_value_in->{ $param } = $value;
    }
}

########################################
# OUTPUT
########################################

sub write_file {
    my ( $self, $filename ) = @_;
    $filename ||= $self->{_m}{filename} || 'config.ini';
    my ( $original_filename );
    if ( -f $filename ) {
        $original_filename = $filename;
        $filename = "$filename.new";
    }
    warn "--Writing INI to ($filename) (original: $original_filename)\n";
    open( OUT, "> $filename" ) || die "Cannot write configuration to ($filename): $!";
    print OUT "# Written by ", ref $self, " at ", scalar localtime, "\n\n";
    foreach my $full_section ( @{ $self->{_m}{order} } ) {
        print OUT $self->{_m}{comments}{ $full_section }, "\n",
                  "[$full_section]\n",
                  $self->output_section( $full_section ),
                  "\n\n";
    }
    close( OUT );
    if ( $original_filename ) {
        unlink( $original_filename );
        rename( $filename, $original_filename );
    }
    return $filename;
}

sub output_section {
    my ( $self, $full_section ) = @_;
    my ( $section, $sub_section ) = split /\s+/, $full_section;
    my $show_from = ( $sub_section )
                      ? $self->{ $section }{ $sub_section }
                      : $self->{ $section };
    my @items = ();
    foreach my $key ( keys %{ $show_from } ) {
        if ( ref $show_from->{ $key } eq 'ARRAY ' ) {
            foreach my $value ( @{ $show_from->{ $key } } ) {
                push @items, $self->show_item( $key, $value );
            }
        }
        else {
            push @items, $self->show_item( $key, $show_from->{ $key } );
        }
    }
    return join "\n", @items;
}

sub show_item { return join( ' = ', @_[1], @_[2] ) }

1;

__END__

=pod

=head1 NAME

OpenInteract::Config::Ini - Read/write INI-style (++) configuration files

=head1 SYNOPSIS

 my $config = OpenInteract::Config::Ini->new({ filename => 'myconf.ini' });
 print "Main database driver is:", $config->{db_info}{main}{driver}, "\n";
 $config->{db_info}{main}{username} = 'mariolemieux';
 $config->write_config;

=head1 DESCRIPTION

This is a very simple implementation of a configuration file
reader/writer that preserves comments and section order, enables
multivalue fields and one or two-level sections.

Yes, there are other configuration file modules out there to
manipulate INI-style files. But this one takes several features from
them while providing a very simple and uncluttered interface.

=over 4

=item *

From L<Config::IniFiles|Config::IniFiles> we take comment preservation
and the idea that we can have multi-level sections like:

 [Section subsection]

=item *

From L<Config::Ini|Config::Ini> and L<AppConfig|AppConfig> we borrow
the usage of multivalue keys:

 item = first
 item = second

=back

=head1 SEE ALSO

L<AppConfig|AppConfig>

L<Config::Ini|Config::Ini>

L<Config::IniFiles|Config::IniFiles>

=head1 COPYRIGHT

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHORS

Chris Winters <ch...@cw...>

=cut

--- NEW FILE: IniFile.pm ---
package OpenInteract::Config::IniFile;

# $Id: IniFile.pm,v 1.1 2001/10/17 02:58:22 lachoy Exp $

use strict;
use Data::Dumper         qw( Dumper );
use OpenInteract::Config qw( _w DEBUG );
use OpenInteract::Config::Ini;

@OpenInteract::Config::IniFile::ISA     = qw( OpenInteract::Config );
$OpenInteract::Config::IniFile::VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);

use constant META_KEY => '_INI';

sub read_config {
    my ( $class, $filename ) = @_;
    $class->is_file_valid( $filename );
    my $ini = OpenInteract::Config::Ini->new({ filename => $filename });
    return $ini;
}

sub write_config {
    my ( $self ) = @_;
    my $backup = $self;
    bless( $backup, 'OpenInteract::Config::Ini' );
    $backup->write_file;
}

1;