view release on metacpan or  search on metacpan

lib/Tail/Tool/RegexList.pm  view on Meta::CPAN

package Tail::Tool::RegexList;

# Created on: 2011-03-10 16:59:31
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use strict;
use warnings;
use Moose::Role;
use Moose::Util::TypeConstraints;
use version;
use English qw/ -no_match_vars /;
use Tail::Tool::Regex;

our $VERSION = version->new('0.4.8');

subtype 'ArrayRefRegex'
    => as 'ArrayRef[Tail::Tool::Regex]';

coerce 'ArrayRefRegex'
    => from 'ArrayRef'
    => via {
        my $array = $_;
        for my $item (@$array) {
            my ( $regex, $replace, $enabled ) = ('', '', 1);
            if ( $item =~ m{^/[^/]+?/,} ) {
                my $rest;
                ( $regex, $rest ) = split m{/,}, $item, 2;
                $regex =~ s{^/}{};

                if ( !defined $enabled ) {
                    $enabled = 1;
                }
            }
            elsif ( ( $regex, $replace, $enabled ) = $item =~ m{^/ ([^/]+?) / ([^/]+?) / (.)? $}xms ) {
                $enabled = defined $enabled && $enabled ne '' ? !!$enabled : 1;
            }
            else {
                $regex = $item;
                $enabled = 1,
            }
            $item = Tail::Tool::Regex->new(
                regex   => $regex,
                enabled => $enabled,
                $replace
                ? ( replace => $replace )
                : (),
            );
        }
        return $array;
    };

coerce 'ArrayRefRegex'
    => from 'RegexpRef'
    => via { [ Tail::Tool::Regex->new( regex => $_, enabled => 1 ) ] };

coerce 'ArrayRefRegex'
    => from 'Str'
    => via { [ Tail::Tool::Regex->new( regex => qr/$_/, enabled => 1 ) ] };

coerce 'ArrayRefRegex'
    => from 'Tail::Tool::Regex'
    => via { [ $_ ] };

has regex => (
    is     => 'rw',
    isa    => 'ArrayRefRegex',
    coerce => 1,
    trigger => \&_set_regex,
);

has replace => (
    is     => 'rw',
    isa    => 'Str',
);

sub summarise {
    my ($self, $term) = @_;

    my @out;
    for my $regex ( @{ $self->regex } ) {
        push @out, eval { $regex->summarise($term) };
        warn "regex not a propper Tail::Tool::Regex object: $@" if $@;
    }
    return join ', ', @out;
}

sub _set_regex {