view release on metacpan or  search on metacpan

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

Returns time in format dd.mm.yyyy hh.mm.ss

Tags: BASE, DATE

=head3 lockdir

    my $value = lockdir();

For example value can be set as: /var/lock

Lock files should be stored within the /var/lock directory structure.
Lock files for devices and other resources shared by multiple applications, such as the serial device lock files that
were originally found in either /usr/spool/locks or /usr/spool/uucp, must now be stored in /var/lock.
The naming convention which must be used is "LCK.." followed by the base name of the device. For example, to
lock /dev/ttyS0 the file "LCK..ttyS0" would be created. 5

The format used for the contents of such lock files must be the HDB UUCP lock file format. The HDB format is
to store the process identifier (PID) as a ten byte ASCII decimal number, with a trailing newline. For example, if
process 1230 holds a lock file, it would contain the eleven characters: space, space, space, space, space, space,
one, two, three, zero, and newline.

See L<Sys::Path/"lockdir">

Tags: CORE, BASE, FILE

=head3 ls

    @list = ls( $dir);
    @list = ls( $dir, $mask );

A function returns list content of directory $dir by $mask (regexp or scalar string)

Tags: BASE, FILE, ATOM

=head3 prefixdir

    my $value = prefixdir();

For example value can be set as: /usr

/usr - $Config::Config{'prefix'}

Is a helper function and should not be used directly.

/usr is the second major section of the filesystem. /usr is shareable, read-only data. That means that /usr
should be shareable between various FHS-compliant hosts and must not be written to. Any information that is
host-specific or varies with time is stored elsewhere.

Large software packages must not use a direct subdirectory under the /usr hierarchy.

See L<Sys::Path/"prefix">

Tags: CORE, BASE, FILE

=head3 preparedir

    $status = preparedir( $dir );
    $status = preparedir( \@dirs );
    $status = preparedir( \%dirs );
    $status = preparedir( $dir, $chmode );

Preparing directory: creation and permission modification.
The function returns true or false.

The $chmode argument should be a octal value, for example:

    $status = preparedir( [qw/ foo bar baz /], 0777 );

Tags: BASE, FILE, ATOM

=head3 randchars

    $rand = randchars( $n ); # default chars collection: 0..9,'a'..'z','A'..'Z'
    $rand = randchars( $n, \@collection ); # Defined chars collection

Returns random sequence of casual characters by the amount of n

For example:

    $rand = randchars( 8, [qw/a b c d e f/]); # -> cdeccfdf

Tags: BASE, UTIL

=head3 randomize

    $rand = randomize( $n );

Returns random number of the set amount of characters

Tags: BASE, UTIL

=head3 read_attributes

Smart rearrangement of parameters to allow named parameter calling.
We do the rearrangement if the first parameter begins with a "-", but
since 2.82 it is optional condition

    my @args = @_;
    my ($content, $maxcnt, $timeout, $timedie, $base, $login, $password, $host, $table_tmp);
    ($content, $maxcnt, $timeout, $timedie, $base, $login, $password, $host, $table_tmp) =
    read_attributes([
        ['DATA','CONTENT','USERDATA'],
        ['COUNT','MAXCOUNT','MAXCNT'],
        ['TIMEOUT','FORBIDDEN','INTERVAL'],
        ['TIMEDIE','TIME'],
        ['BD','DB','BASE','DATABASE'],
        ['LOGIN','USER'],
        ['PASSWORD','PASS'],
        ['HOST','HOSTNAME','ADDRESS','ADDR'],
        ['TABLE','TABLENAME','NAME','SESSION','SESSIONNAME']
    ],@args) if defined $args[0];

See L<CGI::Util>

Tags: API, BASE

=head3 rundir

    my $value = rundir();

For example value can be set as: /var/run

This directory contains system information data describing the system since it was booted. Files under this
directory must be cleared (removed or truncated as appropriate) at the beginning of the boot process. Programs
may have a subdirectory of /var/run; this is encouraged for programs that use more than one run-time file. 7

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

    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);
    closedir($dh);
    if ($mask && ref($mask) eq 'Regexp') {
        return grep {$_ =~ $mask} @fds;
    } else {
        return grep {/$mask/} @fds if length($mask);
    }
    return @fds;
}
sub getfilelist {
    return [map {$_->[1]} scanfiles(@_)];
}
sub getlist { goto &getfilelist }
sub getdirlist {
    return [map {$_->[1]} scandirs(@_)];
}

#
# Extended
#