view release on metacpan or  search on metacpan

lib/Devel/Kit.pm  view on Meta::CPAN

package Devel::Kit;

use strict;
use warnings;

use Module::Want 0.6         ();
use String::UnicodeUTF8 0.23 ();

$Devel::Kit::VERSION = '0.82';
$Devel::Kit::fh      = \*STDOUT;

my $pid;

sub import {
    my $caller = caller();

    my $pre = '';
    for (@_) {
        if ( $_ =~ m/(_+)/ ) {
            $pre = $1;
            last;
        }
    }

    no strict 'refs';    ## no critic
    for my $l (qw(a d ei rx ri ni ci si yd jd xd sd md id pd fd dd ld ud gd bd vd ms ss s2 s3 s5 be bu ce cu xe xu ue uu he hu pe pu se su qe qu)) {
        *{ $caller . '::' . $pre . $l } = \&{$l};
    }

    unless ( grep( m/no/, @_ ) ) {
        require Import::Into;    # die here since we don't need it otherwise, so we know right off there's a problem, and so caller does not have to check status unless they want to
        strict->import::into($caller);
        warnings->import::into($caller);
    }
}

my $ak;

sub a {
    if ( !$ak ) {
        require App::Kit;
        $ak = App::Kit->instance;
    }
    return $ak;
}

# output something w/ one trailing newline gauranteed
sub o {
    my ($str) = @_;
    $str =~ s{[\n\r]+$}{};
    print {$Devel::Kit::fh} "$str\n";
}

# dump a perl ref()
sub p {
    my $ref = ref( $_[0] );

    if ( !$ref ) {
        if ( !@_ ) {
            return "no args passed to p()";
        }
        elsif ( !defined $_[0] ) {
            return "undef() passed to p()";
        }
        elsif ( $_[0] eq '' ) {
            return "empty string passed to p()";
        }
        else {
            return "non-ref passed to p(): $_[0]";
        }
    }

    if ( $ref eq 'Regexp' ) {
        return "\tRegexp: /$_[0]/";
    }
    elsif ( Module::Want::have_mod('Data::Dumper') ) {

        # blatantly stolen from Test::Builder::explain() then wantonly added Pad()
        my $dumper = Data::Dumper->new( [ $_[0] ] );
        $dumper->Indent(1)->Terse(1)->Pad("\t");
        $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
        return $dumper->Dump;
    }
    else {
        return "Error: “Data::Dumper” could not be loaded:\n\t$@\n";
    }
}

sub d {
    my @caller = caller();

    if ( !@_ ) {