view release on metacpan or  search on metacpan

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

package MHFS::Util v0.7.0;
use 5.014;
use strict; use warnings;
use feature 'say';
use Carp qw(croak);
use Exporter 'import';
use Feature::Compat::Try;
use File::Find;
use File::Basename;
use POSIX ();
use Cwd qw(abs_path getcwd);
use Encode qw(decode encode);
use URI::Escape qw(uri_escape uri_escape_utf8);
use MIME::Base64 qw(encode_base64url decode_base64url);
use PerlIO::encoding;
use warnings::register;
our @EXPORT_OK = ('LOCK_GET_LOCKDATA', 'LOCK_WRITE', 'UNLOCK_WRITE', 'write_file', 'write_text_file', 'write_text_file_lossy', 'read_file', 'read_text_file', 'read_text_file_lossy', 'shellcmd_unlock', 'ASYNC', 'FindFile', 'space2us', 'escape_html', '...

BEGIN {
    if (eval "use feature 'fc'; 1;") {
        *fold_case = \&CORE::fc;
    } else {
        *fold_case = \&lc;
    }
}

# single threaded locks
sub LOCK_GET_LOCKDATA {
    my ($filename) = @_;
    my $lockname = "$filename.lock";
    try { read_text_file($lockname) }
    catch ($e) { return; }
}

#sub LOCK_GET_FILESIZE {
#    my ($filename) = @_;
#    my $lockedfilesize = LOCK_GET_LOCKDATA($filename);
#    if(defined $lockedfilesize) {
#
#    }
#}

sub LOCK_WRITE {
    my ($filename, $lockdata) = @_;
    my $lockname = "$filename.lock";
    if(-e $lockname) {
        return 0;
    }
    $lockdata //= "99999999999"; #99 Billion
    write_text_file($lockname, $lockdata);
    return 1;
}

sub UNLOCK_WRITE {
    my ($filename) = @_;
    my $lockname = "$filename.lock";
    unlink($lockname);
}

sub write_file {
    my ($filename, $data) = @_;
    if (utf8::is_utf8($data)) {
        warnings::warnif "UTF8 string in write_file";
        Encode::_utf8_off($data);
    }
    open (my $fh, '>', $filename) or croak "$! $filename";
    print $fh $data;
    close($fh);
}

sub write_text_file {
    my ($filename, $text) = @_;
    local $PerlIO::encoding::fallback = Encode::FB_CROAK;
    open (my $fh, '>:encoding(UTF-8)', $filename) or croak "$! $filename";
    print $fh $text;
    close($fh);
}

sub write_text_file_lossy {
    my ($filename, $text) = @_;
    local $PerlIO::encoding::fallback = Encode::ONLY_PRAGMA_WARNINGS | Encode::WARN_ON_ERR;
    open (my $fh, '>:encoding(UTF-8)', $filename) or croak "$! $filename";
    print $fh $text;
    close($fh);
}

sub read_file {