1# $OpenBSD: Trace.pm,v 1.5 2023/07/06 08:29:26 espie Exp $ 2 3# Copyright (c) 2007-2010 Steven Mestdagh <steven@openbsd.org> 4# Copyright (c) 2012 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 18use v5.36; 19 20package LT::Trace; 21use Exporter 'import'; 22our @EXPORT = qw(tprint tsay); 23 24sub print :prototype(&)($val) 25{ 26 if (defined $ENV{TRACE_LIBTOOL}) { 27 state $trace_file; 28 if (!defined $trace_file) { 29 open $trace_file, '>>', $ENV{TRACE_LIBTOOL}; 30 } 31 if (defined $trace_file) { 32 print $trace_file (&$val()); 33 } 34 } 35} 36 37my $trace_level = 0; 38 39sub set($, $t) 40{ 41 $trace_level = $t; 42} 43 44sub tprint :prototype(&;$)($args, $level = 1) 45{ 46 if ($trace_level >= $level) { 47 print (&$args()); 48 } 49} 50 51sub tsay :prototype(&;$)($args, $level = 1) 52{ 53 if ($trace_level >= $level) { 54 say (&$args()); 55 } 56} 57 581; 59