psyced/utility/INI.pm

362 lines
7.9 KiB
Perl
Raw Normal View History

# $Id: INI.pm,v 1.34 2006/06/14 16:27:23 lynx Exp $
package INI;
require Tie::Hash;
@ISA = (Tie::ExtraHash);
use strict;
# lynx: you propably really want that _all_ tied INI hashes in a Perl ...
# "session" share the verbosity-setting, but would you mind if i did that some
# more OO, on a per hash basis?
my $verbose = 0;
# saga: i don't need this to be any better but if your heart aches, go ahead
sub HASH { 0 }
sub FNAME { 1 }
sub CHANGED { 2 }
sub MAX { 3 }
sub JANITOR { 4 }
sub import {
$_ = join ' ', @_;
$verbose = /\bverbose\b/i;
}
sub iniSane {
my $self = shift;
my $key = shift;
my $value = shift;
if (defined $value && $key !~ /^.+?_.+/) {
die "'$key' is not a valid key";
}
if ($key =~ /[\r\n\s]/) {
die "invalid characters in key '$key'";
}
if (defined $value && $value =~ /[\r\n]/) {
die "invalid characters in value for '$key'";
}
}
# TODO:: make janitor a more swanky datastructure.
# like $janitor->{'_foo'}->[CHILDREN]->{'_bar'}->[COUNT]
# instead of $janitor->{'_foo_bar'}.
# on the other hand, we'd probably need entries for levels with a count of 0,
# if they got child levels. hm.
# it'd eat more memory (ok, we don't have to care for that), and.. i'm not even
# sure if it would be faster. probably not. same operations, splitting on "_",
# and we'd have to walk through the structure beginning from the leftmost level
# of a value to the right every time while we might find our levels earlier
# if coming from the right (.. trying _foo_bar_some before _foo_bar before
# _foo) in the average case. we'll at least in some cases, while we always need
# to walk through from the leftmost level if doing that tree specified above.
# hm. i'll have to think that over.
sub iniJanDel {
my $self = shift;
my $key = shift;
my $janitor = $self->[JANITOR];
my $max = $self->[MAX];
while ($key =~ s/(.+)_.*/$1/) {
if ($janitor->{$key}-- == $max) {
for (my $i = 1; $i < $max; $i++) {
$self->iniJanAdd($key);
}
last;
}
last if $janitor->{$key} >= $max;
delete $janitor->{$key} unless $janitor->{$key};
}
}
sub iniJanAdd {
my $self = shift;
my $key = shift;
my $janitor = $self->[JANITOR];
my $max = $self->[MAX];
while ($key =~ s/(.+)_.*/$1/) {
if (++$janitor->{$key} == $max) {
for (my $i = 1; $i < $max; $i++) {
$self->iniJanDel($key);
}
last;
}
last if $janitor->{$key} > $max;
}
}
sub iniParse {
my $self = shift;
my $fname = $self->[FNAME];
my $max = $self->[MAX];
my $hash = $self->[HASH];
my $janitor = $self->[JANITOR];
my $section;
open(FILE, '<', $fname) || die $!;
while (<FILE>) {
chomp;
next if /^\s*(?:$|;)/;
if (/^\[(.+?)\]\s*(?:;.*)?$/) {
$self->iniSane($1);
$section = $1;
print STDERR "$section " if $verbose;
next;
}
if ($section && /^(.+?)\s*=\s*((?>(?:(?<=(?<!\\)\\)(?:\\\\)*["\s;\\]|[^"\s\\;]|\s(?!\s*(?:;|$))|\\(?!$))*)|"(?:(?<=(?<!\\)\\)(?:\\\\)*["\s]|[^"])*?(?:(?<!\\)(?:\\\\)+|(?<!\\))")\s*(?:;.*)?$/) {
my $t = join('', $section, $1);
my $t2 = $2;
if (substr($t2, 0, 1) eq '"') {
$t2 = substr($t2, 1, length($t2)-2);
}
$t2 =~ s/\\(.)/$1/g;
$self->iniSane($t, $t2);
$hash->{$t} = $t2;
# print STDERR "$t is $t2\n";
$self->iniJanAdd($t) if $max;
next;
}
die "failed in parsing from '$fname':\n$_\n(line $.)" if ($_);
}
close(FILE);
}
sub iniSerialize {
my $self = shift;
my $hash = $self->[HASH];
my $janitor = $self->[JANITOR];
my $max = $self->[MAX];
my %shash = ();
my $nottop;
my $res = ";this is an automatically generated file, you may change it as "
. "you like, but\n"
. ";keep in mind that your comments will be destroyed if a "
. "config tool makes some\n"
. ";changes.\n\n";
foreach (keys %$hash) {
my $sec = $_;
my $key = "";
my ($section, $buf);
while ($max && $sec =~ s/(.+)(_.*)/$1/) {
$key = $2 . $key;
if ($janitor->{$sec} >= $max) {
$section = $sec;
last;
}
}
unless ($section) {
/(.+?)(_.*)/;
$section = $1;
$key = $2;
}
$shash{$section} = {} unless exists $shash{$section};
$buf = $hash->{$_};
$buf =~ s/\\/\\\\/g;
$buf =~ s/"/\\"/g;
if ($buf =~ /(?:^\s|\s$|;)/) {
$buf = join('', '"', $buf, '"');
}
$shash{$section}->{$key} = $buf;
}
foreach my $base (sort keys %shash) {
if ($nottop) {
$res .= "\n";
} else {
$nottop = 1;
}
$res .= join('', '[', $base, ']', "\n");
foreach my $child (keys %{$shash{$base}}) {
$res .= join(' ', $child, '=', $shash{$base}->{$child});
$res .= "\n";
}
}
return $res;
}
sub TIEHASH {
my $pkg = shift;
my $fname = shift || die 'NO FILENAME PROVIDED';
my $max = shift;
my $self = [{}, $fname, 0, $max, {}];
bless $self, $pkg;
if (-r $fname) {
print STDERR "Loading from $fname:\n" if $verbose;
$self->iniParse();
print STDERR "\nConfiguration loaded.\n\n" if $verbose;
} else {
print STDERR "$fname does not exist.\n" if $verbose;
}
return $self;
}
sub STORE {
my $self = shift;
my $key = shift;
my $value = shift;
#TODO: needs more restrictive checks, (key, value) are valid if they can be
#added to the hash.
#alternatively keep this somewhat abstract and overload it for psyced config
#sanity checks.
#oh, i like that.
$self->iniSane($key, $value);
$self->[CHANGED] = 1;
if ($self->[MAX] && !exists $self->[HASH]->{$key}) {
$self->iniJanAdd($key);
}
return $self->SUPER::STORE($key, $value);
}
sub DELETE {
my $self = shift;
my $key = shift;
if ($self->[MAX] && exists $self->[HASH]->{$key}) {
$self->iniJanDel($key);
}
return $self->SUPER::DELETE($key);
}
sub CLEAR {
my $self = shift;
$self->[CHANGED] = 1;
$self->[JANITOR] = {};
return $self->SUPER::CLEAR();
}
sub SCALAR {
my $self = shift;
return $self->iniSerialize();
}
sub UNTIE {
my $self = shift;
return unless $self->[CHANGED];
open(FILE, '>', $self->[FNAME]) || die $!;
print FILE $self->iniSerialize();
close(FILE);
}
1;
=head1 NAME
INI - class definitions for tying .ini-like configuration files as hashes
=head1 SYNOPSIS
require INI;
tie(%hash, INI, 'conf.ini', 5);
if ($hash{'_some_system_setting'} =~ /^y(?:es)$/) {
# do something
}
$hash{'_some_system_setting2'} = 12;
untie %hash;
=head1 FORMAT DESCRIPTION
[section] ; comment
key = value ; comment
key = "value" ; comment
; comment
(all whitespaces up to here are optional).
key = \"
(value of key will be a quote sign)
key = \; ; and
key = ";"
(value of key will will be a semicolon)
Section- and keynames should start with underscores.
The section names are just prepended to the key names, so
[_foo]
_bar_snafu = kibo
and
[_foo_bar]
_snafu = kibo
define the same (key, value)-tuple.
=head1 API
=over
=item tie(B<HASH>, B<FILE>, B<MAX>)
Tie B<FILE> to B<HASH>, B<FILE> will be parsed upon tie and fill the hash,
contents of B<HASH> will be serialized to B<FILE> on untie.
B<MAX> is optional and defines when a level counts as full, thus if B<MAX>
is set to 3, and you have 3 settings named _foo_bar_something1,
_foo_bar_something2 and _foo_bar_something3, they'll be serialized into a
section [_foo_bar] as _something<digit> = value.
=item untie(B<HASH>)
Untie B<HASH>, will be serialized into B<FILE> given in the tie statement if
changed.
Will use B<MAX> (from the tie statement) to find out which levels deserve their
own section.
=item scalar(B<HASH>)
Returns a string containing B<HASH> serialized into the INI format.
You'll most probably never need that for anything but debugging purposes, as
B<INI> does serializing into files for you on untie.
=back
=head1 SEE ALSO
L<http://about.psyc.eu/psyced>
=head1 AUTHOR
Tobias Josefowitz, <tobij@goodadvice.pages.de>
=head1 COPYRIGHT
Copyright (c) 2005 Tobias Josefowitz.
All rights reserved.
This program is free software under the GPL.
=cut