File Coverage

blib/lib/File/BaseDir.pm
Criterion Covered Total %
statement 41 41 100.0
branch 20 20 100.0
condition 8 9 88.8
subroutine 22 22 100.0
pod 13 15 86.6
total 104 107 97.2


line stmt bran cond sub pod time code
1             package File::BaseDir;
2              
3 6     6   28364 use strict;
  6         9  
  6         174  
4 6     6   24 use Carp;
  6         8  
  6         4665  
5             require File::Spec;
6             require Exporter;
7              
8             our $VERSION = 0.07;
9              
10             our @ISA = qw(Exporter);
11             our %EXPORT_TAGS = (
12             vars => [ qw(
13             xdg_data_home xdg_data_dirs
14             xdg_config_home xdg_config_dirs
15             xdg_cache_home
16             ) ],
17             lookup => [ qw(
18             data_home data_dirs data_files
19             config_home config_dirs config_files
20             cache_home
21             ) ],
22             );
23             our @EXPORT_OK = (
24             qw(xdg_data_files xdg_config_files),
25             map @$_, values %EXPORT_TAGS
26             );
27              
28             # Set root and home directories
29             my $rootdir = File::Spec->rootdir();
30             if ($^O eq 'MSWin32') {
31             $rootdir = 'C:\\'; # File::Spec default depends on CWD
32             $ENV{HOME} ||= $ENV{USERPROFILE} || $ENV{HOMEDRIVE}.$ENV{HOMEPATH};
33             # logic from File::HomeDir::Windows
34             }
35             my $home = $ENV{HOME};
36             unless ($home) {
37             # Default to operating system's home dir. NOTE: web applications may not have $ENV{HOME} assigned,
38             # so don't issue a warning. See RT bug #41744
39             $home = $rootdir;
40             }
41              
42             # Set defaults
43             our $xdg_data_home = File::Spec->catdir($home, qw/.local share/);
44             our @xdg_data_dirs = (
45             File::Spec->catdir($rootdir, qw/usr local share/),
46             File::Spec->catdir($rootdir, qw/usr share/),
47             );
48             our $xdg_config_home = File::Spec->catdir($home, '.config');
49             our @xdg_config_dirs = ( File::Spec->catdir($rootdir, qw/etc xdg/) );
50             our $xdg_cache_home = File::Spec->catdir($home, '.cache');
51              
52             # OO method
53 1     1 1 16 sub new { bless \$VERSION, shift } # what else is there to bless ?
54              
55             # Variable methods
56 15 100   15 1 65 sub xdg_data_home { $ENV{XDG_DATA_HOME} || $xdg_data_home }
57              
58             sub xdg_data_dirs {
59 14 100   14 1 431 ( $ENV{XDG_DATA_DIRS}
60             ? _adapt($ENV{XDG_DATA_DIRS})
61             : @xdg_data_dirs
62             )
63             }
64              
65 8 100   8 1 537 sub xdg_config_home {$ENV{XDG_CONFIG_HOME} || $xdg_config_home }
66              
67             sub xdg_config_dirs {
68 7 100   7 1 24 ( $ENV{XDG_CONFIG_DIRS}
69             ? _adapt($ENV{XDG_CONFIG_DIRS})
70             : @xdg_config_dirs
71             )
72             }
73              
74 3 100   3 1 16 sub xdg_cache_home { $ENV{XDG_CACHE_HOME} || $xdg_cache_home }
75              
76             sub _adapt {
77 15     15   52 map { File::Spec->catdir( split('/', $_) ) } split /[:;]/, shift;
  44         182  
78             # ':' defined in the spec, but ';' is standard on win32
79             }
80              
81             # Lookup methods
82 3     3 1 604 sub data_home { _catfile(xdg_data_home, @_) }
83              
84 6     6 1 23 sub data_dirs { _find_files(\&_dir, \@_, xdg_data_home, xdg_data_dirs) }
85              
86 4     4 1 9 sub data_files { _find_files(\&_file, \@_, xdg_data_home, xdg_data_dirs) }
87              
88 1     1 0 1 sub xdg_data_files { my @dirs = data_files(@_); return @dirs }
  1         5  
89              
90 1     1 1 2 sub config_home { _catfile(xdg_config_home, @_) }
91              
92 2     2 1 5 sub config_dirs { _find_files(\&_dir, \@_, xdg_config_home, xdg_config_dirs) }
93              
94 3     3 1 6 sub config_files { _find_files(\&_file, \@_, xdg_config_home, xdg_config_dirs) }
95              
96 1     1 0 2 sub xdg_config_files { my @dirs = config_files(@_); return @dirs }
  1         5  
97              
98 1     1 1 94 sub cache_home { _catfile(xdg_cache_home, @_) }
99              
100             sub _catfile {
101 5     5   8 my $dir = shift;
102 5 100 100     19 shift if ref $_[0] or $_[0] =~ /::/; # OO call
103 5         49 return File::Spec->catfile($dir, @_);
104             }
105              
106             sub _find_files {
107 15     15   11 my $type = shift;
108 15         12 my $file = shift;
109 15 100 100     64 shift @$file if ref $$file[0] or $$file[0] =~ /::/; # OO call
110             #warn "Looking for: @$file\n in: @_\n";
111 15 100       19 if (wantarray) {
112 27 100       26 return grep { &$type( $_ ) && -r $_ }
  27         101  
113 7         8 map { File::Spec->catfile($_, @$file) } @_;
114             }
115             else { # prevent unnecessary stats by returning early
116 8         13 for (@_) {
117 18         78 my $path = File::Spec->catfile($_, @$file);
118 18 100 66     26 return $path if &$type($path) && -r $path;
119             }
120             }
121 2         16 return ();
122             }
123              
124 21     21   234 sub _dir { -d $_[0] }
125              
126 24     24   224 sub _file { -f $_[0] }
127              
128             1;
129              
130             __END__