File Coverage

blib/lib/File/BaseDir.pm

Criterion	Covered	Total	%
statement	52	53	98.1
branch	21	22	95.4
condition	9	12	75.0
subroutine	27	27	100.0
pod	13	15	86.6
total	122	129	94.5

package File::BaseDir;

use strict;
use warnings;
use Exporter 5.57 qw( import );
use File::Spec;
use Config;

# ABSTRACT: Use the Freedesktop.org base directory specification
our $VERSION = '0.09'; # VERSION

our %EXPORT_TAGS = (
  vars => [ qw(
    xdg_data_home xdg_data_dirs
    xdg_config_home xdg_config_dirs
    xdg_cache_home
  ) ],
  lookup => [ qw(
    data_home data_dirs data_files
    config_home config_dirs config_files
    cache_home
  ) ],
);
our @EXPORT_OK = (
  qw(xdg_data_files xdg_config_files),
  map @$_, values %EXPORT_TAGS
);

if($^O eq 'MSWin32')
{
  *_rootdir = sub { 'C:\\' };
  *_home    = sub { $ENV{USERPROFILE} || $ENV{HOMEDRIVE}.$ENV{HOMEPATH} || 'C:\\' };
}
else
{
  *_rootdir = sub { File::Spec->rootdir };
  *_home    = sub { $ENV{HOME} || eval { [getpwuid($>)]->[7] } || File::Spec->rootdir };
}

# OO method
sub new { bless \$VERSION, shift } # what else is there to bless ?

# Variable methods
sub xdg_data_home { $ENV{XDG_DATA_HOME} || File::Spec->catdir(_home(), qw/.local share/) }

sub xdg_data_dirs {
  ( $ENV{XDG_DATA_DIRS}
    ? _adapt($ENV{XDG_DATA_DIRS})
    : (File::Spec->catdir(_rootdir(), qw/usr local share/), File::Spec->catdir(_rootdir(), qw/usr share/))
  )
}

sub xdg_config_home {$ENV{XDG_CONFIG_HOME} || File::Spec->catdir(_home(), '.config') }

sub xdg_config_dirs {
  ( $ENV{XDG_CONFIG_DIRS}
    ? _adapt($ENV{XDG_CONFIG_DIRS})
    : File::Spec->catdir(_rootdir(), qw/etc xdg/)
  )
}

sub xdg_cache_home { $ENV{XDG_CACHE_HOME} || File::Spec->catdir(_home(), '.cache') }

sub _adapt {
  map { File::Spec->catdir( split(/\//, $_) ) } split /\Q$Config{path_sep}\E/, shift;
    # ':' defined in the spec, but ';' is standard on win32
}

# Lookup methods
sub data_home { _catfile(xdg_data_home, @_) }

sub data_dirs { _find_files(\&_dir, \@_, xdg_data_home, xdg_data_dirs) }

sub data_files { _find_files(\&_file, \@_, xdg_data_home, xdg_data_dirs) }

sub xdg_data_files { my @dirs = data_files(@_); return @dirs }

sub config_home { _catfile(xdg_config_home, @_) }

sub config_dirs { _find_files(\&_dir, \@_, xdg_config_home, xdg_config_dirs) }

sub config_files { _find_files(\&_file, \@_, xdg_config_home, xdg_config_dirs) }

sub xdg_config_files { my @dirs = config_files(@_); return @dirs }

sub cache_home { _catfile(xdg_cache_home, @_) }

sub _catfile {
  my $dir = shift;
  shift if ref $_[0] or $_[0] =~ /::/; # OO call
  return File::Spec->catfile($dir, @_);
}

sub _find_files {
  my $type = shift;
  my $file = shift;
  shift @$file if ref $$file[0] or $$file[0] =~ /::/; # OO call
  #warn "Looking for: @$file\n         in: @_\n";
  if (wantarray) {  ## no critic (Community::Wantarray)
    return grep { &$type( $_ ) && -r $_ }
           map  { File::Spec->catfile($_, @$file) } @_;
  }
  else { # prevent unnecessary stats by returning early
    for (@_) {
      my $path = File::Spec->catfile($_, @$file);
      return $path if &$type($path) && -r $path;
    }
  }
  return ();
}

sub _dir { -d $_[0] }

sub _file { -f $_[0] }

1;

__END__