view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

  cpad
  dserialize
  serialize
  srlz
  cnttbl
  nicenum
  bytes_readable
  sec_readable
  distance
  tms
  s2t
  easter
  time_fp
  timems
  sleep_fp
  sleeps
  sleepms
  sleepus
  sleepns
  eta
  sys
  recursed
  md5sum
  pwgen
  which
  read_conf
  openstr
  printed
  ldist
  $Re_isnum
  isnum
  part
  parth
  parta
  a2h
  h2a
  refa
  refh
  refs
  refaa
  refah
  refha
  refhh
  pushr
  popr
  shiftr
  unshiftr
  splicer
  keysr
  valuesr
  eachr
  joinr
  pile
  aoh2sql
  aoh2xls
  base64
  unbase64
  opts
  ed
  changed
  $Edcursor
  brainfu
  brainfu2perl
  brainfu2perl_optimized
  bfinit
  bfsum
  bfaddbf
  bfadd
  bfcheck
  bfgrep
  bfgrepnot
  bfdelete
  bfstore
  bfretrieve
  bfclone
  bfdimensions
  $PI
  install_acme_command_tools

  $Dbh
  dlogin
  dlogout
  drow
  drows
  drowc
  drowsc
  dcols
  dpk
  dsel
  ddo
  dins
  dupd
  ddel
  dcommit
  drollback
);

our $PI = '3.141592653589793238462643383279502884197169399375105820974944592307816406286';

=head1 NAME

Acme::Tools - Lots of more or less useful subs lumped together and exported into your namespace

=head1 SYNOPSIS

 use Acme::Tools;

 print sum(1,2,3);                   # 6
 print avg(2,3,4,6);                 # 3.75
 print median(2,3,4,6);              # 3.5
 print percentile(25, 101..199);     # 125

 my @list = minus(\@listA, \@listB); # set operation
 my @list = union(\@listA, \@listB); # set operation

 print length(gzip("abc" x 1000));   # far less than 3000

 writefile("/dir/filename",$string); # convenient
 my $s=readfile("/dir/filename");    # also convenient

 print "yes!" if between($PI,3,4);

Tools.pm  view on Meta::CPAN

=cut

sub ref_deep {
  my $s=shift; #
}



=head2 nicenum

 print 14.3 - 14.0;              # 0.300000000000001
 print 34.3 - 34.0;              # 0.299999999999997
 print nicenum( 14.3 - 14.0 );   # 0.3
 print nicenum( 34.3 - 34.0 );   # 0.3

=cut

our $Nicenum;
sub nicenum { #hm
  $Nicenum=$_[0];
  $Nicenum=~s/([\.,]\d*)((\d)\3\3\3\3\3)\d$/$1$2$3$3$3$3$3$3$3$3$3/;
  my $r=0+$Nicenum;
  #warn "nn $_[0] --> $Nicenum --> $r\n";
  $r;
}


=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;

 }

=cut

sub recursed {(caller(1))[3] eq (caller(2))[3]?1:0}



=head2 ed

