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