File Coverage

blib/lib/OptArgs2/StatusLine.pm

Criterion	Covered	Total	%
statement	39	44	88.6
branch	14	20	70.0
condition	1	2	50.0
subroutine	8	8	100.0
pod	1	1	100.0
total	63	75	84.0

use strict;
use warnings;

package OptArgs2::StatusLine;

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

sub TIESCALAR {
    my $class = shift;
    bless [], $class;
}

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

sub STORE {
    my $self = shift;
    my $arg  = shift // return;
    my $str;

    if ( 'SCALAR' eq ref $arg ) {
        if ( not defined $self->[0] ) {
            $str = $$arg . $RS;
        }
        else {
            $str = $self->[0] =~ s/[^$RS]+/$$arg/r;
        }
    }
    elsif ( $arg =~ m/$RS/ ) {
        $str = $arg;
    }
    elsif ( not defined $self->[0] ) {
        require File::Basename;
        $str = File::Basename::basename($0) . ': ' . RS . $arg;
    }
    elsif ( $self->[0] =~ m/(.*)$RS/ ) {
        $str = $1 . RS . $arg;
    }
    else {
        warn "Internal Error - should never happen!";
        return;
    }

    my $NL = $str =~ s/\n\z// ? "\n" : "\r";
    my $fh = select;

    if ( -t $fh ) {
        $fh->printflush( $str . "\e[K" . $NL );
    }
    else {
        $fh->print( $str . "\n" );
    }

    $str =~ s/(.*$RS).*/$1/ if $NL eq "\n";
    $self->[0] = $str;
}

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;
        }
        else {
            die 'expected "RS" or "$scalar"';
        }

    }
}

1;

__END__