File Coverage

blib/lib/File/ConfigDir.pm
Criterion Covered Total %
statement 114 116 98.2
branch 46 50 96.0
condition 3 3 100.0
subroutine 33 33 100.0
pod 13 13 100.0
total 209 215 98.1


line stmt bran cond sub pod time code
1             package File::ConfigDir;
2              
3 6     6   466473 use strict;
  6         66  
  6         219  
4 6     6   39 use warnings;
  6         13  
  6         220  
5 6     6   2220 use parent 'Exporter';
  6         2274  
  6         36  
6 6     6   381 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS);
  6         12  
  6         343  
7              
8 6     6   38 use Carp qw(croak);
  6         13  
  6         278  
9 6     6   36 use Config;
  6         10  
  6         232  
10 6     6   35 use Cwd ();
  6         11  
  6         99  
11 6     6   31 use Exporter ();
  6         13  
  6         130  
12 6     6   2177 use FindBin ();
  6         5097  
  6         172  
13 6     6   60 use File::Basename ();
  6         17  
  6         122  
14 6     6   44 use File::Spec ();
  6         15  
  6         4509  
15              
16             =head1 NAME
17              
18             File::ConfigDir - Get directories of configuration files
19              
20             =begin html
21              
22             Travis CI
23             Coverage Status
24              
25             =end html
26              
27             =cut
28              
29             $VERSION = '0.020';
30             @EXPORT_OK = (
31             qw(config_dirs system_cfg_dir desktop_cfg_dir),
32             qw(xdg_config_dirs machine_cfg_dir),
33             qw(core_cfg_dir site_cfg_dir vendor_cfg_dir),
34             qw(locallib_cfg_dir local_cfg_dir),
35             qw(here_cfg_dir singleapp_cfg_dir vendorapp_cfg_dir),
36             qw(xdg_config_home user_cfg_dir)
37             );
38             %EXPORT_TAGS = (
39             ALL => [@EXPORT_OK],
40             );
41              
42 6     6   3210 eval "use List::MoreUtils qw/distinct/;"; ## no strict (BuiltinFunctions::ProhibitStringyEval)
  6         86242  
  6         43  
