File Coverage

blib/lib/FLAT/Regex/WithExtraOps.pm
Criterion Covered Total %
statement 33 63 52.3
branch 0 4 0.0
condition n/a
subroutine 14 28 50.0
pod 1 2 50.0
total 48 97 49.4


line stmt bran cond sub pod time code
1             package FLAT::Regex::WithExtraOps;
2 6     6   44 use parent 'FLAT::Regex';
  6         12  
  6         33  
3              
4 6     6   340 use strict;
  6         10  
  6         107  
5 6     6   27 use Carp;
  6         11  
  6         1734  
6              
7             #### Precedence
8             # 30 ::star
9             # 20 ::concat
10             # 15 ::negate <---<< WithExtraOps
11             # 12 ::shuffle <---<< WithExtraOps
12             # 10 ::alt
13             # 0 ::atomic
14              
15             my $PARSER = FLAT::Regex::Parser->new(qw[ alt concat star negate shuffle ]);
16 3028     3028   24536 sub _parser {$PARSER}
17              
18             sub negate {
19 0     0 0 0 my $self = $_[0];
20 0         0 my $op = FLAT::Regex::Op::negate->new(map {$_->as_regex->op} @_);
  0         0  
21 0         0 $self->_from_op($op);
22             }
23              
24             ###############################
25             sub shuffle {
26 0     0 1 0 my $self = $_[0];
27 0         0 my $op = FLAT::Regex::Op::shuffle->new(map {$_->as_regex->op} @_);
  0         0  
28 0         0 $self->_from_op($op);
29             }
30              
31             package FLAT::Regex::Op::negate;
32 6     6   44 use parent "FLAT::Regex::Op";
  6         10  
  6         53  
33 6     6   433 use Carp;
  6         13  
  6         1729  
34              
35 6     6   19 sub parse_spec {"'~' %s";}
36 6     6   18 sub precedence {15} # between concat and alternation
37              
38             sub as_string {
39 0     0   0 my ($self, $prec) = @_;
40 0         0 my $result = "~" . $self->members->as_string($self->precedence);
41 0 0       0 return $prec > $self->precedence ? "($result)" : $result;
42             }
43              
44             sub from_parse {
45 0     0   0 my ($pkg, @item) = @_;
46 0         0 $pkg->new($item[2]);
47             }
48              
49             ## note: "reverse" conflicts with perl builtin
50             sub reverse {
51 0     0   0 my $self = shift;
52 0         0 my $op = $self->members->reverse;
53 0         0 __PACKAGE__->new($op);
54             }
55              
56             sub is_empty {
57 0     0   0 croak "Not implemented for negated regexes";
58             }
59              
60             sub has_nonempty_string {
61 0     0   0 croak "Not implemented for negated regexes";
62             }
63              
64             sub is_finite {
65 0     0   0 croak "Not implemented for negated regexes";
66             }
67              
68             ###############################
69             package FLAT::Regex::Op::shuffle;
70 6     6   42 use parent 'FLAT::Regex::Op';
  6         12  
  6         25  
71 6     6   351 use Carp;
  6         20  
  6         2319  
72              
73 6     6   42 sub parse_spec {"%s(2.. /[&]/)"}
74 6     6   15 sub precedence {12}
75              
76             sub as_string {
77 0     0   0 my ($self, $prec) = @_;
78 0         0 my $result = join "&", map {$_->as_string($self->precedence)} $self->members;
  0         0  
79 0 0       0 return $prec > $self->precedence ? "($result)" : $result;
80             }
81              
82             sub as_perl_regex {
83 0     0   0 my $self = shift;
84 0         0 croak "Not implemented for shuffled regexes";
85             }
86              
87             sub from_parse {
88 1347     1347   318012 my ($pkg, @item) = @_;
89 1347         3474 $pkg->new(@{$item[1]});
  1347         6419  
90             }
91              
92             sub as_pfa {
93 43     43   115 my $self = shift;
94 43         239 my @parts = map {$_->as_pfa} $self->members;
  88         437  
95 43         332 $parts[0]->shuffle(@parts[1 .. $#parts]);
96             }
97              
98             # Implement?
99             sub reverse {
100 0     0     my $self = shift;
101 0           croak "Not implemented for shuffled regexes";
102             }
103              
104             sub is_empty {
105 0     0     croak "Not implemented for shuffled regexes";
106             }
107              
108             sub has_nonempty_string {
109 0     0     croak "Not implemented for shuffled regexes";
110             }
111              
112             sub is_finite {
113 0     0     croak "Not implemented for shuffled regexes";
114             }