view release on metacpan or  search on metacpan

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

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}
        }

        push @callstack, \@caller;
    }
    continue { $i++ }

    @callstack;
}

method alldef : common (@items) {
    all { $_ } @items;
}

sub dmsg (@msgs) {
    my $self =    # Maybe there's a reason to make an anon class here?
      blessed $msgs[0] && $msgs[0]->DOES('BS::Common') ? shift @msgs : undef;

    if ( state $debug = $DEBUG // $ENV{DEBUG} // undef ) {

        my @caller = caller 0;

        my $out = "*** " . localtime->datetime . " - DEBUG MESSAGE ***\n\n";

        {
            local $Data::Dumper::Pad    = "  ";
            local $Data::Dumper::Indent = 1;

            $out .=
                scalar @msgs > 1 ? Dumper(@msgs)
              : ref $msgs[0]     ? Dumper(@msgs)
              :   eval { my $s = $msgs[0] // 'undef'; "  $s\n" };

            $out .= "\n"
        }

        $out .=
          $ENV{DEBUG} && $ENV{DEBUG} == 2
          ? join "\n",
          map { ( my $line = $_ ) =~ s/^\t/  /; "  $line" } split /\R/,
          Devel::StackTrace::WithLexicals->new(
            indent      => 1,
            skip_frames => 1
          )->as_string
          : "at $caller[1]:$caller[2]";

        say STDERR "$out\n";
        $out;
    }
}

method bsx : common ($cmd_aref, %args) {
    %args = ( in => undef, out => [], err => '' ) unless scalar keys %args;

    dmsg { cmd => $cmd_aref, args => \%args };

    run3( $cmd_aref,
        map { ref $_ ? $_ : defined $_ ? \$_ : undef } @args{qw(in out err)} );

    my $res = BsxResult->new(
        cmd    => $cmd_aref,
        status => $?,
        %args{qw(in out err dest)}
    );

    #my %ret = map { $_ => $res->$_ } $args{fields}->@*;
    #   scalar %ret ? \%ret : $res;
    $res;
}

method open_as_href : common ($in, %args) {
    my ( $as_aref, $as_path );

    # Is it 'out' or 'dest'?
    #my $as_href = delete $args{dest} // {};
    my $as_href = first { delete $args{$_} } qw(dest out);

    $as_aref = $class->tie_file( $in, dest => $as_href, %args );

    foreach my $line (@$as_aref) {
        $line =~ s/$TRIM_RE/$1/;

        my ( $key, $val ) =
          $args{parse_line}->( $line, dest => $as_href, %args );

        next unless $key && $val;

        if ( $$as_href{$key} ) {
            if (   $args{no_dupes}
                && $args{dest}->{$key}
                && $$as_href{$key} eq $args{dest}->{$key} )
            {
                next;
            }

            $$as_href{$key} = [ $$as_href{$key} ]
              if ref $$as_href{$key} ne 'ARRAY';
            push $$as_href{$key}->@*, $val;
        }
        else {
            $$as_href{$key} = $val;
        }
    }

    dmsg $as_href;
    $as_href;
}