view release on metacpan or  search on metacpan

lib/CTK/Skel.pm  view on Meta::CPAN

    # Get skels list
    my @skels = $self->skels;
    unless ($name && grep {$_ eq $name} @skels) {
        carp("Incorrect scope name. Allowed: ".join(", ",@skels));
        return 0;
    }
    $rplc = {} unless ref($rplc) eq 'HASH';

    # Directories normalize
    $self->dirs() if $self->can('dirs');

    # Pools normalize
    $self->pool() if $self->can('pool');

    # To next build() in modules
    my $ret = $self->maybe::next::method();
    return 0 unless $ret;

    #
    # Building
    #
    my $_rplc = $self->{rplc};
    for (keys %$_rplc) { $rplc->{$_} = $_rplc->{$_} }

    # Post-processing: directories
    my $subdirs = $self->{subdirs} || {};
    my $vd = $subdirs->{$name};
    foreach my $d (@$vd) {
        my @ds = split(/\//,_ff($d->{path}, $rplc));
        my $path = $root ? File::Spec->catdir($root, @ds) : File::Spec->catdir(@ds);
        my $mode = defined $d->{mode} ? $d->{mode} : DIRMODE;
        if (preparedir($path, $mode)) {
            $self->_debug(_yep("%s", $path));
        } else {
            $self->_debug(_nope("Can't create directory \"%s\" [%o]", $path, $mode));
        }
    }

    # Post-processing: files
    my $pools = $self->{pools} || {};
    my $vp = $pools->{$name};
    foreach my $p (@$vp) {
        next if $p->{type} && !isostype($p->{type}); # Type check
        my $b64 = ($p->{encode} && $p->{encode} eq 'base64') ? 1 : 0;
        my $fname = $p->{name} || 'noname';
        unless ($p->{file}) {
            $self->_debug(_skip("Skip %s file: path not defined!", $fname));
            next;
        }
        my @ds = split(/\//,_ff($p->{file}, $rplc));
        my $file = File::Spec->catfile($root, @ds);
        if (-e $file) {
            $self->_debug(_skip("%s", $file));
            next;
        }
        my $mode = $p->{mode};
        my $st = 0;
        if ($b64) { $st = bsave($file, decode_base64( $p->{data} )) }
        else      { $st = bsave($file, CTK::Util::lf_normalize(_ff($p->{data}, $rplc)), 1) }
        if ($st && -e $file) {
            chmod($mode, $file) if defined($mode);
            $self->_debug(_yep("%s", $file));
        } else {
            $self->_debug(_nope("Can't create file \"%s\" [%o]", $file, $mode // 0));
            return 0;
        }
    }

    return 1;
}
sub dirs {
    my $self = shift;
    $self->maybe::next::method();
    my $dirs = $self->{subdirs} || {};
    foreach my $kd (keys %$dirs) {
        if (ref($dirs->{$kd}) eq 'HASH') {
            $dirs->{$kd} = [$dirs->{$kd}];
        } elsif (ref($dirs->{$kd}) eq 'ARRAY') {
            # OK;
        } else {
            carp "Directory incorrect. Array or hash expected!" if $dirs->{$kd};
        }
    }
    return 1;
}
sub pool {
    my $self = shift;
    $self->maybe::next::method();
    my $boundary = $self->{boundary};
    my $pools = $self->{pools} || {};
    foreach my $kd (keys %$pools) {
        my $buff = $pools->{$kd};
        my @pool;
        $buff =~ s/$boundary/_bcut($1,\@pool)/ge;
        foreach my $r (@pool) {
            my $name = ($r =~ /^\s*name\s*\:\s*(.+?)\s*$/mi) ? $1 : '';
            my $file = ($r =~ /^\s*file\s*\:\s*(.+?)\s*$/mi) ? $1 : '';
            my $mode = ($r =~ /^\s*mode\s*\:\s*(.+?)\s*$/mi) ? $1 : '';
            my $type = ($r =~ /^\s*type\s*\:\s*(.+?)\s*$/mi) ? $1 : '';
            my $enc = ($r =~ /^\s*encode\s*\:\s*(.+?)\s*$/mi) ? $1 : '';
            my $data = ($r =~ /\s*\r?\n\s*\r?\n(.+)/s) ? $1 : '';

            $mode = undef unless $mode =~ /^[0-9]{1,3}$/;
            $r = {
                    name => $name,
                    file => $file,
                    data => lf_normalize($data), # CRLF correct
                    mode => defined($mode) ? oct($mode) : undef,
                    type => $type,
                    encode => $enc,
                };
        }
        $pools->{$kd} = [@pool];
    }
    return 1;
}

# Methods
sub _load {
    my $self = shift;
    my $module = shift;