view release on metacpan or  search on metacpan

lib/File/XDG.pm  view on Meta::CPAN

        $path_class = 'Path::Class';
      }
    }

    my $file_class = $path_class eq 'Path::Class' ? 'Path::Class::File' : $path_class;
    my $dir_class  = $path_class eq 'Path::Class' ? 'Path::Class::Dir'  : $path_class;

    if(is_coderef($path_class))
    {
      $dir_class = $file_class = $path_class;
    }
    elsif(is_arrayref($path_class))
    {
      ($file_class, $dir_class) = @$path_class;
    }
    elsif($path_class eq 'Path::Tiny')
    {
      require Path::Tiny;
    }
    elsif($path_class eq 'Path::Class')
    {
      require Path::Class::File;
      require Path::Class::Dir;
    }
    elsif($path_class eq 'File::Spec')
    {
      require File::Spec;
      $file_class = sub { File::Spec->catfile(@_) };
      $dir_class  = sub { File::Spec->catdir(@_) };
    }
    else
    {
      Carp::croak("Unknown path class: $path_class");
    }

    my $strict = delete $args{strict};
    Carp::croak("XDG base directory specification cannot strictly implemented on Windows")
      if $^O eq 'MSWin32' && $strict;

    Carp::croak("unknown arguments: @{[ sort keys %args ]}") if %args;

    my $self = bless {
        name       => $name,
        api        => $api,
        file_class => $file_class,
        dir_class  => $dir_class,
        strict     => $strict,
        runtime    => $ENV{XDG_RUNTIME_DIR},
    }, $class;

    if($^O eq 'MSWin32') {
        my $local = Win32::GetFolderPath(Win32::CSIDL_LOCAL_APPDATA(), 1);
        $self->{home}        = $local;
        $self->{data}        = $ENV{XDG_DATA_HOME}   || "$local\\.local\\share\\";
        $self->{cache}       = $ENV{XDG_CACHE_HOME}  || "$local\\.cache\\";
        $self->{config}      = $ENV{XDG_CONFIG_HOME} || "$local\\.config\\";
        $self->{state}       = $ENV{XDG_STATE_HOME}  || "$local\\.local\\state\\";
        $self->{data_dirs}   = $ENV{XDG_DATA_DIRS}   || '';
        $self->{config_dirs} = $ENV{XDG_CONFIG_DIRS} || '';
    } else {
        my $home = $ENV{HOME} || [getpwuid($>)]->[7];
        $self->{home}        = $home;
        $self->{data}        = $ENV{XDG_DATA_HOME}   || "$home/.local/share/";
        $self->{cache}       = $ENV{XDG_CACHE_HOME}  || "$home/.cache/";
        $self->{state}       = $ENV{XDG_STATE_HOME}  || "$home/.local/state/";
        $self->{config}      = $ENV{XDG_CONFIG_HOME} || "$home/.config/";
        $self->{data_dirs}   = $ENV{XDG_DATA_DIRS}   || '/usr/local/share:/usr/share';
        $self->{config_dirs} = $ENV{XDG_CONFIG_DIRS} || '/etc/xdg';
    }

    return $self;
}

sub _dir {
  my $self = shift;
  is_coderef($self->{dir_class})
    ? $self->{dir_class}->(@_)
    : $self->{dir_class}->new(@_);
}

sub _file {
  my $self = shift;
  is_coderef($self->{dir_class})
    ? $self->{file_class}->(@_)
    : $self->{file_class}->new(@_);
}

sub _dirs {
    my($self, $type) = @_;
    return $self->{"${type}_dirs"} if exists $self->{"${type}_dirs"};
    Carp::croak('invalid _dirs requested');
}

sub _lookup_file {
    my ($self, $type, @subpath) = @_;

    Carp::croak('subpath not specified') unless @subpath;
    Carp::croak("invalid type: $type") unless defined $self->{$type};

    my @dirs = ($self->{$type}, split(/\Q$Config{path_sep}\E/, $self->_dirs($type)));
    my @paths = map { $self->_file($_, @subpath) } @dirs;
    my ($match) = grep { -f $_ } @paths;

    return $match;
}


sub data_home {
    my $self = shift;
    my $xdg = $self->{data};
    return $self->_dir($xdg, $self->{name});
}


sub config_home {
    my $self = shift;
    my $xdg = $self->{config};
    return $self->_dir($xdg, $self->{name});
}