Acme-Tools

 view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

    #not needed but often faster
    if(!defined $Pushsort_cmpsub){ #faster rank() in most cases
      push    @$ar, $v and next if $v>=$$ar[-1];
      unshift @$ar, $v and next if $v< $$ar[0];
    }

    splice @$ar, binsearch($v,$ar,1,$Pushsort_cmpsub)+1, 0, $v;
  }
  0+@$ar
}
sub pushsortstr(\@@){ local $Pushsort_cmpsub=sub{$_[0]cmp$_[1]}; pushsort(@_) } #speedup: copy sub pushsort

=head2 binsearch

Returns the position of an element in a numerically sorted array. Returns undef if the element is not found.

B<Input:> Two, three or four arguments

B<First argument:> the element to find. Usually a number.

B<Second argument:> a reference to the array to search in. The array

Tools.pm  view on Meta::CPAN

Beware of using C<sort> like the following because sort will see C<uniq>
as the subroutine for comparing elements! Which you most likely didnt mean.
This has nothing to do with the way uniq is implemented. It's Perl's C<sort>.

 print sort uniq('a','dup','z','dup');  # will return this four element array: a dup z dup
 print sort(uniq('a','dup','z','dup')); # better, probably what you meant
 print distinct('a','dup','z','dup'));  # same, distinct includes alphanumeric sort

=cut

sub uniq(@) { my %seen; grep !$seen{$_}++, @_ }

=head1 HASHES

=head2 subhash

Copies a subset of keys/values from one hash to another.

B<Input:> First argument is a reference to a hash. The rest of the arguments are a list of the keys of which key/value-pair you want to be copied.

B<Output:> The hash consisting of the keys and values you specified.

Tools.pm  view on Meta::CPAN

 my @arr = globr "X{a,b,c,d}Z";         # same as above
 my @arr = globr "X{a..d}Z";            # same as above
 my @arr = globr "X{a..f..2}";          # step 2, returns array: Xa Xc Xe
 my @arr = globr "{aa..bz..13}Z";       # aaZ anZ baZ bnZ
 my @arr = globr "{1..12}b";            # 1b 2b 3b 4b 5b 6b 7b 8b 9b 10b 11b 12b
 my @arr = globr "{01..11}b";           # 01b 02b 03b 04b 05b 06b 07b 08b 09b 10b 11b (keep leading zero)
 my @arr = globr "{01..12..3}b";        # 01b 04b 07b 10b

=cut

sub globr($) {
  my $p=shift;
  $p=~s{
    \{(-?\w+)\.\.(-?\w+)(\.\.(-?\d+))?\}
  }{
    my $i=0;
    my @r=$1 le $2 ? ($1..$2) : reverse($2..$1);
    @r=grep !($i++%$4),@r if $4;
    "{" . join(",",@r) . "}"
  }xeg;
  glob $p;

Tools.pm  view on Meta::CPAN

=head2 sys

Call instead of C<system> if you want C<die> (Carp::croak) when something fails.

 sub sys($){ my$s=shift; my$r=system($s); $r==0 or croak"ERROR: system($s)==$r ($!) ($?)" }


=cut

sub sys($){ my$s=shift; my$r=system($s); $r==0 or croak"ERROR: system($s)==$r ($!) ($?)" }

=head2 recursed

Returns true or false (actually 1 or 0) depending on whether the
current sub has been called by itself or not.

 sub xyz
 {
    xyz() if not recursed;

t/common.pl  view on Meta::CPAN

use strict;
use warnings;
#use Test::More;
use Acme::Tools 0.24;
#todo: faster make test, group some *.t together, 6s is too long
sub deb($) { print STDERR @_ if $ENV{ATDEBUG} }
sub tmp    { require File::Temp;File::Temp::tempdir(CLEANUP=>$ENV{ATDEBUG}?0:1,@_) }
sub ok_ca  { ok( abs( 1 - $_[0]/$_[1] ) < 1e-4, $_[2]) }
sub ok_str { my($s1,$s2)=@_; if($s1 eq $s2){ ok(1) }else{ ok(0,"s1: $s1   not eq   s2: $s2") } }
sub ok_ref {
  my($s1,$s2) = map serialize($_),@_[0,1];
  my $ok = ok($s1 eq $s2, $_[2]) or deb "s1=$s1\ns2=$s2\n";
  $ok
}
sub gz {
  return gzip(shift()) if $] >= 5.010;