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