view release on metacpan or  search on metacpan

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

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
        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

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
use base qw/ https://metacpan.org/pod/Exporter">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)));