view release on metacpan or  search on metacpan

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

    binmode $IN unless $onutf8;
    return scalar(do { local $/; <$IN> });
}
sub file_save {
    my $fn      = shift // return 0;
    my $content = shift // '';
    my $onutf8 = shift;
    return 0 unless length($fn);
    my $OUT;
    my $flc = 0;
    if (ref $fn eq 'GLOB') {
       $OUT = $fn;
    } else {
        open($OUT, '>', $fn) or do {
            carp("bsave: Can't open file to write \"$fn\": $!");
            return 0;
        };
        flock($OUT, 2) or carp("bsave: Can't lock file \"$fn\": $!");
        $flc = 1;
    }
    if ($onutf8) {
        binmode($OUT, ':raw:utf8');
    } else {
        binmode($OUT);
    }
    print $OUT $content;
    close $OUT if $flc;
    return 1;
}
sub bload { goto &file_load } # двоичное чтение
sub bsave { goto &file_save } # двоичная запись

#
# Files utilities
#
sub touch {
    # See ExtUtils::Command)
    my $fn  = shift // '';
    return 0 unless length($fn);
    my $t = time;
    my $OUT;
    my $ostat = open $OUT, '>>', $fn;
    unless ($ostat) {
        carp("touch: Can't open file to write \"$fn\": $!");
        return 0;
    }
    close $OUT if $ostat;
    utime($t,$t,$fn);
    return 1;
}
sub eqtime {
    # Делаем файл такой же датой создания и модификации
    my $src = shift // '';
    my $dst = shift // '';
    return 0 unless length($src);
    return 0 unless length($dst);
    unless ($src && -e $src) {
        carp("eqtime: Can't open file to read \"$src\": $!");
        return 0;
    }
    unless (utime((stat($src))[8,9],$dst)) {
        carp("eqtime: Can't change access and modification times on file \"$dst\": $!");
        return 0;
    }
    return 1;
}
sub preparedir {
    my $din = shift // return 0;
    my $chmod = shift; # 0777

    my @dirs;
    if (ref($din) eq 'HASH') {
        foreach my $k (values %$din) { push @dirs, $k if length($k // '') };
    } elsif (ref($din) eq 'ARRAY') {
        @dirs = grep { defined($_) && length($_) } @$din;
    } else { push @dirs, $din if length($din) }
    my $stat = 1;
    foreach my $dir (@dirs) {
        mkpath( $dir, {verbose => 0} ) unless -e $dir; # mkdir $dir unless -e $dir;
        chmod($chmod, $dir) if defined($chmod) && -e $dir;
        unless (-d $dir or -l $dir) {
            $stat = 0;
            carp("preparedir: Directory don't prepare \"$dir\"");
        }
    }
    return $stat;
}
sub scandirs {
    my $dir = shift // cwd() // curdir() // '.';
    my $mask = shift // '';

    my @dirs;

    @dirs = grep {!(/^\.+$/) && -d catdir($dir,$_)} ls($dir, $mask);
    @dirs = sort {$a cmp $b} @dirs;

    return map {[catdir($dir,$_), $_]} @dirs;
}
sub scanfiles {
    my $dir = shift // cwd() // curdir() // '.';
    my $mask = shift // '';

    my @files;
    @files = grep { -f catfile($dir,$_)} ls($dir, $mask);
    @files = sort {$a cmp $b} @files;

    return map {[catfile($dir,$_), $_]} @files;
}
sub ls {
    my $dir = shift // curdir() // '.';
    my $mask = shift // '';

    my @fds;

    my $dh = gensym();
    unless (opendir($dh,$dir)) {
        carp("ls: Can't open directory \"$dir\": $!");
        return @fds;
    }

    @fds = readdir($dh);