File Coverage

blib/lib/App/Greple/frame.pm
Criterion Covered Total %
statement 17 41 41.4
branch 0 20 0.0
condition 0 8 0.0
subroutine 6 13 46.1
pod 1 6 16.6
total 24 88 27.2


line stmt bran cond sub pod time code
1             package App::Greple::frame;
2              
3             our $VERSION = "1.03";
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             App::Greple::frame - Greple frame output module
10              
11             =head1 SYNOPSIS
12              
13             greple -Mframe --frame ...
14              
15             =head1 DESCRIPTION
16              
17             Greple -Mframe module provide a capability to put surrounding frames
18             for each blocks.
19              
20             C, C and C frames are printed for blocks.
21              
22             By default B<--join-blocks> option is enabled to collect consecutive
23             lines into a single block. If you don't like this, override it by
24             B<--no-join-blocks> option.
25              
26             =head1 OPTIONS
27              
28             =over 7
29              
30             =item B<--frame>
31              
32             =for comment
33             =item B<--frame-fold>
34              
35             =begin html
36              
37            

38              
39             =end html
40              
41             Set frame and fold long lines with frame-friendly prefix string.
42             Folding width is taken from the terminal. Or you can specify the
43             width by calling B function with module option.
44              
45             =begin comment
46              
47             =item B<--frame-simple>
48              
49             Set frame without folding.
50              
51             =end comment
52              
53             =item B<--frame-cols>
54              
55             Output results in multi-column format to fit the width of the
56             terminal. The number of columns is automatically calculated from the
57             terminal width.
58              
59             =item B<--frame-pages>
60              
61             Output results in multi-column and paginated format.
62              
63             =begin html
64              
65            

66              
67             =end html
68              
69             =item B<--set-frame-width>=I<#>
70              
71             Set frame width. You have to put this option before B<--frame>
72             option. See B function in L section.
73              
74             =back
75              
76             =begin comment
77              
78             Put next line in your F<~/.greplerc> to autoload B module.
79              
80             autoload -Mframe --frame
81              
82             Then you can use B<--frame> option whenever you want.
83              
84             =end comment
85              
86             =head1 FUNCTION
87              
88             =over 7
89              
90             =item B(B=I)
91              
92             Set terminal width to I. Use like this:
93              
94             greple -Mframe::set(width=80) ...
95              
96             greple -Mframe::set=width=80 ...
97              
98             If non-digit character is found in the value part, it is considered as
99             a Reverse Polish Notation, starting terminal width pushed on the
100             stack. RPN C<2/3-> means C.
101              
102             You can use like this:
103              
104             greple -Mframe::set=width=2/3- --frame --uc '(\w+::)+\w+' --git | ansicolumn -PC2
105              
106             =begin html
107              
108            

109              
110             =end html
111              
112             =back
113              
114             =head1 SEE ALSO
115              
116             L
117              
118             L
119              
120             L
121              
122             =head1 AUTHOR
123              
124             Kazumasa Utashiro
125              
126             =head1 LICENSE
127              
128             Copyright 2022-2023 Kazumasa Utashiro.
129              
130             This library is free software; you can redistribute it and/or modify
131             it under the same terms as Perl itself.
132              
133             =cut
134              
135 1     1   236829 use 5.014;
  1         4  
136 1     1   4 use warnings;
  1         2  
  1         83  
137 1     1   469 use utf8;
  1         258  
  1         6  
138 1     1   518 use Data::Dumper;
  1         6473  
  1         172  
139              
140             $ENV{GREPLE_FRAME_PAGES_WIDTH} //= '80';
141             $ENV{GREPLE_FRAME_PAGES_MARGIN} //= '0';
142             $ENV{GREPLE_FRAME_PAGES_BOUNDARY} //= 'none';
143              
144             my($mod, $argv);
145             my($head, $blockend, $file_start, $file_end);
146              
147             my %param = (
148             width => undef,
149             column => undef,
150             fold => '',
151             );
152              
153             sub terminal_width {
154 1     1   530 use Term::ReadKey;
  1         2130  
  1         537  
155 0     0 0   my $default = 80;
156 0           my @size;
157 0 0         if (open my $tty, ">", "/dev/tty") {
158             # Term::ReadKey 2.31 on macOS 10.15 has a bug in argument handling
159             # and the latest version 2.38 fails to install.
160             # This code should work on both versions.
161 0           @size = GetTerminalSize $tty, $tty;
162             }
163 0 0         $size[0] or $default;
164             }
165              
166             sub finalize {
167 0     0 0   ($mod, $argv) = @_;
168             }
169              
170             my %frame_base = (
171             top => ' ┌─' ,
172             middle => ' ⋮ ├╶' ,
173             bottom => '──────┴─' ,
174             );
175              
176             sub opt_frame {
177 0     0 0   my $pos = shift;
178 0   0       my $width = $param{width} //= terminal_width;
179 0 0         local $_ = $frame_base{$pos} or die;
180 0 0         if ((my $rest = $width - length) > 0) {
181 0           $_ .= (substr($_, -1, 1) x $rest);
182             }
183 0           $_;
184             }
185              
186             my %rpn = (
187             width => { init => sub { terminal_width } },
188             column => { init => sub { terminal_width } },
189             );
190             sub rpn {
191 0     0 0   my($k, $v) = @_;
192             require Getopt::EX::RPN
193 0 0         and Getopt::EX::RPN->import('rpn_calc');
194 0   0       my $init = $rpn{$k}->{init} // die;
195 0 0         my @init = ref $init ? $init->() : $init ? $init : ();
    0          
196 0 0         int(rpn_calc(@init, $v)) or die "$v: format error\n";
197             }
198              
199             sub set {
200 0     0 1   while (my($k, $v) = splice(@_, 0, 2)) {
201 0 0         exists $param{$k} or next;
202 0 0 0       $v = rpn($k, $v) if $rpn{$k} and $v =~ /\D/;
203 0           $param{$k} = $v;
204             }
205 0           ();
206             }
207              
208             sub get {
209 1     1   7 use List::Util qw(pairmap);
  1         2  
  1         120  
210 0     0 0   pairmap { $param{$a} } @_;
  0     0      
211             }
212              
213             1;
214              
215             __DATA__