view release on metacpan or  search on metacpan

lib/App/Pod.pm  view on Meta::CPAN

    };
    my $path = path( $self->define_last_run_cache_file );

    if ( not -e $path->dirname ) {
        mkdir $path->dirname or die $!;
    }

    my $writer = $path->can( "spew" ) ? "spew" : "spurt";
    $path->$writer( j $cache );

    # Reset the flag.
    $self->_dirty_cache( 0 );

    $cache;
}

=head2 retrieve_cache

Returns the last stored class cache and its options.

=cut

sub retrieve_cache {
    my ( $self ) = @_;
    my $empty = { class => "" };
    return $empty if $self->_dirty_cache;

    # Use in-memory cache if present.
    my $mem_cache = $self->_cache_from_file;
    return $mem_cache if $mem_cache;

    # Otherwise, go to the actual file.
    my $file = $self->define_last_run_cache_file;
    if ( not -e $file ) {
        $self->_dirty_cache( 1 );
        return $empty;
    }

    # Extract data from file.
    my $disk_cache = j path( $file )->slurp;

    # Wrong class.
    if ( $disk_cache->{class} ne $self->_class ) {
        $self->_dirty_cache( 1 );
        return $empty;
    }

    # Cache it locally
    $self->_cache_from_file( $disk_cache );

    $disk_cache;
}

#
# Output
#

=head2 trim

Trim a line to fit the terminal width.
Handles also escape codes within the line.

=cut

sub trim {
    my ( $line ) = @_;
    state $esc            = qr{ \033\[ [\d;]+ m    }x;
    state $data           = qr{ (?: (?!$esc) . )++ }x;
    state $data_or_escape = qr{ (?<data>$data) | (?<esc>$esc) }x;
    state $term_width     = Pod::Query::get_term_width();
    state $replacement    = " ...";
    state $width_raw      = $term_width - length( $replacement );
    state $base_width = $width_raw >= 0 ? $width_raw : 0;  # To avoid negatives.

    # Figure out the total len of the line (uncolored).
    my $total_chars = 0;
    my @detailed_line_parts;
    while ( $line =~ /$data_or_escape/g ) {
        my $part = {%+};
        $total_chars += $part->{len} = length( $part->{data} // "" );
        push @detailed_line_parts, $part;
    }

    # No need to trim.
    return $line if $total_chars <= $term_width;

    # Need to trim.
    my @parts;
    my $size_exceeded;
    my $so_far_len = 0;
    for my $part ( @detailed_line_parts ) {

        # Handle escape codes.
        if ( not $part->{len} ) {
            push @parts, $part->{esc};    # Add escapes back.
            last if $size_exceeded;       # Done.
            next;
        }

        # Handle trailing escapes.
        last if $size_exceeded;

        # Trim line if it would be too long.
        if ( $so_far_len + $part->{len} > $base_width ) {
            $size_exceeded = 1;  # Still need to possibly add a trailing escape.

            # Limit line to allowed width.
            $part->{data} = substr(
                $part->{data},
                0,
                $base_width - $so_far_len,    # How much space is left.
            ) . $replacement;
        }

        $so_far_len += $part->{len};
        push @parts, $part->{data};
    }

    join "", @parts;
}

sub _sayt {

    say trim( @_ );
}

sub _red {

    colored( "@_", "RESET RED" );
}

sub _yellow {

    colored( "@_", "RESET YELLOW" );
}

sub _green {

    # Reset since last line may be trimmed.
    colored( "@_", "RESET GREEN" );
}

sub _grey {

    colored( "@_", "RESET DARK" );
}

sub _neon {

    colored( "@_", "RESET ON_BRIGHT_BLACK" );
}

sub _reset {

    colored( "@_", "RESET" );
}

#
# Misc Support
#

sub uniq(@) {
    my %h;
    grep { not $h{$_}++ } @_;
}