view release on metacpan or  search on metacpan

lib/BS/Common.pm  view on Meta::CPAN

use Object::Pad qw(:experimental(:all));

package BS::Common;
role BS::Common : does(BS::Path);

use utf8;
use v5.40;

use Carp;
use IPC::Run3;
use Tie::File;
use Const::Fast;
use Time::Piece;
use Data::Dumper;
use List::AllUtils qw(any all first);
use Syntax::Keyword::Try;
use Const::Fast::Exporter;
use Syntax::Keyword::Dynamically;

use subs qw(dmsg bsx callstack __pkgfn__ const);

our @EXPORT = qw(dmsg bsx callstack __pkgfn__ const);

const our $DEBUG   => ( any { $_ } @ENV{qw(BS_DEBUG DEBUG)} ) || 0;
const our $TRIM_RE => qr/\s*(.+)\s*\n*/i;

eval {
    use Devel::StackTrace::WithLexicals;
    use PadWalker qw(peek_my peek_our);
    use Module::Metadata;
} if $DEBUG;

my class BsxResult {
    use utf8;
    use v5.40;

    use subs qw(dmsg);

    field $debug = $BS::Common::DEBUG;

    field @out;
    field @err;

    field $cmd : param : reader;
    field $inh : param(in) : reader = \undef;
    field $outh : param(out) : mutator(out) //= \@out;
    field $errh : param(err) : reader //= \@err;
    field $dest : param : reader   = \@out;
    field $status : param : reader = 0;

    ADJUST {
        BS::Common::dmsg { self => $self }
    }
};

field $debug : mutator : param : inheritable = $DEBUG;

APPLY($mop) {
    use utf8;
    use v5.40;

    use Object::Pad ':experimental(:all)';
    use Const::Fast::Exporter;
    use parent 'Exporter';

    use subs qw(dmsg bsx callstack __pkgfn__ const);
    our @EXPORT = qw(dmsg bsx callstack __pkgfn__ const);
}

ADJUST {
    use utf8;
    use v5.40;
    $ENV{DEBUG} = $debug = $BS::Common::DEBUG
};

method __pkgfn__ : common ($pkgname = undef) {
    $pkgname //= $class;
    "$pkgname.pm" =~ s/::/\//rg;
}

method callstack : common {
    my @callstack;
    my $i = 0;

    while ( my @caller = caller $i ) {
        {
            no strict 'refs';
            push @caller, \%{"$caller[0]\::"};
            push @caller, $caller[0]->META() if ${"$caller[0]\::"}{META}