File Coverage

blib/lib/Text/ANSI/Tabs.pm
Criterion Covered Total %
statement 45 49 91.8
branch 9 12 75.0
condition n/a
subroutine 10 11 90.9
pod 3 3 100.0
total 67 75 89.3


line stmt bran cond sub pod time code
1             package Text::ANSI::Tabs;
2             our $VERSION = "1.02";
3              
4             =encoding utf-8
5              
6             =head1 NAME
7              
8             Text::ANSI::Tabs - Tab expand and unexpand with ANSI sequence
9              
10             =head1 SYNOPSIS
11              
12             use Text::ANSI::Tabs qw(:all);
13             use Text::ANSI::Tabs qw(ansi_expand ansi_unexpand);
14             ansi_expand($text);
15             ansi_unexpand($text);
16              
17             use Text::ANSI::Tabs;
18             Text::ANSI::Tabs::expand($text);
19             Text::ANSI::Tabs::unexpand($text);
20              
21             =head1 VERSION
22              
23             Version 1.02
24              
25             =cut
26              
27 4     4   215511 use v5.14;
  4         45  
28 4     4   666 use utf8;
  4         19  
  4         21  
29 4     4   96 use warnings;
  4         8  
  4         92  
30 4     4   2430 use Data::Dumper;
  4         28559  
  4         354  
31              
32             BEGIN {
33 4     4   27 *ansi_expand = \&expand;
34 4         99 *ansi_unexpand = \&unexpand;
35             }
36              
37 4     4   27 use Exporter qw(import);
  4         8  
  4         314  
38             our @EXPORT_OK = qw(
39             &ansi_expand &ansi_unexpand $tabstop
40             &configure
41             );
42             our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
43              
44 4         2465 use Text::ANSI::Fold qw(
45             $csi_re
46             $reset_re
47             $erase_re
48 4     4   2247 );
  4         249152  
49             my $end_re = qr{ $reset_re | $erase_re }x;
50              
51             my $fold = Text::ANSI::Fold->new;
52              
53             our $tabstop = 8;
54             our $REMOVE_REDUNDANT = 1;
55              
56             sub configure {
57 0     0 1 0 my $class = shift;
58 0         0 $fold->configure(@_);
59             }
60              
61             sub expand {
62 132 50   132 1 82102 my @opt = ref $_[0] eq 'ARRAY' ? @{+shift} : ();
  0         0  
63 132         340 my @param = (width => -1, expand => 1, tabstop => $tabstop, @opt);
64             my @l = map {
65 132         277 s{^ (?>.*\t) (?: [^\e\n]* $end_re+ )? }{
  152         6132  
66 148         5521 ($fold->fold(${^MATCH}, @param))[0];
67             }xmgepr;
68             } @_;
69 132 100       68179 wantarray ? @l : $l[0];
70             }
71              
72             sub unexpand {
73 66 50   66 1 41862 my @opt = ref $_[0] eq 'ARRAY' ? @{+shift} : ();
  0         0  
74             my @l = map {
75 66         147 s{ ^(.*[ ].*) }{ _unexpand($1) }xmger
  76         391  
  74         166  
76             } @_;
77 66 50       161 if ($REMOVE_REDUNDANT) {
78 66         131 for (@l) {
79 76         1163 1 while s/ (?$csi_re+) [^\e\n]* \K $end_re+ \g{c} //xg;
80             }
81             }
82 66 100       328 wantarray ? @l : $l[0];
83             }
84              
85             sub _unexpand {
86 74     74   198 local $_ = shift;
87 74         103 my $ret = '';
88 74         121 my $margin = 0;
89 74         227 while (/ /) {
90 136         214 my $width = $tabstop + $margin;
91 136         383 my($a, $b, $w) = $fold->fold($_, width => $width);
92 136 100       45356 if ($w == $width) {
93 116         799 $a =~ s/([ ]+)(?= $end_re* $)/\t/x;
94             }
95 136         245 $margin = $width - $w;
96 136         214 $ret .= $a;
97 136         416 $_ = $b;
98             }
99 74         400 $ret . $_;
100             }
101              
102             1;
103              
104             __END__