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.00";
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             Set frame and fold long lines with frame-friendly prefix string.
36             Folding width is taken from the terminal. Or you can specify the
37             width by calling B function with module option.
38              
39             =item B<--set-frame-width>=I<#>
40              
41             Set frame width. You have to put this option before B<--frame>
42             option. See B function in L section.
43              
44             =begin comment
45              
46             =item B<--frame-simple>
47              
48             Set frame without folding.
49              
50             =end comment
51              
52             =item B<--frame-pages>
53              
54             Output results in multi-column, paginated format to fit the width of the
55             terminal.
56              
57             =back
58              
59             =begin comment
60              
61             Put next line in your F<~/.greplerc> to autoload B module.
62              
63             autoload -Mframe --frame
64              
65             Then you can use B<--frame> option whenever you want.
66              
67             =end comment
68              
69             =begin html
70              
71            

72              
73             =end html
74              
75             =head1 FUNCTION
76              
77             =over 7
78              
79             =item B(B=I)
80              
81             Set terminal width to I. Use like this:
82              
83             greple -Mframe::set(width=80) ...
84              
85             greple -Mframe::set=width=80 ...
86              
87             If non-digit character is found in the value part, it is considered as
88             a Reverse Polish Notation, starting terminal width pushed on the
89             stack. RPN C<2/3-> means C.
90              
91             You can use like this:
92              
93             greple -Mframe::set=width=2/3- --frame --uc '(\w+::)+\w+' --git | ansicolumn -PC2
94              
95             =begin html
96              
97            

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