package LIMS::Local::Debug; =begin ========================================================================= uses Data::Printer to colourise terminal output. Usage: p @foo, p %h, p $o, etc. conflict with Data::Printer::p avoided by aliasing to 'dpp' rc_file: automatically picked up if exists in ~/.dataprinter, or can use alternate file, eg path($RealBin, '..', 'config', 'settings', 'dataprinter.conf'), but don't use realpath() or will get error calling method on undefined path object if file can't be found - eg *.t scripts have different location of $RealBin =cut =========================================================================== use strict; use warnings; use FileHandle; use Path::Tiny; use LIMS::Local::Config; use Data::Dumper::Concise; use FindBin qw($RealBin); # load Data::Printer, settings in ~/.dataprinter, caller_info useless here: use Data::Printer alias => 'dpp', caller_info => 0; # override ~/.dataprinter cfg use vars qw( $fh1 $fh2 @EXPORT ); use Exporter; @EXPORT = qw( p ); # debug_path sub import { goto &Exporter::import } sub p { _DEBUG(@_) } # alias sub _DEBUG { my (@args) = @_; # don't want t/*.t output unless specifically requested: return if ($ENV{HARNESS_ACTIVE} && ! $ENV{DEBUG_ON}); # TODO: don't want this if called from cgi script (eg rfc.cgi): dpp($_) for @args; # send to stdout with colourised output my $cfg = LIMS::Local::Config->instance; my $path = $cfg->{path_to_app_root}; # warn $path; unless ($fh1) { # debug.txt in overwrite mode: $fh1 = new FileHandle '>' . "$path/logs/debug.txt" or die $!; } unless ($fh2) { # debug.log in append mode: $fh2 = new FileHandle '>>' . "$path/logs/debug.log" or die $!; } my $str = join '', map { ref $_ # use Data::Dumper if it's a ref/object: ? ( Dumper $_ ) : ( $_ . "\n" ); } grep $_, @args; # ignore empty elements print $_ $str for ($fh1, $fh2); # print to both filehandles $fh1->flush; $fh2->flush; # for mod_perl } =begin # using LIMS::Local::Config->instance now # can't use LIMS::Utils version as LT use's this package sub find_home { # warn Dumper \@INC; my $path_to_app; foreach (@INC) { if (-e "$_/script/lims_server.pl") { # warn 'PATH:', $_; $path_to_app = $_ and last; } } return $path_to_app; } =cut 1;