File Coverage

blib/lib/App/logcat_format.pm
Criterion Covered Total %
statement 30 96 31.2
branch 0 26 0.0
condition n/a
subroutine 10 17 58.8
pod 0 5 0.0
total 40 144 27.7


line stmt bran cond sub pod time code
1             package App::logcat_format;
2              
3             # ABSTRACT: pretty print adb logcat output
4              
5 1     1   15543 use strict;
  1         3  
  1         33  
6 1     1   4 use warnings;
  1         1  
  1         24  
7              
8 1     1   418 use Cache::LRU;
  1         591  
  1         24  
9 1     1   511 use Term::ReadKey;
  1         5774  
  1         133  
10 1     1   823 use Term::ANSIColor;
  1         6147  
  1         111  
11 1     1   760 use IO::Async::Loop;
  1         43745  
  1         33  
12 1     1   574 use IO::Async::Process;
  1         14076  
  1         32  
13 1     1   602 use Getopt::Long::Descriptive;
  1         34420  
  1         7  
14 1     1   706 use IO::Interactive qw( is_interactive );
  1         3364  
  1         6  
15              
16             =pod
17              
18             =head1 NAME
19              
20             logcat_format - pretty print android adb logcat output
21              
22             =head1 DESCRIPTION
23              
24             A tool to pretty print the output of the android sdk 'adb logcat' command.
25              
26             =head1 SYNOPSIS
27              
28             Default adb logcat pretty print ..
29              
30             % logcat_format
31              
32             For default logcat output for emulator only ..
33              
34             % logcat_format -e
35              
36             For default logcat output for device only ..
37              
38             % logcat_format -d
39              
40             For other adb logcat commands, just pipe into logcat_format ..
41              
42             % adb logcat -v threadtime | logcat_format
43             % adb -e logcat -v process | logcat_format
44              
45             =head1 VERSION
46              
47             version 0.06
48              
49             =cut
50              
51             # set it up
52             my ($opt, $usage) = describe_options(
53             'logcat_format',
54             [ 'emulator|e', "connect to emulator", ],
55             [ 'device|d', "connect to device", ],
56             [],
57             [ 'help|h', "print usage message and exit" ],
58             );
59            
60             print($usage->text), exit if $opt->help;
61            
62             my %priority =
63             (
64             V => 'bold black on_bright_white', # Verbose
65             D => 'bold black on_bright_blue', # Debug
66             I => 'bold black on_bright_green', # Info
67             W => 'bold black on_bright_yellow', # Warn
68             E => 'bold black on_bright_red', # Error
69             F => 'bold white on_black', # Fatal
70             S => 'not printed', # Silent
71             );
72              
73             my %known_tags =
74             (
75             dalvikvm => 'bright_blue',
76             PackageManager => 'cyan',
77             ActivityManager => 'blue',
78             );
79              
80             my $cache = Cache::LRU->new( size => 1000 );
81             my @colors = ( 1 .. 15 );
82              
83             my ( $wchar, $hchar, $wpixels, $hpixels ) = GetTerminalSize();
84              
85             my %longline;
86              
87             sub run
88             {
89 0     0 0   my $class = shift;
90              
91 0 0         if ( is_interactive() )
92             {
93             # kick off adb logcat with args
94 0           my $loop = IO::Async::Loop->new;
95              
96 0           my $argument = '-a';
97 0 0         $argument = '-e' if $opt->emulator;
98 0 0         $argument = '-d' if $opt->device;
99            
100             my $process = IO::Async::Process->new(
101             command => [ 'adb', $argument, 'logcat' ],
102             stdout => {
103             on_read => sub {
104 0     0     my ( $stream, $buffref ) = @_;
105 0           format_line( $1 ) while( $$buffref =~ s/^(.*)\n// );
106 0           return 0;
107             },
108             },
109             on_finish => sub {
110 0     0     print "The process has finished\n";
111             }
112 0           );
113 0           $loop->add( $process );
114 0           $loop->run();
115             }
116             else
117             {
118             # piped to STDIN
119 0           format_line( $_ ) while ( );
120             }
121             }
122              
123             sub format_line
124             {
125 0     0 0   my $line = shift; chomp $line;
  0            
126              
127 0 0         if ( $line =~ m!^
    0          
    0          
    0          
    0          
128             (?V|D|I|W|E|F|S)
129             \/
130             (?.+?)
131             \(\s{0,5}
132             (?\d{1,5})
133             \):\s
134             (?.*)
135             $!xms )
136             {
137             # 'BRIEF' format
138 1     1   855 print colored( sprintf( " %5s ", $+{pid} ), 'bold black on_grey9' );
  1         434  
  1         1069  
  0            
139 0           print colored( sprintf( " %s ", $+{priority} ), "bold $priority{ $+{priority} }" );
140 0           print colored( sprintf( " %25s ", tag_format( $+{tag} ) ), tag_colour( $+{tag} ) );
141 0           print colored( sprintf( " %s", log_format( $+{log}, 39 ) ), 'white' );
142 0           print "\n";
143             }
144             elsif ( $line =~ m!^
145             (?V|D|I|W|E|F|S)
146             \(\s{0,}?
147             (?\d{1,5})
148             \){1}\s{1}
149             (?.*)
150             \s{1,}?\(
151             (?.+?)
152             \)\s{1,}?
153             $!xms )
154             {
155             # 'PROCESS' format
156 0           print colored( sprintf( " %5s ", $+{pid} ), 'bold black on_grey9' );
157 0           print colored( sprintf( " %s ", $+{priority} ), "bold $priority{ $+{priority} }" );
158 0           print colored( sprintf( " %25s ", tag_format( $+{tag} ) ), tag_colour( $+{tag} ) );
159 0           print colored( sprintf( " %s", log_format( $+{log}, 39 ) ), 'white' );
160 0           print "\n";
161             }
162             elsif ( $line =~ m!^
163             (?V|D|I|W|E|F|S)
164             \/
165             (?.+?)
166             :\s{1}
167             (?.*)
168             $!xms )
169             {
170             # 'TAG' format
171 0           print colored( sprintf( " %s ", $+{priority} ), "bold $priority{ $+{priority} }" );
172 0           print colored( sprintf( " %25s ", tag_format( $+{tag} ) ), tag_colour( $+{tag} ) );
173 0           print colored( sprintf( " %s", log_format( $+{log}, 32 ) ), 'white' );
174 0           print "\n";
175             }
176             elsif ( $line =~ m!^
177             (?\d\d-\d\d)
178             \s
179             (?
180             \s
181             (?V|D|I|W|E|F|S)
182             \/
183             (?.+)
184             \(\s*
185             (?\d{1,5})
186             \):\s
187             (?.*)
188             $!xms )
189             {
190             # 'TIME' format
191 0           print colored( sprintf( " %5s ", $+{time} ), 'bold black on_grey12' );
192 0           print colored( sprintf( " %5s ", $+{date} ), 'bold black on_grey7' );
193 0           print colored( sprintf( " %5s ", $+{pid} ), 'bold black on_grey9' );
194 0           print colored( sprintf( " %s ", $+{priority} ), "bold $priority{ $+{priority} }" );
195 0           print colored( sprintf( " %25s ", tag_format( $+{tag} ) ), tag_colour( $+{tag} ) );
196 0           print colored( sprintf( " %s", log_format( $+{log}, 60 ) ), 'white' );
197 0           print "\n";
198             }
199             elsif ( $line =~ m/^
200             (?\d\d-\d\d)
201             \s
202             (?
203             \s{1,5}
204             (?\d{1,5})
205             \s{1,5}
206             (?\d{1,5})
207             \s
208             (?V|D|I|W|E|F|S)
209             \s
210             (?.+?)
211             :\s{1,}?
212             (?.*)
213             $/xms )
214             {
215             # 'THREADTIME' format
216 0           print colored( sprintf( " %5s ", $+{time} ), 'bold black on_grey12' );
217 0           print colored( sprintf( " %5s ", $+{date} ), 'bold black on_grey7' );
218 0           print colored( sprintf( " %5s ", $+{pid} ), 'bold black on_grey9' );
219 0           print colored( sprintf( " %5s ", $+{tid} ), 'bold black on_grey10' );
220 0           print colored( sprintf( " %s ", $+{priority} ), "bold $priority{ $+{priority} }" );
221 0           print colored( sprintf( " %25s ", tag_format( $+{tag} ) ), tag_colour( $+{tag} ) );
222 0           print colored( sprintf( " %s", log_format( $+{log}, 67 ) ), 'white' );
223 0           print "\n";
224             }
225             else
226             {
227 0           print "$line\n";
228             }
229             }
230              
231             sub tag_format
232             {
233 0     0 0   my $tag = shift;
234              
235 0           $tag =~ s/^\s+|\s+$//g;
236 0 0         return substr( $tag, ( length $tag ) - 25 ) if ( length $tag > 25 );
237 0           return $tag;
238             }
239              
240             sub tag_colour
241             {
242 0     0 0   my $tag = shift;
243              
244 0 0         return $known_tags{$tag} if ( exists $known_tags{$tag} );
245 0 0         return $cache->get( $tag ) if ( $cache->get( $tag ) );
246              
247 0           $cache->set ( $tag => "ANSI$colors[0]" );
248 0           push @colors, shift @colors;
249              
250 0           return $cache->get( $tag );
251             }
252              
253             sub log_format
254             {
255 0     0 0   my ( $msg, $wrap ) = @_;
256              
257 0           $msg =~ s/^\s+|\s+$//g;
258              
259 0 0         return $msg if ( ! defined $wrap );
260 0 0         return $msg if length $msg < ( $wchar - $wrap );
261              
262 0           my $str = substr $msg, 0, ( $wchar - $wrap );
263 0           $str .= "\n";
264 0           $str .= ' ' x $wrap;
265 0           $str .= substr $msg, ( $wchar - $wrap );
266              
267 0           return $str;
268             }
269              
270             1;