String editor commands

 literals:               a-z 0-9 space
 move cursor:            FBAEPN MF MB ME
 delete:                 D Md
 up/low/camelcase word   U L C
 backspace:              -
 search:                 S
 return/enter:           R
 meta/esc/alt:           M
 shift:                  T
 cut to eol:             K
 caps lock:              C
 yank:                   Y
 start and end:          < >
 macro start/end/play:   { } !
 times for next cmd:     M<number>  (i.e. M24a inserts 24 a's)

(TODO: alfa...and more docs needed)

=cut

our $Edcursor;
sub ed {
  my($s,$cs,$p,$buf)=@_; #string, commands, point (or cursor)
  return $$s=ed($$s,$cs,$p,$buf) if ref($s);
  my($sh,$cl,$m,$t,@m)=(0,0,0,undef);
  while(length($cs)){
    my $n = 0;
    my $c = $cs=~s,^(M\d+|M.|""|".+?"|S.+?R|\\.|.),,s ? $1 : die;
    $p = curb($p||0,0,length($s));
    if(defined$t){$cs="".($c x $t).$cs;$t=undef;next}
    my $add=sub{substr($s,$p,0)=$_[0];$p+=length($_[0])};
    if   ($c =~ /^([a-z0-9 ])/){ &$add($sh^$cl?uc($1):$1); $sh=0 }
    elsif($c =~ /^"(.+)"$/)    { &$add($1) }
    elsif($c =~ /^\\(.)/)      { &$add($1) }
    elsif($c =~ /^S(.+)R/)     { my $i=index($s,$1,$p);$p=$i+length($1) if $i>=0 }
    elsif($c =~ /^M(\d+)/)     { $t=$1; next }
    elsif($c eq 'F') { $p++ }
    elsif($c eq 'B') { $p-- }
    elsif($c eq 'A') { $p-- while $p>0 and substr($s,$p-1,2)!~/^\n/ }
    elsif($c eq 'E') { substr($s,$p)=~/(.*)/ and $p+=length($1) }
    elsif($c eq 'D') { substr($s,$p,1)='' }
    elsif($c eq 'MD'){ substr($s,$p)=~s/^(\W*\w+)// and $buf=$1 }
    elsif($c eq 'MF'){ substr($s,$p)=~/(\W*\w+)/ and $p+=length($1) }
    elsif($c eq 'MB'){ substr($s,0,$p)=~/(\w+\W*)$/ and $p-=length($1) }
    elsif($c eq '-') { substr($s,--$p,1)='' if $p }
    elsif($c eq 'M-'){ substr($s,0,$p)=~s/(\w+\W*)$// and $p-=length($buf=$1)}
    elsif($c eq 'K') { substr($s,$p)=~s/(\S.+|\s*?\n)// and $buf=$1 }
    elsif($c eq 'Y') { &$add($buf) }
    elsif($c eq 'U') { substr($s,$p)=~s/(\W*)(\w+)/$1\U$2\E/; $p+=length($1.$2) }
    elsif($c eq 'L') { substr($s,$p)=~s/(\W*)(\w+)/$1\L$2\E/; $p+=length($1.$2) }
    elsif($c eq 'C') { substr($s,$p)=~s/(\W*)(\w+)/$1\u\L$2\E/; $p+=length($1.$2) }
    elsif($c eq '<') { $p=0 }
    elsif($c eq '>') { $p=length($s) }
    elsif($c eq 'T') { $sh=1 }
    elsif($c eq 'C') { $cl^=1 }
    elsif($c eq '{') { $m=1; @m=() }
    elsif($c eq '}') { $m=0 }
    elsif($c eq '!') { $m||!@m and die"ed: no macro"; $cs=join("",@m).$cs }
    elsif($c eq '""'){ &$add('"') }
    else             { croak "ed: Unknown cmd '$c'\n" }
    push @m, $c if $m and $c ne '{';
    #warn serialize([$c,$m,$cs],'d');
  }
  $Edcursor=$p;
  $s;
}

=head2 changed

 while(<>){
    my $line=$_;
    print "\n" if changed(/^\d\d\d\d-\d\d-(\d\d)/);
    print "\n" if changed(substr($_,8,2));
 }

Returns undef, 0 or 1. Undef if its the first time C<changed> is
called on that perl line. 0 if not the first time and the parameters
differ from the last call on that line. 1 if not the first time and
the parameters is the exact same as they where on the previous call on
that line of perl source code.

=cut

our %Changed_lastval;
sub changed {
    my $now=join($;,@_);
    my $key=join($;,caller());
    my $e=exists $Changed_lastval{$key};
    if($e){
	my $last=$Changed_lastval{$key};
	return 0 if  defined $last and  defined $now and $last eq $now
                 or !defined $last and !defined $now;
    }
    $Changed_lastval{$key}=$now;
    return $e?1:undef;
}

#todo: sub unbless eller sub damn
#todo: ..se også: use Data::Structure::Util qw/unbless/;
#todo: ...og: Acme::Damn sin damn()
#todo? sub swap($$) http://www.idg.no/computerworld/article242008.ece
#todo? catal
#todo?
#void quicksort(int t, int u) int i, m; if (t >= u) return; swap(t, randint(t, u)); m = t; for (i = t + 1; i <= u; i++) if (x[i] < x[t]) swap(++m, i); swap(t, m) quicksort(t, m-1); quicksort(m+1, u);


=head1 JUST FOR FUN

=head2 brainfu

B<Input:> one or two arguments

First argument: a string, source code of the brainfu
language. String containing the eight charachters + - < > [ ] . ,
Every other char is ignored silently.

Second argument: if the source code contains commas (,) the second
argument is the input characters in a string.

B<Output:> The resulting output from the program.

Example:

 print brainfu(<<"");  #prints "Hallo Verden!\n"