File Coverage

blib/lib/No/Worries/Dir.pm

Criterion	Covered	Total	%
statement	56	56	100.0
branch	25	32	78.1
condition	5	6	83.3
subroutine	14	14	100.0
pod	6	6	100.0
total	106	114	92.9

#+##############################################################################
#                                                                              #
# File: No/Worries/Dir.pm                                                      #
#                                                                              #
# Description: directory handling without worries                              #
#                                                                              #
#-##############################################################################

#
# module definition
#

package No::Worries::Dir;
use strict;
use warnings;
our $VERSION  = "1.7";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);

#
# used modules
#

use No::Worries qw($_IntegerRegexp);
use No::Worries::Die qw(dief);
use No::Worries::Export qw(export_control);
use Params::Validate qw(validate :types);

#
# change the working directory
#

sub dir_change ($) {
    my($path) = @_;

    chdir($path) or dief("cannot chdir(%s): %s", $path, $!);
}

#
# ensure that a directory exists
#

# really make a directory, recursively

sub _mkdir ($$);
sub _mkdir ($$) {
    my($path, $mode) = @_;

    if ($path =~ m{^(.+)/[^/]+$} and not -d $1) {
        _mkdir($1, $mode);
    }
    mkdir($path, $mode)
        or dief("cannot mkdir(%s, %04o): %s", $path, $mode, $!);
}

# public interface

my %dir_ensure_options = (
    mode => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
);

sub dir_ensure ($@) {
    my($path, %option);

    $path = shift(@_);
    %option = validate(@_, \%dir_ensure_options) if @_;
    $option{mode} = oct(777) unless defined($option{mode});
    $path =~ s{/+$}{};
    _mkdir($path, $option{mode}) unless $path eq "" or -d $path;
}

#
# make a directory
#

my %dir_make_options = (
    mode => { optional => 1, type => SCALAR, regex => $_IntegerRegexp },
);

sub dir_make ($@) {
    my($path, %option);

    $path = shift(@_);
    %option = validate(@_, \%dir_make_options) if @_;
    $option{mode} = oct(777) unless defined($option{mode});
    mkdir($path, $option{mode})
        or dief("cannot mkdir(%s, %04o): %s", $path, $option{mode}, $!);
}

#
# return the parent directory of the given path
#

sub dir_parent ($) {
    my($path) = @_;

    return(".") if $path eq "";
    $path =~ s{/+$}{};
    return("/") if $path eq "";
    $path =~ s{[^/]+$}{};
    return(".") if $path eq "";
    $path =~ s{/+$}{};
    return("/") if $path eq "";
    return($path);
}

#
# read a directory
#

sub dir_read ($) {
    my($path) = @_;
    my($dh, @list);

    opendir($dh, $path) or dief("cannot opendir(%s): %s", $path, $!);
    @list = grep($_ !~ /^\.\.?$/, readdir($dh));
    closedir($dh) or dief("cannot closedir(%s): %s", $path, $!);
    return(@list);
}

#
# remove a directory
#

sub dir_remove ($) {
    my($path) = @_;

    rmdir($path) or dief("cannot rmdir(%s): %s", $path, $!);
}

#
# export control
#

sub import : method {
    my($pkg, %exported);

    $pkg = shift(@_);
    grep($exported{$_}++,
         map("dir_$_", qw(change ensure make parent read remove)));
    export_control(scalar(caller()), $pkg, \%exported, @_);
}

1;

__DATA__