Browse Source

initial version

themage
theMage 4 years ago
commit
6346b1ffb4
6 changed files with 369 additions and 0 deletions
  1. 6 0
      Changes
  2. 6 0
      MANIFEST
  3. 14 0
      Makefile.PL
  4. 46 0
      README.md
  5. 279 0
      lib/Config/RecurseINI.pm
  6. 18 0
      t/Config-RecurseINI.t

+ 6 - 0
Changes

@ -0,0 +1,6 @@
1
Revision history for Perl extension Config::RecurseINI.
2
3
0.01  Wed Apr 27 20:26:26 2016
4
	- original version; created by h2xs 1.23 with options
5
		-A -X -n Config::RecurseINI
6

+ 6 - 0
MANIFEST

@ -0,0 +1,6 @@
1
Changes
2
Makefile.PL
3
MANIFEST
4
README
5
t/Config-RecurseINI.t
6
lib/Config/RecurseINI.pm

+ 14 - 0
Makefile.PL

@ -0,0 +1,14 @@
1
use 5.022001;
2
use ExtUtils::MakeMaker;
3
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
4
# the contents of the Makefile that is written.
5
WriteMakefile(
6
    NAME              => 'Config::RecurseINI',
7
    VERSION_FROM      => 'lib/Config/RecurseINI.pm', # finds $VERSION, requires EU::MM from perl >= 5.5
8
    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
9
    ABSTRACT_FROM     => 'lib/Config/RecurseINI.pm', # retrieve abstract from module
10
    AUTHOR            => 'Marco Neves <mpneves@>',
11
    #LICENSE           => 'perl',
12
    #Value must be from legacy list of licenses here
13
    #http://search.cpan.org/perldoc?Module%3A%3ABuild%3A%3AAPI
14
);

+ 46 - 0
README.md

@ -0,0 +1,46 @@
1
# Config-RecurseINI
2
3
Config::RecurseINI adds two things on top of Config::Tiny:
4
5
* based on the name of the script or a parameter to first config call
6
  search for the config file in several places
7
8
* allow config sections to inherit from other sections
9
10
## INSTALLATION
11
12
To install this module type the following:
13
14
   perl Makefile.PL
15
   make
16
   make test
17
   make install
18
19
## DEPENDENCIES
20
21
This module requires these other modules and libraries:
22
23
  Config::Tiny
24
  Getopt::Log
25
26
## SUPPORT AND BUGS
27
28
the main issue tracking of this project is in
29
30
  http://magick-source.net/MagickPerl/Config-RecurseINI
31
32
## COPYRIGHT AND LICENCE
33
34
This is licensed with GPL 2.0+ or perl's artistic licence
35
the files with both licences are part of this package
36
37
Copyright (C) 2016 by theMage
38
39
This library is free software; you can redistribute it and/or modify
40
it under the same terms as Perl itself, either Perl version 5.22.1 or, 
41
at your option, any later version of Perl 5 you may have available.
42
43
Alternativally, you can also redistribute it and/or modify it
44
under the terms of the GPL 2.0 licence (or any future version of it).
45
46

+ 279 - 0
lib/Config/RecurseINI.pm

