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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
package Config::Model::Itself::BackendDetector ;
# since this package is mostly targeted for dev environments
# let the detector detect models under development
use lib 'lib';
use Pod::POM ;
use File::Find ;
use base qw/Config::Model::Value/ ;
use strict ;
use warnings ;
sub setup_enum_choice {
my $self = shift ;
# using a hash to make sure that a backend is not listed twice. This may
# happen in development environment where a backend in found in /usr/lib
# and in ./lib (or ./blib)
my %choices = map { ($_ => 1);} ref $_[0] ? @{$_[0]} : @_ ;
# find available backends in all @INC directories
my $wanted = sub {
my $n = $File::Find::name ;
if (-f $_ and $n =~ s/\.pm$// and $n !~ /Any$/) {
$n =~ s!.*Backend/!! ;
$n =~ s!/!::!g ;
$choices{$n} = 1 ;
}
} ;
foreach my $inc (@INC) {
my $path = "$inc/Config/Model/Backend" ;
find ($wanted, $path ) if -d $path;
}
$self->SUPER::setup_enum_choice(sort keys %choices) ;
}
sub set_help {
my ($self,$args) = @_ ;
my $help = delete $args->{help} || {} ;
my $path = $INC{"Config/Model.pm"} ;
$path =~ s!\.pm!/Backend! ;
my $parser = Pod::POM->new();
my $wanted = sub {
my $n = $File::Find::name ;
return unless (-f $n and $n !~ /Any\.pm$/) ;
my $file = $n ;
$n =~ s/\.pm$//;
$n =~ s!/!::!g ;
my $perl_name = $n ;
$n =~ s!.*Backend::!! ;
$perl_name =~ s!.*Config!Config! ;
my $pom = $parser->parse_file($file)|| die $parser->error();
foreach my $head1 ($pom->head1()) {
if ($head1->title() eq 'NAME') {
my $c = $head1->content();
$c =~ s/.*?-\s*//;
$c =~ s/\n//g;
$help->{$n} = $c . " provided by L<$perl_name>";
last;
}
}
};
find ($wanted, $path ) ;
$self->{help} = $help;
}
1;
# ABSTRACT: Detect available read/write backends usable by config models
__END__
=head1 SYNOPSIS
# this class should be referenced in a configuration model and
# created only by Config::Model::Node
my $model = Config::Model->new() ;
$model ->create_config_class
(
name => "Test",
'element'
=> [
'backend' => { type => 'leaf',
class => 'Config::Model::Itself::BackendDetector' ,
value_type => 'enum',
# specify backends built in Config::Model
choice => [qw/cds_file perl_file ini_file custom/],
help => {
cds_file => "file ...",
ini_file => "Ini file ...",
perl_file => "file perl",
custom => "Custom format",
}
}
],
);
my $root = $model->instance(root_class_name => 'Test') -> config_root ;
my $backend = $root->fetch_element('backend') ;
my @choices = $backend->get_choice ;
=head1 DESCRIPTION
This class is derived from L<Config::Model::Value>. It is designed to
be used in a 'enum' value where the choice (the available backends)
are the backend built in L<Config::Model> and all the plugin backends. The
plugin backends are all the C<Config::Model::Backend::*> classes.
This module will detect available plugin backend and query their pod
documentation to provide a contextual help for config-model graphical
editor.
=head1 SEE ALSO
L<Config::Model>, L<Config::Model::Node>, L<Config::Model::Value>
=cut
|
