Acme-Tools

 view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

=head2 etahhmm

 ...NOT YET

=cut

our %Eta;
our $Eta_forgetfulness=2;
sub eta {
  my($id,$pos,$end,$time_fp)=( @_==2 ? (join(";",caller()),@_) : @_ );
  $time_fp||=time_fp();
  my $a=$Eta{$id}||=[];
  push @$a, [$pos,$time_fp];
  @$a=@$a[map$_*2,0..@$a/2] if @$a>40;  #hm 40
  splice(@$a,-2,1) if @$a>1 and $$a[-2][0]==$$a[-1][0]; #same pos as last
  return undef if @$a<2;
  my @eta;
  for(2..@$a){
    push @eta, $$a[-1][1] + ($end-$$a[-1][0]) * ($$a[-1][1]-$$a[-$_][1])/($$a[-1][0]-$$a[-$_][0]);
  }

Tools.pm  view on Meta::CPAN

  my $s=@_==1?shift():0;
  my $time=time_fp();
  my $sleep=$s-($time-nvl($Time_last_sleep_until,0));
  $Time_last_sleep_until=time;
  sleep_fp($sleep) if $sleep>0;
}

my %thr;
sub throttle {
  my($times,$mintime,$what)=@_;
  $what||=join(":",@{[caller(1)]}[3,2]);
  $thr{$what}||=[];
  my $thr=$thr{$what};
  push @$thr,time_fp();
  return if @$thr<$times;
  my $since=$$thr[-1]-shift(@$thr);
  my $sleep=$since<$mintime?$mintime-$since:0;
  sleep_fp($sleep);
  return $sleep;
}

Tools.pm  view on Meta::CPAN

=head2 dserialize

Debug-serialize, dumping data structures for you to look at.

Same as C<serialize()> but the output is given a newline every 80th character.
(Every 80th or whatever C<$Acme::Tools::Dserialize_width> contains)

=cut

our $Dserialize_width=80;
sub _kallstack { my $tilbake=shift||0; my @c; my $ret; $ret.=serialize(\@c,"caller$tilbake") while @c=caller(++$tilbake); $ret }
sub dserialize{join "\n",serialize(@_)=~/(.{1,$Dserialize_width})/gs}
sub serialize {
  no warnings;
  my($r,$name,$filename,$level)=@_;
  my @r=(undef,undef,($level||0)-1);
  if($filename){
    open my $fh, '>', $filename or croak("FEIL: could not open file $filename\n" . _kallstack());
    my $ret=serialize($r,$name,undef,$level);
    print $fh "$ret\n1;\n";
    close($fh);

Tools.pm  view on Meta::CPAN

    #warn "Tried to serialize CODE";
    return 'sub{croak "Can not serialize CODE-references, see perhaps B::Deparse and Storable"}'
  }
  elsif(ref($$r) eq 'GLOB'){
    warn "Tried to serialize a GLOB";
    return '\*STDERR'
  }
  else{
    my $tilbake;
    my($pakke,$fil,$line,$sub,$hasargs,$wantarray);
      ($pakke,$fil,$line,$sub,$hasargs,$wantarray)=caller($tilbake++) until $sub ne 'serialize' || $tilbake>20;
    croak("serialize() argument should be reference!\n".
        "\$r=$r\n".
        "ref(\$r)   = ".ref($r)."\n".
        "ref(\$\$r) = ".ref($$r)."\n".
        "kallstack:\n". _kallstack());
  }
}

=head2 srlz

Tools.pm  view on Meta::CPAN

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

Tools.pm  view on Meta::CPAN

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