File Coverage

blib/lib/Archlinux/Term.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	4	4	100.0
condition			n/a
subroutine	12	12	100.0
pod	5	5	100.0
total	65	65	100.0

package Archlinux::Term;

use warnings;
use strict;

use Term::ANSIColor qw(color);
use Text::Wrap      qw(wrap);
use Exporter;

our @ISA         = qw(Exporter);
our @EXPORT_OK   = qw(msg status substatus warning error);
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
our $VERSION     = '0.03';

our ($Columns, $Mono) = (78, undef);

sub _word_wrap
{
    my ($prefix, $msg) = @_;

    if ( eval { $Columns > 0 } ) {
        my $spaces = q{ } x length $prefix;

        local $Text::Wrap::columns = $Columns + 1;
        return wrap( $prefix, $spaces, $msg );
    }

    return $prefix . $msg;
}

sub _color_wrap
{
    my ($color, $prefix, @messages) = @_;

    # Wrap the uncolored first because ANSI color chars mess up wrap()
    # (it doesn't know the ANSI color codes are invisible)
    my $msg          = join q{}, @messages;
    $msg             =~ s/\s*\n\s*/ /g;

    my $result       = _word_wrap( $prefix, $msg );
    my $prefix_match = quotemeta $prefix;

    return $result if ( $Mono );

    # Now colorize the prefix and stuff...
    $result =~ s{ \A $prefix_match } # Use \033[0;1m cuz Term::ANSIColor
                { color( 'BOLD', $color ) . $prefix . "\e[0;1m" }exms;
    $result .= color( 'RESET' );     # ... doesnt have very bright white!

    return $result;
}

sub msg
{
    my @messages = @_;
    chomp $messages[-1];

    my $prefix = q{ } x 4;

    print _word_wrap( $prefix, join q{}, @messages ), "\n";
}

sub status
{
    print _color_wrap( 'GREEN' => q{==> }, @_ ), "\n";
}

sub substatus
{
    print _color_wrap( 'BLUE' => q{  -> }, @_ ), "\n";
}

sub warning
{
    my @args = @_;
    chomp $args[-1];
    warn _color_wrap( 'YELLOW' => q{==> WARNING: }, @args ), "\n";
}

sub error
{
    my @args = @_;
    chomp $args[-1];
    die _color_wrap( 'RED' => q{==> ERROR: }, @args ), "\n";
}

1;

__END__