File Coverage

blib/lib/Tail/Tool/Regex.pm
Criterion Covered Total %
statement 28 29 96.5
branch 8 10 80.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 44 47 93.6


line stmt bran cond sub pod time code
1             package Tail::Tool::Regex;
2              
3             # Created on: 2011-03-10 17:42:50
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 7     7   407711 use Moose;
  7         307483  
  7         44  
10 7     7   30995 use warnings;
  7         11  
  7         188  
11 7     7   1163 use version;
  7         2952  
  7         46  
12 7     7   346 use Moose::Util::TypeConstraints;
  7         7  
  7         51  
13 7     7   9658 use English qw/ -no_match_vars /;
  7         3976  
  7         37  
14 7     7   5607 use Term::ANSIColor qw/colored/;
  7         31864  
  7         3801  
15              
16             our $VERSION = version->new('0.4.7');
17              
18             coerce 'RegexpRef'
19             => from 'Str'
20             => via { qr/$_/ };
21              
22             has regex => (
23             is => 'rw',
24             isa => 'RegexpRef',
25             default => qw/^/,
26             coerce => 1,
27             required => 1,
28             );
29             has replace => (
30             is => 'rw',
31             isa => 'Str',
32             predicate => 'has_replace',
33             );
34             has colour => (
35             is => 'rw',
36             isa => 'ArrayRef[Str]',
37             predicate => 'has_colour',
38             );
39             has enabled => (
40             is => 'rw',
41             isa => 'Bool',
42             default => 1,
43             );
44              
45             sub summarise {
46 20     20 1 15239 my ($self, $term) = @_;
47              
48 20         566 my $text = "qr/" . $self->regex . "/";
49              
50 20 100       523 if ( $self->has_replace ) {
51 4         90 $text .= $self->replace . '/';
52             }
53              
54 20 100       507 if ( $self->has_colour ) {
55             $text =
56 0         0 $term ? colored( $text, join ' ', @{ $self->colour } )
57 2 50       6 : $text . ', colour=[' . ( join ', ', @{ $self->colour } ) . ']';
  2         41  
58             }
59              
60 20 100       422 if ( !$self->enabled ) {
61 2 50       46 $text =
62             $term ? colored( "[$text]", 'reverse' )
63             : $text . ', disabled';
64             }
65              
66 20         71 return $text;
67             }
68              
69             1;
70              
71             __END__
72              
73             =head1 NAME
74              
75             Tail::Tool::Regex - Base class for regex details
76              
77             =head1 VERSION
78              
79             This documentation refers to Tail::Tool::Regex version 0.4.7.
80              
81             =head1 SYNOPSIS
82              
83             use Tail::Tool::Regex;
84              
85             # create a new object with a regex reference
86             my $regex = Tail::Tool::Regex->new( regex => qr/^find/ );
87              
88             # if a string is passed it will be coerced into a regex reference
89             $regex = Tail::Tool::Regex->new( regex => '^find' );
90              
91             # if replacement is to be done specify a replacement string
92             $regex = Tail::Tool::Regex->new(
93             regex => qr/find$/,
94             replace => 'found',
95             );
96              
97             # if the regex is used for colouring specify the colours
98             $regex = Tail::Tool::Regex->new(
99             regex => qr/find$/,
100             colour => [qw/red on_green/],
101             );
102              
103             # The regex can be set to being disabled initially
104             $regex = Tail::Tool::Regex->new(
105             regex => qr/find/,
106             enabled => 0,
107             );
108              
109             =head1 DESCRIPTION
110              
111             =head1 SUBROUTINES/METHODS
112              
113             =head2 C<summarise ( [$term] )>
114              
115             Returns a summary of this modules settings, if C<$term> is true the string is
116             coloured for terminal displays.
117              
118             =head1 DIAGNOSTICS
119              
120             A list of every error and warning message that the module can generate (even
121             the ones that will "never happen"), with a full explanation of each problem,
122             one or more likely causes, and any suggested remedies.
123              
124             =head1 CONFIGURATION AND ENVIRONMENT
125              
126             A full explanation of any configuration system(s) used by the module, including
127             the names and locations of any configuration files, and the meaning of any
128             environment variables or properties that can be set. These descriptions must
129             also include details of any configuration language used.
130              
131             =head1 DEPENDENCIES
132              
133             A list of all of the other modules that this module relies upon, including any
134             restrictions on versions, and an indication of whether these required modules
135             are part of the standard Perl distribution, part of the module's distribution,
136             or must be installed separately.
137              
138             =head1 INCOMPATIBILITIES
139              
140             A list of any modules that this module cannot be used in conjunction with.
141             This may be due to name conflicts in the interface, or competition for system
142             or program resources, or due to internal limitations of Perl (for example, many
143             modules that use source code filters are mutually incompatible).
144              
145             =head1 BUGS AND LIMITATIONS
146              
147             A list of known problems with the module, together with some indication of
148             whether they are likely to be fixed in an upcoming release.
149              
150             Also, a list of restrictions on the features the module does provide: data types
151             that cannot be handled, performance issues and the circumstances in which they
152             may arise, practical limitations on the size of data sets, special cases that
153             are not (yet) handled, etc.
154              
155             The initial template usually just has:
156              
157             There are no known bugs in this module.
158              
159             Please report problems to Ivan Wills (ivan.wills@gmail.com).
160              
161             Patches are welcome.
162              
163             =head1 AUTHOR
164              
165             Ivan Wills - (ivan.wills@gmail.com)
166             <Author name(s)> (<contact address>)
167              
168             =head1 LICENSE AND COPYRIGHT
169              
170             Copyright (c) 2011 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
171             All rights reserved.
172              
173             This module is free software; you can redistribute it and/or modify it under
174             the same terms as Perl itself. See L<perlartistic>. This program is
175             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
176             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
177             PARTICULAR PURPOSE.
178              
179             =cut