1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
package SkinFile;
use strict;
use warnings;
use Fcntl 'LOCK_SH', 'SEEK_SET';
sub new {
my($class, $root, $open) = @_;
my $self = bless { root => $root }, $class;
$self->open($open) if $open;
return $self;
}
sub list {
return map /\/([^\/]+)\/conf/?$1:(), glob "$_[0]{root}/*/conf";
}
sub open {
my($self, $dir, $force) = @_;
return if $self->{"s_$dir"} && !$force;
my %o;
open my $F, '<:utf8', "$self->{root}/$dir/conf" or die $!;
flock $F, LOCK_SH or die $!;
seek $F, 0, SEEK_SET or die $!;
local $_;
while(<$F>) {
chomp;
s/\r//g;
s{[\t\s]*//.+$}{};
next if !/^([a-z0-9]+)[\t\s]+(.+)$/;
$o{$1} = $2;
}
close $F;
$self->{"s_$dir"} = \%o;
$self->{opened} = $dir;
}
sub get {
my($self, $dir, $var) = @_;
$self->open($dir) if defined $var;
$var = $dir if !defined $var;
$var ? $self->{"s_$self->{opened}"}{$var} : keys %{$self->{"s_$self->{opened}"}};
}
1;
__END__
=pod
=head1 NAME
SkinFile - Simple object oriented interface to parsing skin configuration files
=head1 USAGE
use SkinFile;
my $s = SkinFile->new($dir);
my @skins = $s->list;
$s->open($skins[0]);
my $name = $s->get('name');
# same as above, but in one function
my $name = $s->get($skins[0], 'name');
|