@ -0,0 +1,279 @@
1
package Config::RecurseINI;
2
3
use strict;
4
use warnings;
5
6
use base 'Exporter';
7
use Cwd qw(abs_path);
8
use Carp;
9
10
use Getopt::Long;
11
use Config::Tiny;
12
13
our @EXPORT_OK = qw(config debug verbose);
14
my %exports = map { $_ => 1 } @EXPORT_OK;
15
16
our $VERSION = '0.9.0';
17
18
my $defaultpath 	= abs_path($0);
19
$defaultpath			=~s{/\w?bin/[^/]+$}{/config/};
20
my $scriptpath		= $0;
21
my ($scriptname)	= $scriptpath =~ m{([^/]+)$};
22
$scriptname =~ s{\.pl$}{};
23
24
my @configdirs  = ();
25
if ($ENV{HOME}) {
26
	push @configdirs, $ENV{HOME}, $ENV{HOME}.'/.config';
27
}
28
push @configdirs, '/etc/', $defaultpath;
29
30
my $configname	= '';
31
32
my $debug 			= -1;
33
my $verbose 		= -1;
34
my $readstrict 	= 0;
35
36
my %params=();
37
38
############################
39
# import
40
#     IN: list of subs to export
41
#    OUT: 
42
#GoodFor: import methods
43
sub import {
44
  my $class = shift;
45
	unless ($configname and !$exports{ $_[0] } ) {
46
		$configname = shift;
47
	}
48
	@_ = grep { $exports{ $_ } } @_;
49
50
	_read_config() unless %params;
51
52
	$class->Exporter::export_to_level(1, $class, @_);
53
}
54
55
############################
56
# debug
57
#     IN: 0 
58
#    OUT: $debuglevel
59
#GoodFor: check if debug is active
60
sub debug {
61
	_read_config() unless %params;
62
63
	return $debug;
64
} 
65
66
############################
67
# verbose
68
#     IN: 0 
69
#    OUT: $verboselevel
70
#GoodFor: check if verbose is active
71
sub verbose {
72
	_read_config() unless %params;
73
74
	return $verbose;
75
} 
76
77
############################
78
# config
79
#     IN: 
80
#    OUT: 
81
#GoodFor: 
82
my %config=();
83
sub config {
84
	my $section;
85
	my %args = ();
86
	if ( scalar @_ == 2 ) {
87
		%args = (section => shift, configkey => shift);
88
	} else {
89
		$section = shift if scalar @_ %2;
90
		%args = @_;
91
	}
92
93
	$section ||= delete $args{section};
94
	my $key = delete $args{configkey};
95
	
96
	_read_config(%args)
97
		unless %config and (!$args{strict} or $readstrict);
98
99
	my %sec = $section ? %{$config{$section}||{}} : %config;
100
	if ($key) {
101
		return $sec{$key};
102
	}
103
	
104
	return wantarray ? %sec : \%sec;
105
} 
106
107
############################
108
# _read_config
109
#     IN: %args - see docs
110
#    OUT: \%config
111
#GoodFor: Read the full configuration for a script
112
sub _read_config {
113
	my %args=@_;
114
	my $strict = $args{strict} || 0;
115
116
	my ($cpkg) = caller(1);
117
	my $checks;
118
	if ($args{config_check}) {
119
		$checks = $args{config_check}->();
120
	} elsif (my $chk=$cpkg->can('config_check')) {
121
		$checks = $chk->();
122
	}
123
	if ($strict and !$checks) {
124
		croak "Can't use strict mode without a config_check\n";
125
	}
126
127
	my %parms = get_params();
128
	get_env_params(\%parms);
129
130
	my $cfname = $parms{config};
131
	$cfname = _get_best_config() unless $cfname;
132
133
	my $cfg = Config::Tiny->read($cfname);
134
	unless ($cfg) {
135
		my $err = Config::Tiny->errstr;
136
		croak "Error reading config '$cfname': << $err >> " if $err;
137
	}
138
139
	$debug>-1 or $debug = $cfg->{_}->{debug} || 0;
140
	$verbose>-1 or $verbose = $cfg->{_}->{verbose} || 0;
141
142
	my %isa = ();
143
	for my $s (keys %$cfg) {
144
		next if $s eq '_';
145
146
		for my $k (keys %{$cfg->{$s}}) {
147
			next if $k eq '_isa';
148
149
			my $chk = $checks->{$s}->{$k};
150
			if ($strict and !$chk) {
151
				croak "config option [$s]$k not needed";
152
			}
153
			if ($chk and $chk->{check}) {
154
				if ($cfg->{$s}->{$k}=~$chk->{check}) {
155
					$config{$s}{$k} = $cfg->{$s}{$k};
156
				} else {
157
					croak "config option [$s]$k='$cfg->{$s}{$k}' is not valid";
158
				}
159
			} else {
160
				$config{$s}{$k} = $cfg->{$s}{$k};
161
			}
162
		}
163
164
		if ( $cfg->{ $s }->{_isa} ) {
165
			$isa{ $s } = [ split /\s*[,;]\s*/, $cfg->{ $s }->{_isa} ];
166
		}
167
	}
168
169
	my $_isa;
170
	my %_isaseen;
171
	$_isa = sub {
172
		my $s = shift;
173
		return if $_isaseen{ $s };
174
		$_isaseen{ $s }++;
175
		for my $ds ( @{ $isa{$s} }) {
176
			if ($isa{ $ds }) {
177
				$_isa->($ds);
178
			}
179
			for my $k (keys %{ $config{ $ds } }) {
180
				$config{ $s }{ $k } = $config{ $ds }{ $k }
181
					unless exists $config{ $s }{ $k };
182
			}
183
		}
184
		$_isaseen{ $s }--;
185
	};
186
187
	for my $s (keys %isa) {
188
		%_isaseen = ();
189
		$_isa->($s) if $isa{ $s };
190
	}
191
192
	if ($checks) {
193
		for my $s (keys %$checks) {
194
			for my $k (keys %{$checks->{$s}}) {
195
				$config{$s}{$k} = $checks->{$s}{$k}{default}
196
					if (exists $checks->{$s}{$k}{default}
197
						and !exists $config{$s}{$k});
198
199
				croak "Missing config option [$s]$k"
200
					if $checks->{$s}{$k}{needed}
201
						and !exists $config{$s}{$k};
202
			}
203
		}
204
	}
205
206
}
207
208
############################
209
# _get_best_config
210
#     IN: 0
211
#    OUT: filename for the config file
212
#GoodFor: find the config file name
213
sub _get_best_config {
214
	carp "Can't guess the config file for -e [use --config]"
215
		if !$configname and $scriptname eq '-e';
216
217
  $configname ||= $scriptname;
218
219
	for my $dir (@configdirs) {
220
    next unless -d $dir;
221
222
		my @fnames = ("$configname.ini", "$configname.conf");
223
		unshift @fnames, ".$configname" if $dir eq $ENV{HOME}//'';
224
225
    $dir .= '/' unless substr($dir, -1) eq '/';
226
    for my $cfgname (@fnames) {
227
      $cfgname = $dir.$cfgname;
228
  		$debug>4 and print STDERR "trying configfile=$cfgname\n";
229
	  	if (-r $cfgname) {
230
		  	$verbose>2 and print STDERR "guessed configfile='$cfgname'\n";
231
			  return $cfgname;
232
		  }
233
    }
234
	}
235
236
	croak "Unable to guess a config file for '$scriptname'";
237
} 
238
239
############################
240
# get_params
241
#     IN: 0
242
#    OUT: %params
243
#GoodFor: Get the params that the script got
244
sub get_params {
245
	return %params if %params;
246
	%params=(config=>'',setconfig=>{});
247
	GetOptions(
248
		#config params
249
		"config=s"	=> \$params{config},
250
		"setconfig=s%" => $params{setconfig},
251
252
		#debug and info
253
		"debug=i"		=> \$debug,
254
		"nodebug"		=> sub { $debug=0 },
255
		"verbose=i"	=> \$verbose,
256
		"noverbose"	=> sub { $verbose=0 },
257
	);
258
259
	return %params;
260
} 
261
262
############################
263
# get_env_params
264
#     IN: \%params
265
#    OUT: 0
266
#GoodFor: get params from %ENV
267
sub get_env_params {
268
	my $parms=shift;
269
270
	$parms->{config} ||= $ENV{'CONFIG_FILE'} || '';
271
	$debug  	= $ENV{'DEBUG'}
272
		if $debug<0 and exists $ENV{'DEBUG'};
273
	$verbose	= $ENV{'VERBOSE'}
274
		if $verbose<0 and exists $ENV{'VERBOSE'};
275
} 
276
277
1;
278
__END__
279

+ 18 - 0
t/Config-RecurseINI.t

@ -0,0 +1,18 @@
1
# Before 'make install' is performed this script should be runnable with
2
# 'make test'. After 'make install' it should work as 'perl Config-RecurseINI.t'
3
4
#########################
5
6
# change 'tests => 1' to 'tests => last_test_to_print';
7
8
use strict;
9
use warnings;
10
11
use Test::More tests => 1;
12
BEGIN { use_ok('Config::RecurseINI') };
13
14
#########################
15
16
# Insert your test code below, the Test::More module is use()ed here so read
17
# its man page ( perldoc Test::More ) for help writing this test script.
18