mirror of git://git.psyced.org/git/psyced
362 lines
7.9 KiB
Perl
362 lines
7.9 KiB
Perl
# $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
|