File Coverage

blib/lib/Metabrik/String/Regex.pm
Criterion Covered Total %
statement 9 25 36.0
branch 0 10 0.0
condition n/a
subroutine 3 5 60.0
pod 1 2 50.0
total 13 42 30.9


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # string::regex Brik
5             #
6             package Metabrik::String::Regex;
7 1     1   639 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         25  
9              
10 1     1   4 use base qw(Metabrik);
  1         2  
  1         333  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable encode decode) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             },
20             attributes_default => {
21             },
22             commands => {
23             encode => [ qw($regex|$regex_list) ],
24             },
25             require_modules => {
26             'Regexp::Assemble' => [ ],
27             },
28             };
29             }
30              
31             sub encode {
32 0     0 0   my $self = shift;
33 0           my ($regex) = @_;
34              
35 0 0         $self->brik_help_run_undef_arg('encode', $regex) or return;
36              
37 0 0         my $ra = Regexp::Assemble->new
38             or return $self->log->error("encode: Regexp::Assemble new failed");
39              
40 0 0         if (ref($regex)) {
    0          
41 0           for my $this (@$regex) {
42 0           $ra->add($this);
43             }
44             }
45             elsif (! ref($regex)) {
46 0           $ra->add($regex);
47             }
48              
49 0           my $encoded;
50 0           eval {
51 0           $encoded = $ra->as_string;
52             };
53 0 0         if ($@) {
54 0           chomp($@);
55 0           return $self->log->error("encode: assembling failed [$@]");
56             }
57              
58 0           return $encoded;
59             }
60              
61             1;
62              
63             __END__