43             __PACKAGE__->can("distinct") or eval <<'EOP';
44             # from PP part of List::MoreUtils
45             sub distinct(&@) {
46             my %h;
47             map { $h{$_}++ == 0 ? $_ : () } @_;
48             }
49             EOP
50              
51             =head1 SYNOPSIS
52              
53             use File::ConfigDir ':ALL';
54              
55             my @cfgdirs = config_dirs();
56             my @appcfgdirs = config_dirs('app');
57              
58             # install support
59             my $site_cfg_dir = (site_cfg_dir())[0];
60             my $vendor_cfg_dir = (site_cfg_dir()))[0];
61              
62             =head1 DESCRIPTION
63              
64             This module is a helper for installing, reading and finding configuration
65             file locations. It's intended to work in every supported Perl5 environment
66             and will always try to Do The Right Thing(TM).
67              
68             C is a module to help out when perl modules (especially
69             applications) need to read and store configuration files from more than
70             one location. Writing user configuration is easy thanks to
71             L, but what when the system administrator needs to place
72             some global configuration or there will be system related configuration
73             (in C on UNIX(TM) or C<$ENV{windir}> on Windows(TM)) and some
74             network configuration in NFS mapped C or
75             C<$ENV{ALLUSERSPROFILE} . "\\Application Data\\p5-app">, respectively.
76              
77             C has no "do what I mean" mode - it's entirely up to the
78             user to pick the right directory for each particular application.
79              
80             =head1 EXPORT
81              
82             Every function listed below can be exported, either by name or using the
83             tag C<:ALL>.
84              
85             =head1 SUBROUTINES/METHODS
86              
87             All functions can take one optional argument as application specific
88             configuration directory. If given, it will be embedded at the right (TM)
89             place of the resulting path.
90              
91             =cut
92              
93             sub _find_common_base_dir
94             {
95 8     8   2733 my ($dira, $dirb) = @_;
96 8         89 my ($va, $da, undef) = File::Spec->splitpath($dira, 1);
97 8         53 my ($vb, $db, undef) = File::Spec->splitpath($dirb, 1);
98 8         61 my @dirsa = File::Spec->splitdir($da);
99 8         43 my @dirsb = File::Spec->splitdir($db);
100 8         19 my @commondir;
101 8 100       37 my $max = $#dirsa < $#dirsb ? $#dirsa : $#dirsb;
102 8         37 for my $i (0 .. $max)
103             {
104 18 50       55 $dirsa[$i] eq $dirsb[$i] or last;
105 18         57 push(@commondir, $dirsa[$i]);
106             }
107              
108 8         135 File::Spec->catpath($va, File::Spec->catdir(@commondir));
109             }
110              
111             =head2 system_cfg_dir
112              
113             Returns the configuration directory where configuration files of the
114             operating system resides. For Unices this is C, for MSWin32 it's
115             the value of the environment variable C<%windir%>.
116              
117             =cut
118              
119             my $system_cfg_dir = sub {
120             my @cfg_base = @_;
121             my @dirs = File::Spec->catdir($^O eq "MSWin32" ? $ENV{windir} : "/etc", @cfg_base);
122             @dirs;
123             };
124              
125             sub system_cfg_dir
126             {
127 2     2 1 1943 my @cfg_base = @_;
128 2 100       160 1 < scalar(@cfg_base)
129             and croak "system_cfg_dir(;\$), not system_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
130 1         12 $system_cfg_dir->(@cfg_base);
131             }
132              
133             =head2 machine_cfg_dir
134              
135             Alias for desktop_cfg_dir - deprecated.
136              
137             =head2 xdg_config_dirs
138              
139             Alias for desktop_cfg_dir
140              
141             =head2 desktop_cfg_dir
142              
143             Returns the configuration directory where configuration files of the
144             desktop applications resides. For Unices this is C, for MSWin32
145             it's the value of the environment variable C<%ALLUSERSPROFILE%>
146             concatenated with the basename of the environment variable C<%APPDATA%>.
147              
148             =cut
149              
150             my $desktop_cfg_dir = sub {
151             my @cfg_base = @_;
152             my @dirs;
153             if ($^O eq "MSWin32")
154             {
155             my $alluserprof = $ENV{ALLUSERSPROFILE};
156             my $appdatabase = File::Basename::basename($ENV{APPDATA});
157             @dirs = (File::Spec->catdir($alluserprof, $appdatabase, @cfg_base));
158             }
159             else
160             {
161             if ($ENV{XDG_CONFIG_DIRS})
162             {
163             @dirs = split(":", $ENV{XDG_CONFIG_DIRS});
164             @dirs = map { File::Spec->catdir($_, @cfg_base) } @dirs;
165             }
166             else
167             {
168             @dirs = (File::Spec->catdir("/etc", "xdg", @cfg_base));
169             }
170             }
171             @dirs;
172             };
173              
174             sub desktop_cfg_dir
175             {
176 3     3 1 2891 my @cfg_base = @_;
177 3 100       150 1 < scalar(@cfg_base)
178             and croak "desktop_cfg_dir(;\$), not desktop_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
179 2         16 $desktop_cfg_dir->(@cfg_base);
180             }
181              
182 6     6   68 no warnings 'once';
  6         16  
  6         517  
183             *machine_cfg_dir = \&desktop_cfg_dir;
184             *xdg_config_dirs = \&desktop_cfg_dir;
185 6     6   46 use warnings;
  6         11  
  6         7143  
