File Coverage

blib/lib/Tail/Tool/RegexList.pm
Criterion Covered Total %
statement 33 33 100.0
branch 1 2 50.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 44 45 97.7


line stmt bran cond sub pod time code
1             package Tail::Tool::RegexList;
2              
3             # Created on: 2011-03-10 16:59:31
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 6     6   83706 use strict;
  6         8  
  6         177  
10 6     6   24 use warnings;
  6         7  
  6         168  
11 6     6   2476 use Moose::Role;
  6         353377  
  6         25  
12 6     6   23624 use Moose::Util::TypeConstraints;
  6         9  
  6         31  
13 6     6   7743 use version;
  6         1870  
  6         40  
14 6     6   786 use English qw/ -no_match_vars /;
  6         2848  
  6         44  
15 6     6   4235 use Tail::Tool::Regex;
  6         15  
  6         3291  
16              
17             our $VERSION = version->new('0.4.7');
18              
19             subtype 'ArrayRefRegex'
20             => as 'ArrayRef[Tail::Tool::Regex]';
21              
22             coerce 'ArrayRefRegex'
23             => from 'ArrayRef'
24             => via {
25             my $array = $_;
26             for my $item (@$array) {
27             my ( $regex, $replace, $enabled ) = ('', '', 1);
28             if ( $item =~ m{^/[^/]+?/,} ) {
29             my $rest;
30             ( $regex, $rest ) = split m{/,}, $item, 2;
31             $regex =~ s{^/}{};
32              
33             if ( !defined $enabled ) {
34             $enabled = 1;
35             }
36             }
37             elsif ( ( $regex, $replace, $enabled ) = $item =~ m{^/ ([^/]+?) / ([^/]+?) / (.)? $}xms ) {
38             $enabled = defined $enabled && $enabled ne '' ? !!$enabled : 1;
39             }
40             else {
41             $regex = $item;
42             $enabled = 1,
43             }
44             $item = Tail::Tool::Regex->new(
45             regex => $regex,
46             enabled => $enabled,
47             $replace
48             ? ( replace => $replace )
49             : (),
50             );
51             }
52             return $array;
53             };
54              
55             coerce 'ArrayRefRegex'
56             => from 'RegexpRef'
57             => via { [ Tail::Tool::Regex->new( regex => $_, enabled => 1 ) ] };
58              
59             coerce 'ArrayRefRegex'
60             => from 'Str'
61             => via { [ Tail::Tool::Regex->new( regex => qr/$_/, enabled => 1 ) ] };
62              
63             coerce 'ArrayRefRegex'
64             => from 'Tail::Tool::Regex'
65             => via { [ $_ ] };
66              
67             has regex => (
68             is => 'rw',
69             isa => 'ArrayRefRegex',
70             coerce => 1,
71             trigger => \&_set_regex,
72             );
73              
74             has replace => (
75             is => 'rw',
76             isa => 'Str',
77             );
78              
79             sub summarise {
80 5     5 1 2263 my ($self, $term) = @_;
81              
82 5         7 my @out;
83 5         8 for my $regex ( @{ $self->regex } ) {
  5         146  
84 5         8 push @out, eval { $regex->summarise($term) };
  5         22  
85 5 50       11 warn "regex not a propper Tail::Tool::Regex object: $@" if $@;
86             }
87 5         29 return join ', ', @out;
88             }
89              
90             sub _set_regex {
91 9     9   58 my ( $self, $regexs, $old_regexs ) = @_;
92              
93 9         17 for my $regex ( @{ $regexs } ) {
  9         28  
94             # $regex->{enabled} ||= 0;
95             }
96              
97 9         23 return;
98             }
99              
100             1;
101              
102             __END__
103              
104             =head1 NAME
105              
106             Tail::Tool::RegexList - <One-line description of module's purpose>
107              
108             =head1 VERSION
109              
110             This documentation refers to Tail::Tool::RegexList version 0.4.7.
111              
112              
113             =head1 SYNOPSIS
114              
115             use Tail::Tool::RegexList;
116              
117             # Brief but working code example(s) here showing the most common usage(s)
118             # This section will be as far as many users bother reading, so make it as
119             # educational and exemplary as possible.
120              
121              
122             =head1 DESCRIPTION
123              
124             =head1 SUBROUTINES/METHODS
125              
126             =head2 C<summarise ( [$term] )>
127              
128             Returns a summary of this modules settings, setting C<$term> true results in
129             summary being coloured for terminal display
130              
131             =head1 DIAGNOSTICS
132              
133             A list of every error and warning message that the module can generate (even
134             the ones that will "never happen"), with a full explanation of each problem,
135             one or more likely causes, and any suggested remedies.
136              
137             =head1 CONFIGURATION AND ENVIRONMENT
138              
139             A full explanation of any configuration system(s) used by the module, including
140             the names and locations of any configuration files, and the meaning of any
141             environment variables or properties that can be set. These descriptions must
142             also include details of any configuration language used.
143              
144             =head1 DEPENDENCIES
145              
146             A list of all of the other modules that this module relies upon, including any
147             restrictions on versions, and an indication of whether these required modules
148             are part of the standard Perl distribution, part of the module's distribution,
149             or must be installed separately.
150              
151             =head1 INCOMPATIBILITIES
152              
153             A list of any modules that this module cannot be used in conjunction with.
154             This may be due to name conflicts in the interface, or competition for system
155             or program resources, or due to internal limitations of Perl (for example, many
156             modules that use source code filters are mutually incompatible).
157              
158             =head1 BUGS AND LIMITATIONS
159              
160             A list of known problems with the module, together with some indication of
161             whether they are likely to be fixed in an upcoming release.
162              
163             Also, a list of restrictions on the features the module does provide: data types
164             that cannot be handled, performance issues and the circumstances in which they
165             may arise, practical limitations on the size of data sets, special cases that
166             are not (yet) handled, etc.
167              
168             The initial template usually just has:
169              
170             There are no known bugs in this module.
171              
172             Please report problems to Ivan Wills (ivan.wills@gmail.com).
173              
174             Patches are welcome.
175              
176             =head1 AUTHOR
177              
178             Ivan Wills - (ivan.wills@gmail.com)
179             <Author name(s)> (<contact address>)
180              
181             =head1 LICENSE AND COPYRIGHT
182              
183             Copyright (c) 2011 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
184             All rights reserved.
185              
186             This module is free software; you can redistribute it and/or modify it under
187             the same terms as Perl itself. See L<perlartistic>. This program is
188             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
189             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
190             PARTICULAR PURPOSE.
191              
192             =cut