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.03";
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.03
24              
25             =cut
26              
27 4     4   224096 use v5.14;
  4         49  
28 4     4   627 use utf8;
  4         20  
  4         20  
29 4     4   98 use warnings;
  4         8  
  4         139  
30 4     4   3829 use Data::Dumper;
  4         28812  
  4         441  
31              
32             BEGIN {
33 4     4   22 *ansi_expand = \&expand;
34 4         96 *ansi_unexpand = \&unexpand;
35             }
36              
37 4     4   29 use Exporter qw(import);
  4         9  
  4         327  
38             our @EXPORT_OK = qw(
39             &ansi_expand &ansi_unexpand $tabstop
40             &configure
41             );
42             our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
43              
44 4         2499 use Text::ANSI::Fold qw(
45             $csi_re
46             $reset_re
47             $erase_re
48 4     4   2353 );
  4         257312  
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 81931 my @opt = ref $_[0] eq 'ARRAY' ? @{+shift} : ();
  0         0  
63 132         357 my @param = (width => -1, expand => 1, tabstop => $tabstop, @opt);
64             my @l = map {
65 132         269 s{^ (?>.*\t) (?: [^\e\n]* $end_re+ )? }{
  152         5883  
66 148         5005 ($fold->fold(${^MATCH}, @param))[0];
67             }xmgepr;
68             } @_;
69 132 100       67188 wantarray ? @l : $l[0];
70             }
71              
72             sub unexpand {
73 66 50   66 1 42198 my @opt = ref $_[0] eq 'ARRAY' ? @{+shift} : ();
  0         0  
74             my @l = map {
75 66         164 s{ ^(.*[ ].*) }{ _unexpand($1) }xmger
  76         381  
  74         172  
76             } @_;
77 66 50       156 if ($REMOVE_REDUNDANT) {
78 66         133 for (@l) {
79 76         1121 1 while s/ (?$csi_re+) [^\e\n]* \K $end_re+ \g{c} //xg;
80             }
81             }
82 66 100       341 wantarray ? @l : $l[0];
83             }
84              
85             sub _unexpand {
86 74     74   195 local $_ = shift;
87 74         144 my $ret = '';
88 74         107 my $margin = 0;
89 74         227 while (/ /) {
90 136         229 my $width = $tabstop + $margin;
91 136         441 my($a, $b, $w) = $fold->fold($_, width => $width);
92 136 100       44839 if ($w == $width) {
93 116         778 $a =~ s/([ ]+)(?= $end_re* $)/\t/x;
94             }
95 136         264 $margin = $width - $w;
96 136         199 $ret .= $a;
97 136         400 $_ = $b;
98             }
99 74         402 $ret . $_;
100             }
101              
102             1;
103              
104             __END__