view release on metacpan or  search on metacpan

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

        CHCK     => [qw/
                is_num is_flt is_int is_int8 is_int16 is_int32 is_int64 is_intx
                is_void isnt_void is_not_void
            /],
        CHECK    => [qw/
                is_num is_flt is_int is_int8 is_int16 is_int32 is_int64 is_intx
                is_void isnt_void is_not_void
            /],
    );

sub uv2zero($) {
    my $v = shift;
    return 0 unless defined $v;
    return $v;
}
sub uv2null($) {
    my $v = shift;
    return '' unless defined $v;
    return $v;
}
sub uv2empty($) { goto &uv2null }
sub uv2void($) { goto &uv2null }
sub fv2undef($) {
    my $v = shift;
    return undef unless $v;
    return $v;
}
sub fv2zero($) {
    my $v = shift;
    return 0 unless $v;
    return $v;
}
sub fv2null($) {
    my $v = shift;
    return '' unless $v;
    return $v;
}
sub fv2empty($) { goto &fv2null }
sub fv2void($) { goto &fv2null }
sub tv2num($) {
    my $tv = shift;
    return is_num($tv) ? $tv : 0;
}
sub tv2number($) { goto &tv2num }
sub is_num($) {
    my $v = shift;
    return 0 unless defined $v;
    return 1 if $v =~ /^[+\-]?[0-9]{1,20}$/; # 64 bit
    return 0;
}
sub tv2flt($) {
    my $tv = shift;
    return is_flt($tv) ? $tv : 0;
}
sub tv2float($) { goto &tv2flt }
sub is_flt($) {
    my $v = shift;
    return 0 unless defined $v;
    return 1 if $v =~ /^[+\-]?[0-9]{1,20}\.?[0-9]*$/; # 64 bit min
    return 0;
}
sub tv2int($) {
    my $tv = shift;
    return is_int($tv) ? $tv : 0;
}
sub is_int($) {
    my $v = shift;
    return 0 unless defined $v;
    return 1 if $v =~ /^[0-9]{1,20}$/; # 64 bit max
    return 0;
}
sub tv2int8($) {
    my $tv = shift;
    return is_int8($tv) ? $tv : 0;
}
sub is_int8($) {
    my $v = shift;
    return 0 unless defined $v;
    return 1 if ($v =~ /^[0-9]{1,3}$/) && ($v >= 0) && ($v < 2**8);
    return 0;
}
sub tv2int16($) {
    my $tv = shift;
    return is_int16($tv) ? $tv : 0;
}
sub is_int16($) {
    my $v = shift;
    return 0 unless defined $v;
    return 1 if ($v =~ /^[0-9]{1,5}$/) && ($v >= 0) && ($v < 2**16);
    return 0;
}
sub tv2int32($) {
    my $tv = shift;
    return is_int32($tv) ? $tv : 0;
}
sub is_int32($) {
    my $v = shift;
    return 0 unless defined $v;
    return 1 if ($v =~ /^[0-9]{1,10}$/) && ($v >= 0) && ($v < 2**32);
    return 0;
}
sub tv2int64($) {
    my $tv = shift;
    return is_int64($tv) ? $tv : 0;
}
sub is_int64($) {
    my $v = shift;
    return 0 unless defined $v;
    return 1 if ($v =~ /^[0-9]{1,20}$/) && ($v >= 0) && ($v < 2**64);
    return 0;
}

sub tv2intx($$) {
    my $tv = shift;
    my $x = shift || 0;
    return is_intx($tv, $x) ? $tv : 0;
}
sub is_intx($$) {
    my $v = shift;
    my $x = shift || 0;
    return 0 unless $x && is_int8($x) && ($x >=0) && ($x <= 64);
    return 0 unless defined $v;
    return 1 if ($v =~ /^[0-9]{1,20}$/) && ($v >= 0) && ($v < 2**$x);
    return 0;
}

sub is_void {
    my $struct = shift;

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

use base qw/ Exporter /;
@EXPORT_OK = qw/ xstest shred wipe /;

use XSLoader;
XSLoader::load("CTK", $VERSION);

use Carp;
use File::Spec::Functions qw/ splitpath catpath /;
use File::Copy qw/ move /;

sub wipe($) {
    my $fn = shift // '';
    my $sz = (length($fn) && -e $fn) ? (-s $fn) : 0;
    return 0 unless $sz;
    return 0 unless wipef($fn, $sz);
    return 1;
}
sub shred($) {
    my $fn = shift // '';
    my $sz = (length($fn) && -e $fn) ? (-s $fn) : 0;
    return 0 unless $sz;
    return 0 unless wipef($fn, $sz);

    my ($vol,$dir,$file) = splitpath( $fn );

    my $nn = '';
    for (my $i = 0; $i < 5; $i++) {
        $nn = catpath($vol, $dir, sprintf("%s.%s", _sr(8), _sr(3)));