File Coverage

blib/lib/App/UnANSI.pm
Criterion Covered Total %
statement 30 48 62.5
branch 4 14 28.5
condition 2 7 28.5
subroutine 7 12 58.3
pod 5 5 100.0
total 48 86 55.8


line stmt bran cond sub pod time code
1             package App::UnANSI;
2             # ABSTRACT: Remove ANSI coloring from output or files
3              
4 2     2   26350 use strict;
  2         3  
  2         44  
5 2     2   5 use warnings;
  2         2  
  2         46  
6 2     2   1177 use Getopt::Long qw<:config no_ignore_case>;
  2         17170  
  2         8  
7              
8             # Helper function
9             sub _help {
10 0     0   0 my $msg = shift;
11              
12 0 0       0 $msg
13             and print "Error: $msg\n\n";
14              
15 0         0 print << "_HELP";
16             command_that_creates_colored_output | $0 [OPTIONS] FILE1 FILE2...FILEN
17              
18             Options:
19              
20             -h | --help Print this help menu and exit
21             -v | --version Print version number and exit
22             _HELP
23              
24 0 0       0 if ($msg) {
25 0         0 exit 2;
26             } else {
27 0         0 exit 0;
28             }
29             }
30              
31             sub new_with_options {
32 0     0 1 0 my ( $class, %opts ) = @_;
33              
34 0         0 my @files;
35             GetOptions(
36 0     0   0 'help|h' => sub { _help(); },
37             'version|v' => sub {
38 0   0 0   0 my $version = $App::UnANSI::VERSION || 'DEV';
39 0         0 print "$0 $version\n";
40 0         0 exit 0;
41             },
42             '<>' => sub {
43 0     0   0 push @files, @_;
44             },
45 0 0       0 ) or _help();
46              
47 0         0 return $class->new( 'files' => \@files );
48             }
49              
50             sub new {
51 2     2 1 27 my ( $class, %opts ) = @_;
52              
53 2   50     7 $opts{'files'} ||= [];
54              
55 2         4 foreach my $file ( @{ $opts{'files'} } ) {
  2         6  
56 2 50 33     51 -e $file && -r $file
57             or _help("$file is not a readable file")
58             }
59              
60 2         12 return bless {%opts}, $class;
61             }
62              
63             sub files {
64 2     2 1 4 my $self = shift;
65 2         4 return @{ $self->{'files'} };
  2         14  
66             }
67              
68             sub run {
69 2     2 1 38271 my $self = shift;
70 2         12 my @files = $self->files;
71              
72 2 50       8 if ( !@files ) {
73             # Work on STDIN
74 0         0 while ( my $line = ) {
75 0         0 $self->remove_ansi_colors($line);
76 0         0 print $line;
77             }
78             } else {
79             # Work on files
80 2         10 foreach my $file (@files) {
81 2 50       66 open my $fh, '<', $file
82             or die "Cannot open $file: $!\n";
83              
84 2         33 while ( my $line = <$fh> ) {
85 2         11 $self->remove_ansi_colors($line);
86 2         74 print $line;
87             }
88              
89 2 50       22 close $fh
90             or die "Cannot close $file: $!\n";
91             }
92             }
93              
94 2         7 return 1;
95             }
96              
97             sub remove_ansi_colors {
98 2     2 1 22 $_[1] =~ s{\x1b\[[^m]*m}{}sgmx;
99 2         5 return 1;
100             }
101              
102             1;
103              
104             __END__