view release on metacpan or  search on metacpan

lib/Devel/Util.pm  view on Meta::CPAN

			}
		}
	}
}

{
	no warnings 'uninitialized';
	my %last_times;
	sub oiaw (&;$) {
		require Time::HiRes;
		if (defined wantarray) {
			my $code = shift;
			my $delay = shift || 1;
			my $last_time = 0;
			sub {
				return unless Time::HiRes::time() - $last_time >= $delay || $_[0] && $_[0] eq '-force';
				$last_time = Time::HiRes::time();
				$code->(@_)
			}
		} else {
			my (undef, $file, $line) = caller;
			return if Time::HiRes::time() - $last_times{$file.$line} < ($_[1]||1);
			$last_times{$file.$line} = Time::HiRes::time();
			$_[0]->();
			1
		}
	}
}

sub tz (&$) {
	require POSIX;
	my ($block, $tz) = @_;
	my (@ret, $ret);
	{
		local $ENV{TZ} = $tz;
		POSIX::tzset();
		if (wantarray) {
			eval {@ret = $block->()}
		}
		elsif (defined wantarray) {
			eval {$ret = $block->()}
		}
		else {
			eval {$block->()}
		}
	}
	POSIX::tzset();
	die $@ if $@;
	wantarray ? @ret : $ret
}

{
	my $timestr = sub {
		my $d = shift;
		$d = 0 if $d<0;
		sprintf("%dm%.3fs", int($d/60), $d - 60*int($d/60))
	};
	sub dt (&;$) {
		require Time::HiRes;
		my $block = shift;
		my $name = shift || sprintf 'dt at %s line %d', (caller)[1,2];
		my ($t_elapsed_0, $t_elapsed_1, $t_user_0, $t_user_1, $t_sys_0, $t_sys_1);
		my @ret;
		my $ret;

		($t_user_0, $t_sys_0) = times;
		$t_elapsed_0 = Time::HiRes::time();
		if (wantarray) {
			@ret = $block->()
		}
		elsif (defined wantarray) {
			$ret = $block->()
		}
		else {
			$block->()
		}
		$t_elapsed_1 = Time::HiRes::time();
		($t_user_1, $t_sys_1) = times;

		printf STDERR ("\nTiming report for %s:\nreal    %s\nuser    %s\nsys     %s\n\n",
			$name,
			$timestr->($t_elapsed_1 - $t_elapsed_0),
			$timestr->($t_user_1 - $t_user_0),
			$timestr->($t_sys_1 - $t_sys_0),
		) unless $QUIET;
		
		wantarray ? @ret : $ret
	}
}

sub do_time (&;$);
*do_time = \&dt;

sub once_in_a_while (&;$);
*once_in_a_while = \&oiaw;

sub timezone (&$);
*timezone = \&tz;

1