view release on metacpan or  search on metacpan

lib/File/Create/Layout.pm  view on Meta::CPAN

        my $extras;
        if ($line =~ s/\s+(\S.*)//) {
            $extras = $1;
            eval { $extras = _decode_json("{$extras}") };
            die "(layout):$linum: Invalid unquoted JSON hash in extras: $@: $extras"
                if $@;
            if (defined $extras->{content}) {
                die "(layout):$linum: Directory must not have 'content': $@: $orig_line"
                    if $is_dir;
            }
        }

        push @res, {
            name       => $name,
            is_dir     => $is_dir,
            is_symlink => defined($sym_target) ? 1:0,
            (symlink_target => $sym_target) x !!(defined $sym_target),
            level      => $#indents >= 0 ? $#indents : 0,
            _linum     => $linum,
            perm       => $perm,
            perm_octal => $orig_perm,
            user       => $user,
            group      => $group,
            (content    => $extras->{content}) x !!(defined $extras->{content}),
        };

        $prev_is_dir = $is_dir;
    }

    \@res;
}

$SPEC{create_files_using_layout} = {
    v => 1.1,
    summary => 'Create files/directories according to a layout',
    description => <<'_',

This routine can be used to quickly create several files/directories according
to a layout which you specify. The layout uses a few simple rules and common
conventions usually found in Linux/Unix environment.

You can use this routine e.g. in a test script.

_
    args => {
        %arg_layout,
        prefix => {
            summary => 'Root directory to create the files/directories in',
            description => <<'_',

Directory must already exist.

If unspecified, will simply create starting from current directory.

_
            schema => 'str*',
        },
    },
};
sub create_files_using_layout {
    require File::chown;

    my %args = @_;

    my $parse_res;
    eval { $parse_res = _parse_layout($args{layout}) };
    return [400, "Syntax error in layout: $@"] if $@;

    my $prefix = $args{prefix};
    local $CWD = $prefix // $CWD;
    $prefix //= ".";

    my $prev_level;
    my @dirs;
    for my $e (@$parse_res) {
        my $p = $prefix . join("", map {"/$_"} @dirs);

        if (defined $prev_level) {
            if ($e->{level} > $prev_level) {
                log_trace("chdir %s ...", $dirs[-1]);
                eval { $CWD = $dirs[-1] };
                return [500, "Can't chdir to $p/$e->{name}: $! (cwd=$CWD)"] if $@;
            } elsif ($e->{level} < $prev_level) {
                my $dir = join("/", (("..") x ($prev_level - $e->{level})));
                splice @dirs, $e->{level};
                $p = $prefix . join("", map {"/$_"} @dirs);
                log_trace("chdir back %s ...", $dir);
                eval { $CWD = $dir };
                return [500, "Can't chdir back to $dir: $! (cwd=$CWD)"]
                    if $@;
            }
        }

        log_trace("Creating %s/%s%s ...",
                     $p, $e->{name}, $e->{is_dir} ? "/":"");
        if ($e->{is_dir}) {
            do {
                if (defined $e->{perm}) {
                    mkdir($e->{name}, $e->{perm});
                } else {
                    mkdir($e->{name});
                }
            } or return [500, "Can't create directory $p/$e->{name}: $!"];
            $dirs[$e->{level}] = $e->{name};
        } elsif ($e->{is_symlink}) {
            symlink($e->{symlink_target}, $e->{name})
                or return [500, "Can't create symlink $p/$e->{name} -> ".
                           "$e->{symlink_target}: $!"];
        } else {
            open my($fh), ">", $e->{name}
                or return [500, "Can't create file $p/$e->{name}: $!"];
            if (defined $e->{content}) {
                print $fh $e->{content}
                    or return [500, "Can't write content to file ".
                               "$p/$e->{name}: $!"];
            }
            if (defined $e->{perm}) {
                chmod($e->{perm}, $e->{name})
                    or return [500, "Can't chmod file $p/$e->{name}: $!"];
            }
        }

        if (defined($e->{user}) || defined($e->{group})) {
            my %opts;
            $opts{deref} = 0 if $e->{is_symlink};
            File::chown::chown(\%opts, $e->{user}, $e->{group}, $e->{name})
                  or return [500, "Can't chown file $p/$e->{name}: $!"];
        }

        $prev_level = $e->{level};
    }

    [200, "OK"];
}

$SPEC{check_layout} = {
    v => 1.1,
    summary => 'Check whether layout has syntax errors',
    args => {
        %arg_layout,
    },
};
sub check_layout {
    my %args = @_;

    eval { _parse_layout($args{layout}) };
    my $err = $@;
    [200, "OK", $err ? 0:1, {'func.error' => $err}];
}

$SPEC{parse_layout} = {
    v => 1.1,
    summary => 'Parse layout string into a data structure '.
        'suitable for processing',
    args => {
        %arg_layout,
    },
};
sub parse_layout {
    my %args = @_;

    my $res;
    eval { $res = _parse_layout($args{layout}) };
    return [400, "Layout has error(s): $@"] if $@;
    [200, "OK", $res];
}

1;
# ABSTRACT: Quickly create files/directories according to a layout

__END__

=pod

=encoding UTF-8

=head1 NAME

File::Create::Layout - Quickly create files/directories according to a layout

=head1 VERSION

This document describes version 0.060 of File::Create::Layout (from Perl distribution File-Create-Layout), released on 2019-04-16.

=head1 SYNOPSIS

 use File::Create::Layout qw(