File Coverage

blib/lib/OptArgs2/StatusLine.pm

Criterion	Covered	Total	%
statement	52	60	86.6
branch	20	24	83.3
condition	4	4	100.0
subroutine	10	11	90.9
pod	1	2	50.0
total	87	101	86.1

use strict;
use warnings;

package OptArgs2::StatusLine;

our $VERSION = 'v2.0.17';

sub RS { chr(30) }
my $RS = RS;

our $WARN_FMT = "\e[38;5;220m%s\e[0m\n";
sub WARN { chr(5) }
my $WARN = WARN;

sub TIESCALAR {
    my $class = shift;
    bless( ( \my $str ), $class );
}

sub FETCH { ${ $_[0] } }

sub STORE {
    my $self = shift;
    my $arg  = shift // return $$self = undef;
    my %arg  = ();

    if ( 'SCALAR' eq ref $arg ) {
        $arg{prefix} = $$arg;
    }
    elsif ( '' eq $arg ) {
        $arg{msg} = '';
    }
    else {
        $arg =~ m/
            (?:(?.+?)?(?:$RS))?
            (?$WARN)?
            (?.+?)?
            (?\n)?
            \z
            /x;

        %arg = %+;
    }

    ( $$self // '' ) =~ m/
        (?:(?.*)(?:$RS))?
        (?.*?)?
        \z
        /x;

    my %next = ( %+, NL => "\r", %arg );

    if ( not defined $next{prefix} ) {
        require File::Basename;
        $next{prefix} = File::Basename::basename($0) . ': ';
    }

    my $fh = select;
    if ( $next{WARN} ) {
        if ( -t STDERR ) {
            warn sprintf $WARN_FMT, $next{prefix} . $next{msg} . "\e[K";
        }
        else {
            warn $next{prefix}, $next{msg}, "\n";
        }
        $fh->print( $next{prefix}, $next{msg}, "\n" ) if not -t $fh;
    }
    elsif ( -t $fh ) {
        $fh->printflush( "\e[?25l", $next{prefix}, $next{msg}, "\e[K",
            $next{NL} );
    }
    else {
        $fh->print( $next{prefix}, $next{msg}, "\n" );
    }

    $next{msg} = '' if $next{NL} eq "\n";
    $$self = $next{prefix} . RS . $next{msg};
}

END {
    my $fh = select;
    $fh->printflush("\e[?25h") if -t $fh;
}

sub import {
    my $class  = shift;
    my $caller = scalar caller;

    no strict 'refs';
    foreach my $arg (@_) {
        if ( $arg =~ m/^\$(.*)/ ) {
            my $name = $1;
            tie my $x, 'OptArgs2::StatusLine';
            *{ $caller . '::' . $name } = \$x;
        }
        elsif ( $arg eq 'RS' ) {
            *{ $caller . '::RS' } = \&RS;
        }
        elsif ( $arg eq 'WARN' ) {
            *{ $caller . '::WARN' } = \&WARN;
        }
        else {
            require Carp;
            Carp::croak('expected "RS", "WARN" or "$scalar"');
        }

    }
}

sub _explode {
    require Carp;
    my $s = shift;
    $s =~ s/\n/\\n/g;
    $s = join( ' . RS . ', map { qq{"$_"} } split( /$RS/, $s ) );
    Carp::carp($s);
}

1;

__END__