186              
187             =head2 core_cfg_dir
188              
189             Returns the C directory below C<$Config{prefix}>.
190              
191             =cut
192              
193             my $core_cfg_dir = sub {
194             my @cfg_base = @_;
195             my @dirs = (File::Spec->catdir($Config{prefix}, "etc", @cfg_base));
196             @dirs;
197             };
198              
199             sub core_cfg_dir
200             {
201 2     2 1 1498 my @cfg_base = @_;
202 2 100       197 1 < scalar(@cfg_base)
203             and croak "core_cfg_dir(;\$), not core_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
204 1         4 $core_cfg_dir->(@cfg_base);
205             }
206              
207             =head2 site_cfg_dir
208              
209             Returns the C directory below C<$Config{sitelib_stem}> or the common
210             base directory of C<$Config{sitelib}> and C<$Config{sitebin}>.
211              
212             =cut
213              
214             my $site_cfg_dir = sub {
215             my @cfg_base = @_;
216             my @dirs;
217              
218             if ($Config{sitelib_stem})
219             {
220             push(@dirs, File::Spec->catdir($Config{sitelib_stem}, "etc", @cfg_base));
221             }
222             else
223             {
224             my $sitelib_stem = _find_common_base_dir($Config{sitelib}, $Config{sitebin});
225             push(@dirs, File::Spec->catdir($sitelib_stem, "etc", @cfg_base));
226             }
227              
228             @dirs;
229             };
230              
231             sub site_cfg_dir
232             {
233 2     2 1 1461 my @cfg_base = @_;
234 2 100       147 1 < scalar(@cfg_base)
235             and croak "site_cfg_dir(;\$), not site_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
236 1         9 $site_cfg_dir->(@cfg_base);
237             }
238              
239             =head2 vendor_cfg_dir
240              
241             Returns the C directory below C<$Config{vendorlib_stem}> or the common
242             base directory of C<$Config{vendorlib}> and C<$Config{vendorbin}>.
243              
244             =cut
245              
246             my $vendor_cfg_dir = sub {
247             my @cfg_base = @_;
248             my @dirs;
249              
250             if ($Config{vendorlib_stem})
251             {
252             push(@dirs, File::Spec->catdir($Config{vendorlib_stem}, "etc", @cfg_base));
253             }
254             else
255             {
256             my $vendorlib_stem = _find_common_base_dir($Config{vendorlib}, $Config{vendorbin});
257             push(@dirs, File::Spec->catdir($vendorlib_stem, "etc", @cfg_base));
258             }
259              
260             @dirs;
261             };
262              
263             sub vendor_cfg_dir
264             {
265 2     2 1 1565 my @cfg_base = @_;
266 2 100       150 1 < scalar(@cfg_base)
267             and croak "vendor_cfg_dir(;\$), not vendor_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
268 1         3 $vendor_cfg_dir->(@cfg_base);
269             }
270              
271             =head2 singleapp_cfg_dir
272              
273             Returns the configuration file for stand-alone installed applications. In
274             Unix speak, installing JRE to C<< /usr/local/jre- >> means there is
275             a C<< /usr/local/jre-/bin/java >> and going from it's directory
276             name one above and into C there is the I. For a
277             Perl module it means, we're assuming that C<$FindBin::Bin> is installed as
278             a stand-alone package somewhere, e.g. into C - as recommended for
279             L.
280              
281             =cut
282              
283             my $singleapp_cfg_dir = sub {
284             my @dirs = (
285             map {
286             eval { Cwd::abs_path($_) }
287             or File::Spec->canonpath($_)
288             } File::Spec->catdir($FindBin::RealDir, "..", "etc")
289             );
290             @dirs;
291             };
292              
293             sub singleapp_cfg_dir
294             {
295 2     2 1 1493 my @cfg_base = @_;
296 2 100       196 0 == scalar(@cfg_base)
297             or croak "singleapp_cfg_dir(), not singleapp_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
298 1         3 $singleapp_cfg_dir->();
299             }
300              
301             =head2 vendorapp_cfg_dir
302              
303             Returns the configuration file for vendor installed applications. In Unix
304             speak, installing bacula to C<< /opt/${vendor} >> means there is
305             a C<< /opt/${vendor}/bin/bacula >> and going from it's directory
306             name one above and into C there is the I. For a
307             Perl module it means, we're assuming that C<$FindBin::Bin> is installed as
308             a stand-alone package somewhere, e.g. into C - as recommended for
309             L.
310              
311             =cut
312              
313             my $vendorapp_cfg_dir = sub {
314             my @cfg_base = @_;
315             my @dirs = (
316             map {
317             eval { Cwd::abs_path($_) }
318             or File::Spec->canonpath($_)
319             } File::Spec->catdir($FindBin::RealDir, "..", "etc", @cfg_base)
320             );
321             @dirs;
322             };
323              
324             sub vendorapp_cfg_dir
325             {
326 2     2 1 1934 my @cfg_base = @_;
327 2 100       157 1 < scalar(@cfg_base)
328             and croak "vendorapp_cfg_dir(;\$), not vendorapp_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
329 1         5 $vendorapp_cfg_dir->(@cfg_base);
330             }
331              
332             =head2 local_cfg_dir
333              
334             Returns the configuration directory for distribution independent, 3rd
335             party applications. While this directory doesn't exists for MSWin32,
336             there will be only the path C for Unices.
337              
338             =cut
339              
340             my $local_cfg_dir = sub {
341             my @cfg_base = @_;
342             my @dirs;
343              
344             unless ($^O eq "MSWin32")
345             {
346             push(@dirs, File::Spec->catdir("/usr", "local", "etc", @cfg_base));
347             }
348              
349             @dirs;
350             };
351              
352             sub local_cfg_dir
353             {
354 2     2 1 1626 my @cfg_base = @_;
355 2 100       201 1 < scalar(@cfg_base)
356             and croak "local_cfg_dir(;\$), not local_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
357 1         36 $local_cfg_dir->(@cfg_base);
358             }
359              
360             =head2 locallib_cfg_dir
361              
362             Extracts the C from C<$ENV{PERL_MM_OPT}> and returns the
363             C directory below it.
364              
365             =cut
366              
367             my $haveLocalLib;
368              
369             BEGIN
370             {
371             # uncoverable branch false
372 6 50   6   553 defined $haveLocalLib or $haveLocalLib = eval "use local::lib (); local::lib->can('active_paths');";
  6     6   960  
  0         0  
  0         0  
373 6 50       2540 defined $haveLocalLib or $haveLocalLib = 0;
374             }
375              
376             my $locallib_cfg_dir = sub {
377             my @cfg_base = @_;
378             my @dirs;
379              
380             $haveLocalLib and push(@dirs, map { File::Spec->catdir($_, "etc", @cfg_base) } local::lib->active_paths);
381              
382             @dirs;
383             };
384              
385             sub locallib_cfg_dir
386             {
387 3     3 1 2324 my @cfg_base = @_;
388 3 100       146 1 < scalar(@cfg_base)
389             and croak "locallib_cfg_dir(;\$), not locallib_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
390 2         10 $locallib_cfg_dir->(@cfg_base);
391             }
392              
393             =head2 here_cfg_dir
394              
395             Returns the path for the C directory below the current working directory.
396              
397             =cut
398              
399             my $here_cfg_dir = sub {
400             my @cfg_base = @_;
401             my @dirs = (File::Spec->catdir(File::Spec->rel2abs(File::Spec->curdir()), @cfg_base, "etc"));
402             @dirs;
403             };
404              
405             sub here_cfg_dir
406             {
407 2     2 1 1967 my @cfg_base = @_;
408 2 100       157 1 < scalar(@cfg_base)
409             and croak "here_cfg_dir(;\$), not here_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
410 1         4 $here_cfg_dir->(@cfg_base);
411             }
412              
413             my $haveFileHomeDir;
414              
415             BEGIN
416             {
417             # uncoverable branch false
418 6 50   6   490 defined $haveFileHomeDir or $haveFileHomeDir = eval "use File::HomeDir; 1";
  6     6   3099  
  5         32179  
  5         239  
419 6 100       4836 defined $haveFileHomeDir or $haveFileHomeDir = 0;
420             }
421              
422             =head2 user_cfg_dir
423              
424             Returns the users home folder using L. Without
425             File::HomeDir, nothing is returned.
426              
427             =cut
428              
429             my $user_cfg_dir = sub {
430             my @cfg_base = @_;
431             my @dirs;
432              
433             my $homedir;
434             $haveFileHomeDir and $homedir = File::HomeDir->my_home();
435             $homedir |= $ENV{HOME} if defined $ENV{HOME};
436             $homedir |= File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}) if defined $ENV{HOMEDRIVE} and defined $ENV{HOMEPATH};
437              
438             $homedir and @dirs = (File::Spec->catdir($homedir, map { "." . $_ } @cfg_base));
439              
440             @dirs;
441             };
442              
443             sub user_cfg_dir
444             {
445 4     4 1 3123 my @cfg_base = @_;
446 4 100       174 1 < scalar(@cfg_base)
447             and croak "user_cfg_dir(;\$), not user_cfg_dir(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
448 3         10 $user_cfg_dir->(@cfg_base);
449             }
450              
451             =head2 xdg_config_home
452              
453             Returns the user configuration directory for desktop applications.
454             If C<< $ENV{XDG_CONFIG_HOME} >> is not set, for MSWin32 the value
455             of C<< $ENV{APPDATA} >> is return and on Unices the C<.config> directory
456             in the users home folder. Without L, on Unices the returned
457             list might be empty.
458              
459             =cut
460              
461             my $xdg_config_home = sub {
462             my @cfg_base = @_;
463             my @dirs;
464              
465             if ($ENV{XDG_CONFIG_HOME})
466             {
467             @dirs = split(":", $ENV{XDG_CONFIG_HOME});
468             @dirs = map { File::Spec->catdir($_, @cfg_base) } @dirs;
469             }
470             elsif ($^O eq "MSWin32")
471             {
472             @dirs = (File::Spec->catdir($ENV{APPDATA}, @cfg_base));
473             }
474             else
475             {
476             $haveFileHomeDir and @dirs = (File::Spec->catdir(File::HomeDir->my_home(), ".config", @cfg_base));
477             }
478              
479             @dirs;
480             };
481              
482             sub xdg_config_home
483             {
484 2     2 1 1753 my @cfg_base = @_;
485 2 100       160 1 < scalar(@cfg_base)
486             and croak "xdg_config_home(;\$), not xdg_config_home(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
487 1         4 $xdg_config_home->(@cfg_base);
488             }
489              
490             my (@extensible_bases, @pure_bases);
491             push(@extensible_bases,
492             $system_cfg_dir, $desktop_cfg_dir, $local_cfg_dir, $singleapp_cfg_dir, $vendorapp_cfg_dir, $core_cfg_dir,
493             $site_cfg_dir, $vendor_cfg_dir, $here_cfg_dir, $user_cfg_dir, $xdg_config_home);
494             push(@pure_bases, 3);
495              
496             =head2 config_dirs
497              
498             @cfgdirs = config_dirs();
499             @cfgdirs = config_dirs( 'appname' );
500              
501             Tries to get all available configuration directories as described above.
502             Returns those who exists and are readable.
503              
504             =cut
505              
506             sub config_dirs
507             {
508 5     5 1 3588 my @cfg_base = @_;
509 5 100       217 1 < scalar(@cfg_base)
510             and croak "config_dirs(;\$), not config_dirs(" . join(",", ("\$") x scalar(@cfg_base)) . ")";
511 4         10 my @dirs = ();
512              
513 4         9 my $pure_idx = 0;
514 4         17 foreach my $idx (0 .. $#extensible_bases)
515             {
516 48         112 my $pure;
517 48 100 100     202 $pure_idx <= $#pure_bases and $idx == $pure_bases[$pure_idx] and $pure = ++$pure_idx;
518 48 100       202 push(@dirs, $extensible_bases[$idx]->(($pure ? () : @cfg_base)));
519             }
520              
521 4 100       81 @dirs = grep { -d $_ && -r $_ } distinct(@dirs);
  33         724  
522              
523 4         29 @dirs;
524             }
525              
526             =head2 _plug_dir_source
527              
528             my $dir_src = sub { return _better_config_dir(@_); }
529             File::ConfigDir::_plug_dir_source($dir_src);
530              
531             my $pure_src = sub { return _better_config_plain_dir(@_); }
532             File::ConfigDir::_plug_dir_source($pure_src, 1); # see 2nd arg is true
533              
534             Registers more sources to ask for suitable directories to check or search
535             for config files. Each L will traverse them in subsequent
536             invocations, too.
537              
538             Returns the number of directory sources in case of success. Returns nothing
539             when C<$dir_src> is not a code ref.
540              
541             =cut
542              
543             sub _plug_dir_source
544             {
545 5     5   911 my ($dir_source, $pure) = @_;
546              
547 5 100       19 $dir_source or return;
548 3 100       16 "CODE" eq ref $dir_source or return;
549              
550 2         6 push(@extensible_bases, $dir_source);
551 2 100       5 $pure and push(@pure_bases, $#extensible_bases);
552 2         13 1;
553             }
554              
555             =head1 AUTHOR
556              
557             Jens Rehsack, C<< >>
558              
559             =head1 BUGS
560              
561             Please report any bugs or feature requests to
562             C, or through the web interface at
563             L.
564             I will be notified, and then you'll automatically be notified of progress
565             on your bug as I make changes.
566              
567             =head1 SUPPORT
568              
569             You can find documentation for this module with the perldoc command.
570              
571             perldoc File::ConfigDir
572              
573             You can also look for information at:
574              
575             =over 4
576              
577             =item * RT: CPAN's request tracker
578              
579             L
580              
581             =item * AnnoCPAN: Annotated CPAN documentation
582              
583             L
584              
585             =item * CPAN Ratings
586              
587             L
588              
589             =item * Search CPAN
590              
591             L
592              
593             =back
594              
595             =head1 ACKNOWLEDGEMENTS
596              
597             Thanks are sent out to Lars Dieckow (daxim) for his suggestion to add
598             support for the Base Directory Specification of the Free Desktop Group.
599             Matthew S. Trout (mst) earns the credit to suggest C
600             and remind about C.
601              
602             =head1 LICENSE AND COPYRIGHT
603              
604             Copyright 2010-2018 Jens Rehsack.
605              
606             This program is free software; you can redistribute it and/or modify it
607             under the terms of either: the GNU General Public License as published
608             by the Free Software Foundation; or the Artistic License.
609              
610             See http://dev.perl.org/licenses/ for more information.
611              
612             =head1 SEE ALSO
613              
614             L, L, L (Unices only)
615              
616             =cut
617              
618             1; # End of File::ConfigDir