File Coverage

blib/lib/File/CodeSearch/Highlighter.pm
Criterion Covered Total %
statement 71 71 100.0
branch 27 32 84.3
condition 3 3 100.0
subroutine 9 9 100.0
pod 2 2 100.0
total 112 117 95.7


line stmt bran cond sub pod time code
1             package File::CodeSearch::Highlighter;
2              
3             # Created on: 2009-08-07 18:42:16
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 4     4   146457 use Moose;
  4         788113  
  4         27  
10 4     4   25202 use warnings;
  4         10  
  4         138  
11 4     4   838 use version;
  4         2988  
  4         25  
12 4     4   332 use Carp;
  4         9  
  4         249  
13 4     4   635 use English qw/ -no_match_vars /;
  4         5351  
  4         26  
14 4     4   1777 use Term::ANSIColor qw/:constants/;
  4         7037  
  4         1544  
15 4     4   1350 use Term::Size::Any;
  4         839  
  4         21  
16              
17             our $VERSION = version->new('0.7.5');
18              
19             extends 'File::CodeSearch::RegexBuilder';
20              
21             has highlight_re => (
22             is => 'rw',
23             );
24             has before_match => (
25             is => 'rw',
26             isa => 'Str',
27             default => BOLD . RED,
28             );
29             has after_match => (
30             is => 'rw',
31             isa => 'Str',
32             default => RESET,
33             );
34             has before_nomatch => (
35             is => 'rw',
36             isa => 'Str',
37             default => CYAN,
38             );
39             has after_nomatch => (
40             is => 'rw',
41             isa => 'Str',
42             default => RESET,
43             );
44             has before_snip => (
45             is => 'rw',
46             isa => 'Str',
47             default => RESET . RED . ON_BLACK,
48             );
49             has after_snip => (
50             is => 'rw',
51             isa => 'Str',
52             default => RESET,
53             );
54             has limit => (
55             is => 'rw',
56             isa => 'Int',
57             default => sub {
58             my ($cols, $rows) = Term::Size::Any::chars;
59             return $cols || 212;
60             }
61             );
62             has snip => (
63             is => 'rw',
64             isa => 'Bool',
65             default => 1,
66             );
67              
68             sub make_highlight_re {
69 19     19 1 19713 my ($self) = @_;
70              
71 19 100       606 return $self->highlight_re if $self->highlight_re;
72              
73 13         64 my $re = $self->make_regex;
74              
75             # make sure that all brackets are for non capture groups
76 13         72 $re =~ s/ (?<! \\ | \[ ) [(] (?! [?] ) /(?:/gxms;
77              
78 13         374 return $self->highlight_re($re);
79             }
80              
81             sub highlight {
82 9     9 1 14505 my ($self, $string) = @_;
83 9         28 my $re = $self->make_highlight_re;
84 9         16 my $out = '';
85              
86 9         82 my @parts = split /($re)/, $string;
87              
88 9         18 my $match_length = 0;
89 9         41 for my $i ( 0 .. @parts - 1 ) {
90 35 100       68 if ( $i % 2 ) {
91 13         30 $match_length += length $parts[$i];
92             }
93             }
94              
95             # 5 is the magic number of characters used to show the line number
96 9         240 my $limit = $self->limit - $match_length - 5;
97 9         31 my $joins = @parts - ( @parts - 1 ) / 2;
98 9         21 my $chars = ( $limit / $joins ) / 2 - 2;
99 9         21 my $chars_front = int $chars;
100 9         13 my $chars_back = int $chars;
101 9         24 my $total = $joins * ( $chars_front + $chars_back + 3 ) + 1;
102 9 100       37 if (length $parts[-1] < $chars * 2) {
103 5         9 $total -= $chars_front + $chars_back - length $parts[-1];
104             }
105              
106 9 100       29 my $inc = $limit - $total > $joins * 2 ? 1 : 0;
107 9         17 $chars += $inc;
108 9         13 $chars_front = int $chars;
109 9         15 $chars_back = int $chars;
110 9         19 $total = $joins * ( $chars_front + $chars_back + 3 ) + 1;
111 9 100       26 if (length $parts[-1] < $chars * 2) {
112 5         11 $total -= $chars_front + $chars_back - length $parts[-1];
113             }
114             #warn "match = $match_length\nchars = $chars\nlimit = $limit ($total)\nparts = " . (scalar @parts) . "\njoins = $joins\n";
115              
116 9         22 for my $i ( 0 .. @parts - 1 ) {
117 35 100       74 if ( $i % 2 ) {
118 13         439 $out .= $self->before_match . $parts[$i] . $self->after_match;
119             }
120             else {
121 22         31 my $part = $parts[$i];
122 22 100 100     559 if ($self->snip && length $string > $self->limit) {
123 7         11 my $chars_front_tmp = $chars_front;
124 7         11 my $chars_back_tmp = $chars_back;
125 7 100       15 if ($total < $limit) {
126 1         2 $chars_front_tmp++;
127 1         3 $total++;
128             }
129 7 100       16 if ($total < $limit) {
130 1         2 $chars_back_tmp++;
131 1         1 $total++;
132             }
133              
134             # Check if
135 7 50       17 if ($chars_front_tmp + $chars_back_tmp < length $parts[$i]) {
136 7 50       18 my ($front) = $chars_front_tmp > 0 ? $parts[$i] =~ /\A(.{$chars_front_tmp})/xms : ('');
137 7 50       16 my ($back) = $chars_back_tmp > 0 ? $parts[$i] =~ /(.{$chars_back_tmp})\Z/xms : ('');
138 7 50       184 $part = (defined $front ? $front : '')
    50          
139             . $self->before_snip . '...'
140             . $self->after_snip
141             . $self->before_nomatch
142             . (defined $back ? $back : '');
143             }
144             }
145 22         634 $out .= $self->before_nomatch . $part . $self->after_nomatch;
146             }
147             }
148              
149 9         133 $out .= RESET;
150 9 100       104 $out .= "\\N" if $string !~ /\n/xms;
151 9 100       25 $out .= "\n" if $out !~ /\n/xms;
152              
153 9         146 return $out;
154             }
155              
156             1;
157              
158             __END__
159              
160             =head1 NAME
161              
162             File::CodeSearch::Highlighter - Highlights matched parts of a line.
163              
164             =head1 VERSION
165              
166             This documentation refers to File::CodeSearch::Highlighter version 0.7.5.
167              
168              
169             =head1 SYNOPSIS
170              
171             use File::CodeSearch::Highlighter;
172              
173             # Brief but working code example(s) here showing the most common usage(s)
174             # This section will be as far as many users bother reading, so make it as
175             # educational and exemplary as possible.
176              
177              
178             =head1 DESCRIPTION
179              
180             =head1 ATTRIBUTES
181              
182             =over 4
183              
184             =item C<highlight_re>
185              
186             The regular expression used to find what to highlight
187              
188             =item C<before_match (Str, BOLD RED)>
189              
190             A string put before a match
191              
192             =item C<after_match (Str RESET)>
193              
194             A string put after a match
195              
196             =item C<before_nomatch (Str, CYAN)>
197              
198             A string for before text that doesn't match
199              
200             =item C<after_nomatch (Str, RESET)>
201              
202             A string for after text that doesn't match
203              
204             =item C<before_snip (Str, RESET . RED . ON_BLACK)>
205              
206             A string for before snipped out text.
207              
208             =item C<after_snip (Str, RESET)>
209              
210             A string for after snipped out text.
211              
212             =item C<limit (Int, columns in terminal)>
213              
214             The size of the limit for line length of text that is extremely long.
215              
216             =item C<snip (Bool, 1)>
217              
218             Cut out non-matching text so that one line of text matches on line of output
219              
220             =back
221              
222             =head1 SUBROUTINES/METHODS
223              
224             =head3 C<highlight ( $search, )>
225              
226             Param: C<$search> - type (detail) - description
227              
228             Return: File::CodeSearch::Highlighter -
229              
230             Description:
231              
232             =head3 C<make_highlight_re ( $search, )>
233              
234             =head1 DIAGNOSTICS
235              
236             =head1 CONFIGURATION AND ENVIRONMENT
237              
238             =head1 DEPENDENCIES
239              
240             =head1 INCOMPATIBILITIES
241              
242             =head1 BUGS AND LIMITATIONS
243              
244             There are no known bugs in this module.
245              
246             Please report problems to Ivan Wills (ivan.wills@gmail.com).
247              
248             Patches are welcome.
249              
250             =head1 AUTHOR
251              
252             Ivan Wills - (ivan.wills@gmail.com)
253              
254             =head1 LICENSE AND COPYRIGHT
255              
256             Copyright (c) 2009 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
257             All rights reserved.
258              
259             This module is free software; you can redistribute it and/or modify it under
260             the same terms as Perl itself. See L<perlartistic>. This program is
261             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
262             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
263             PARTICULAR PURPOSE.
264              
265             =cut