File Coverage

blib/lib/YAPE/Regex/Explain.pm
Criterion Covered Total %
statement 103 420 24.5
branch 44 248 17.7
condition 3 42 7.1
subroutine 9 31 29.0
pod 1 1 100.0
total 160 742 21.5


line stmt bran cond sub pod time code
1             package YAPE::Regex::Explain;
2              
3 3     3   78449 use YAPE::Regex 'YAPE::Regex::Explain';
  3         114333  
  3         25  
4 3     3   2769 use strict;
  3         4  
  3         107  
5 3     3   15 use vars '$VERSION';
  3         10  
  3         19116  
6              
7              
8             $VERSION = '4.01';
9              
10              
11             my $exp_format = << 'END';
12             ^<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
13             END
14              
15             my $REx_format = << 'END';
16             ^<<<<<<<<<<<<<<<<<<<<< # ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
17             END
18              
19             my $noc_format = << 'END';
20             ^<<<<<<<<<<<<<<<<<<<<<
21             END
22              
23             my ($using_rex,$format,$br);
24              
25              
26             my $valid_POSIX = qr{
27             alpha | alnum | ascii | cntrl | digit | graph |
28             lower | print | punct | space | upper | word | xdigit
29             }x;
30              
31              
32             my $cc_REx = qr{(
33             \\[0-3][0-7]{2} |
34             \\x[a-fA-F0-9]{2} |
35             \\x\{[a-fA-F0-9]+\} |
36             \\c. |
37             \\[nrftbae] |
38             \\N\{([^\}]+)\} |
39             \\[wWdDsS] |
40             \\([Pp])([A-Za-z]|\{[^\}]+\}) |
41             \[:(\^?)($valid_POSIX):\] |
42             \\?.
43             )}xs;
44              
45              
46             my %modes = ( on => '', off => '' );
47              
48             my %exp = (
49              
50             # anchors
51             '\A' => 'the beginning of the string',
52             '^' => 'the beginning of the string',
53             '^m' => 'the beginning of a "line"',
54             '\z' => 'the end of the string',
55             '\Z' => 'before an optional \n, and the end of the string',
56             '$' => 'before an optional \n, and the end of the string',
57             '$m' => 'before an optional \n, and the end of a "line"',
58             '\G' => 'where the last m//g left off',
59             '\b' => 'the boundary between a word char (\w) and something ' .
60             'that is not a word char',
61             '\B' => 'the boundary between two word chars (\w) or two ' .
62             'non-word chars (\W)',
63            
64             # quantifiers
65             '*' => '0 or more times',
66             '+' => '1 or more times',
67             '?' => 'optional',
68            
69             # macros
70             '\w' => 'word characters (a-z, A-Z, 0-9, _)',
71             '\W' => 'non-word characters (all but a-z, A-Z, 0-9, _)',
72             '\d' => 'digits (0-9)',
73             '\D' => 'non-digits (all but 0-9)',
74             '\s' => 'whitespace (\n, \r, \t, \f, and " ")',
75             '\S' => 'non-whitespace (all but \n, \r, \t, \f, and " ")',
76              
77             # dot
78             '.' => 'any character except \n',
79             '.s' => 'any character',
80              
81             # alt
82             '|' => "OR",
83              
84             # flags
85             'i' => 'case-insensitive',
86             '-i' => 'case-sensitive',
87             'm' => 'with ^ and $ matching start and end of line',
88             '-m' => 'with ^ and $ matching normally',
89             's' => 'with . matching \n',
90             '-s' => 'with . not matching \n',
91             'x' => 'disregarding whitespace and comments',
92             '-x' => 'matching whitespace and # normally',
93              
94             );
95              
96              
97             my %macros = (
98             # utf8/POSIX macros
99             alpha => 'letters',
100             alnum => 'letters and digits',
101             ascii => 'all ASCII characters (\000 - \177)',
102             cntrl => 'control characters (those with ASCII values less than 32)',
103             digit => 'digits (like \d)',
104             graph => 'alphanumeric and punctuation characters',
105             lower => 'lowercase letters',
106             print => 'alphanumeric, punctuation, and whitespace characters',
107             punct => 'punctuation characters',
108             space => 'whitespace characters (like \s)',
109             upper => 'uppercase letters',
110             word => 'alphanumeric and underscore characters (like \w)',
111             xdigit => 'hexadecimal digits (a-f, A-F, 0-9)',
112             );
113              
114              
115             my %trans = (
116             '\a' => q('\a' (alarm)),
117             '\b' => q('\b' (backspace)),
118             '\e' => q('\e' (escape)),
119             '\f' => q('\f' (form feed)),
120             '\n' => q('\n' (newline)),
121             '\r' => q('\r' (carriage return)),
122             '\t' => q('\t' (tab)),
123             );
124              
125              
126             sub explain {
127 3     3 1 237 my $self = shift;
128 3   100     17 $using_rex = shift || '';
129 3         7 my $stat = @{[ $self->parse ]};
  3         29  
130 3         6208 local $^A = "";
131 3 100       15 $^A = << "END" if not $using_rex;
132             The regular expression:
133              
134 1         10 @{[ $self->display ]}
135              
136             matches as follows:
137            
138             NODE EXPLANATION
139             ----------------------------------------------------------------------
140             END
141            
142 3         126 my @nodes = @{ $self->{TREE} };
  3         10  
143 3 100       27 $format =
    100          
144             $using_rex eq 'silent' ? $noc_format :
145             $using_rex eq 'regex' ? $REx_format :
146             $exp_format;
147              
148 3         20 while (my $node = shift @nodes) {
149 3         14 $node->explanation;
150             }
151            
152 3         8 ($using_rex,$br) = (0,0);
153 3         11 %modes = ( on => '', off => '' );
154              
155 3         13 return $^A;
156             }
157              
158              
159             sub YAPE::Regex::Explain::Element::extra_info {
160 9     9   14 my $self = shift;
161 9         62 my ($q,$ng) = ($self->quant, $self->ngreed);
162 9         96 my $ex = '';
163              
164 9 50       74 chop $q if $ng;
165 9 50       24 if ($q =~ /\{(\d*)(,?(\d*))\}/) {
166 0 0 0     0 if ($2 and length $3) { $q = "between $1 and $3 times" }
  0 0       0  
    0          
167 0         0 elsif ($2) { $q = "at least $1 times" }
168 0         0 elsif (length $1) { $q = "$1 times" }
169             }
170              
171 9 100       27 if ($q) {
172 3   33     21 $ex .= ' (' . ($exp{$q} || $q);
173 3 50       25 $ex .= ' (matching the ' . ($ng ? 'lea' : 'mo') . 'st amount possible)'
    50          
174             if $q !~ /^\d+ times$/;
175 3 50       12 $ex .= ')' if $q;
176             }
177              
178 9         32 return $ex;
179             }
180              
181              
182             # yes, I'm sure this could be made a bit more efficient...
183             # but I'll deal with the small fish when the big fish are fried
184              
185             sub YAPE::Regex::Explain::Element::handle_flags {
186 3     3   6 my $self = shift;
187 3         13 my ($prev_on, $prev_off) = @modes{qw( on off )};
188            
189 3         13 for (split //, $self->{ON}) {
190 2 50       16 $modes{on} .= $_ if index($modes{on},$_) == -1;
191             }
192 3         16 my $on = $modes{on} = join "", sort split //, $modes{on};
193              
194 3 100       34 $modes{off} =~ s/[$on]+//g if length $on;
195              
196 3         13 for (split //, $self->{OFF}) {
197 10 50       45 $modes{off} .= $_ if index($modes{off},$_) == -1;
198             }
199 3         19 my $off = $modes{off} = join "", sort split //, $modes{off};
200              
201 3 50       49 $modes{on} =~ s/[$off]+//g if length $off;
202              
203 3         9 my $exp = '';
204              
205 3 100       33 if ($modes{on} ne $prev_on) {
206 2         8 for (split //, $modes{on}) { $exp .= ' (' . $exp{$_} . ')' }
  2         10  
207             }
208            
209 3 50       14 if ($modes{off} ne $prev_off) {
210 3         10 for (split //, $modes{off}) { $exp .= ' (' . $exp{-$_} . ')' }
  10         35  
211             }
212              
213 3         37 return $exp;
214             }
215              
216              
217             sub YAPE::Regex::Explain::anchor::explanation {
218 0     0   0 my $self = shift;
219 0         0 my $type = $self->{TEXT};
220 0 0 0     0 $type .= 'm' if
      0        
221             ($type eq '^' or $type eq '$') and
222             $modes{on} =~ /m/;
223              
224 0         0 my $explanation = $exp{$type} . $self->extra_info;
225 0         0 my $string = $self->string;
226            
227 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) }
  0         0  
  0         0  
228 0 0       0 $^A .= ($using_rex ? '' : '-' x 70) . "\n";
229             }
230              
231              
232             sub YAPE::Regex::Explain::macro::explanation {
233 3     3   5 my $self = shift;
234 3         49 my $type = $self->text;
235              
236 3         33 my $explanation = $exp{$type} . $self->extra_info;
237 3         19 my $string = $self->string;
238            
239 3 100       32 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  2 100       30  
  1         10  
  3         21  
240             }
241              
242              
243             sub YAPE::Regex::Explain::oct::explanation {
244 0     0   0 my $self = shift;
245 0         0 my $n = oct($self->{TEXT});
246              
247 0         0 my $explanation = "character $n" . $self->extra_info;
248 0         0 my $string = $self->string;
249            
250 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
251             }
252              
253              
254             sub YAPE::Regex::Explain::hex::explanation {
255 0     0   0 my $self = shift;
256 0         0 my $n = hex($self->{TEXT});
257              
258 0         0 my $explanation = "character $n" . $self->extra_info;
259 0         0 my $string = $self->string;
260            
261 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
262             }
263              
264              
265             sub YAPE::Regex::Explain::utf8hex::explanation {
266 0     0   0 my $self = shift;
267 0         0 my $n = hex($self->{TEXT});
268              
269 0         0 my $explanation = "UTF character $n" . $self->extra_info;
270 0         0 my $string = $self->string;
271            
272 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
273             }
274              
275              
276             sub YAPE::Regex::Explain::ctrl::explanation {
277 0     0   0 my $self = shift;
278 0         0 my $c = $self->{TEXT};
279              
280 0         0 my $explanation = "^$c" . $self->extra_info;
281 0         0 my $string = $self->string;
282            
283 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
284             }
285              
286              
287             sub YAPE::Regex::Explain::named::explanation {
288 0     0   0 my $self = shift;
289 0         0 my $c = $self->{TEXT};
290              
291 0         0 my $explanation = "the character named '$c'" . $self->extra_info;
292 0         0 my $string = $self->string;
293            
294 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
295             }
296              
297              
298             sub YAPE::Regex::Explain::Cchar::explanation {
299 0     0   0 my $self = shift;
300 0         0 my $c = $self->{TEXT};
301              
302 0         0 my $explanation = "one byte (a C character)" . $self->extra_info;
303 0         0 my $string = $self->string;
304            
305 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
306             }
307              
308              
309             sub YAPE::Regex::Explain::slash::explanation {
310 0     0   0 my $self = shift;
311              
312 0   0     0 my $explanation =
313             ($trans{$self->text} || "'$self->{TEXT}'") .
314             $self->extra_info;
315 0         0 my $string = $self->string;
316            
317 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
318             }
319              
320              
321             sub YAPE::Regex::Explain::any::explanation {
322 0     0   0 my $self = shift;
323 0         0 my $type = '.';
324 0 0       0 $type .= 's' if $modes{on} =~ /s/;
325              
326 0         0 my $explanation = $exp{$type} . $self->extra_info;
327 0         0 my $string = $self->string;
328            
329 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
330             }
331              
332              
333             sub YAPE::Regex::Explain::text::explanation {
334 3     3   6 my $self = shift;
335 3         31 my $text = $self->text;
336            
337 3         41 $text =~ s/\n/\\n/g;
338 3         8 $text =~ s/\r/\\r/g;
339 3         7 $text =~ s/\t/\\t/g;
340 3         6 $text =~ s/\f/\\f/g;
341 3         6 $text =~ s/'/\\'/g;
342            
343 3         26 my $explanation = "'$text'" . $self->extra_info;
344 3         26 my $string = $self->string;
345              
346 3 100       30 if ($using_rex) {
347 2         5 $string =~ s/\n/\\n/g;
348 2         4 $string =~ s/\r/\\r/g;
349 2         3 $string =~ s/\t/\\t/g;
350 2         5 $string =~ s/\f/\\f/g;
351 2         4 $string =~ s/([ #])/\\$1/g;
352             }
353              
354 3 100       11 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  2 100       18  
  1         6  
  3         39  
355             }
356              
357              
358             sub YAPE::Regex::Explain::alt::explanation {
359 0     0   0 my $self = shift;
360              
361 0         0 my $explanation = $exp{'|'};
362 0         0 my $string = $self->string;
363            
364 0         0 my $oldfmt = $format;
365 0         0 $format =~ s/ (\^<+)/$1 /g;
366 0 0       0 $format =~ s/ #/# / if $using_rex;
367 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
368 0         0 $format = $oldfmt;
369              
370             }
371              
372              
373             sub YAPE::Regex::Explain::backref::explanation {
374 0     0   0 my $self = shift;
375              
376 0         0 my $explanation =
377             "what was matched by capture \\$self->{TEXT}" . $self->extra_info;
378 0         0 my $string = $self->string;
379            
380 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
381             }
382              
383              
384             sub YAPE::Regex::Explain::class::explanation {
385 0     0   0 my $self = shift;
386 0         0 my $class = $self->{TEXT};
387 0 0       0 $class = $self->text if $self->{NEG} =~ /[pP]/;
388              
389 0         0 my $explanation = "any character ";
390 0 0       0 $explanation .= ($self->{NEG} eq '^') ? "except: " : "of: ";
391              
392 0         0 while ($class =~ s/^$cc_REx//) {
393 0         0 my ($c1, $name, $pP, $utf8, $neg, $posix) = ($1,$2,$3,$4,$5,$6);
394            
395 0 0       0 if ($name) {
    0          
    0          
396 0         0 $explanation .= qq{the character named "$name"};
397             }
398            
399             elsif ($utf8) {
400 0         0 $utf8 =~ tr/{}//d;
401 0         0 (my $nice = $utf8) =~ s/^Is//;
402              
403 0   0     0 my $add =
      0        
404             ($pP eq 'P' and "anything but ") .
405             ($macros{lc $nice} || "UTF macro '$utf8'");
406 0 0       0 $add =~ s/\\([wds])/\\\U$1/ if $pP eq 'P';
407 0         0 $explanation .= $add;
408             }
409            
410             elsif ($posix) {
411 0   0     0 my $add = ($neg and "anything but ") . $macros{lc $posix};
412 0 0       0 $add =~ s/\\([wds])/\\\U$1/ if $neg;
413 0         0 $explanation .= $add;
414             }
415            
416             else {
417 0   0     0 $explanation .= (
418             $trans{$c1} ||
419             ($c1 =~ /\\[wWdDsS]/ and $exp{$c1}) ||
420             "'$c1'"
421             );
422             }
423              
424 0 0 0     0 if (!$utf8 and !$posix and $c1 !~ /\\[wWdDsS]/ and $class =~ s/^-$cc_REx//) {
      0        
425 0         0 my ($c2, $name, $pP, $utf8, $neg, $posix) = ($1,$2,$3,$4,$5,$6);
426              
427 0 0 0     0 $class = "-$c2", next if $utf8 or $posix or $c2 =~ /\\[wWdDsS]/;
      0        
428              
429 0 0       0 if ($name) {
430 0         0 $explanation .= qq{ to the character named "$name"};
431             }
432             else {
433 0   0     0 $explanation .= ' to ' . ($trans{$c2} || "'$c2'");
434             }
435             }
436 0         0 $explanation .= ', ';
437              
438             }
439              
440 0         0 substr($explanation,-2) = $self->extra_info;
441 0         0 my $string = $self->string;
442            
443 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
444             }
445              
446              
447 0     0   0 sub YAPE::Regex::Explain::comment::explanation { }
448              
449              
450 0     0   0 sub YAPE::Regex::Explain::whitespace::explanation { }
451              
452              
453             sub YAPE::Regex::Explain::flags::explanation {
454 0     0   0 my $self = shift;
455 0 0       0 if ($using_rex) {
456 0 0       0 $self->{ON} .= 'x' if $self->{ON} !~ /x/;
457 0         0 $self->{OFF} =~ s/x//;
458             }
459 0         0 my $string = $self->string;
460 0         0 my $explanation =
461             'set flags for this block' .
462             $self->handle_flags;
463              
464 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
465             }
466              
467              
468             sub YAPE::Regex::Explain::code::explanation {
469 0     0   0 my $self = shift;
470 0         0 my $string = $self->string;
471 0         0 my $explanation = 'run this block of Perl code';
472              
473 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
474             }
475              
476              
477             sub YAPE::Regex::Explain::later::explanation {
478 0     0   0 my $self = shift;
479 0         0 my $string = $self->string;
480 0         0 my $explanation = 'run this block of Perl code (that isn\'t interpolated until RIGHT NOW)';
481              
482 0 0       0 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0       0  
  0         0  
  0         0  
483             }
484              
485              
486             sub YAPE::Regex::Explain::group::explanation {
487 3     3   8 my $self = shift;
488 3 100       9 if ($using_rex) {
489 2 50       11 $self->{ON} .= 'x' if $self->{ON} !~ /x/;
490 2         8 $self->{OFF} =~ s/x//;
491             }
492 3         29 my $explanation =
493             'group, but do not capture' .
494             $self->handle_flags .
495             $self->extra_info .
496             ":";
497 3         25 my $string = $self->string;
498            
499 3 100       29 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  2 100       61  
  1         14  
  3         18  
500              
501 3         15 my %old = %modes;
502              
503 3         7 my $oldfmt = $format;
504 3         44 $format =~ s/\^<<(<+)/ ^$1/g;
505 3 100       13 $format =~ s/# / #/ if $using_rex;
506 3         7 $_->explanation for @{ $self->{CONTENT} };
  3         17  
507 3         9 $format = $oldfmt;
508            
509 3         12 $string = ')' . $self->quant;
510 3         13 $explanation = 'end of grouping';
511              
512 3         20 %modes = %old;
513            
514 3 100       10 if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  2 100       28  
  1         5  
  3         25  
515             }
516              
517              
518             sub YAPE::Regex::Explain::capture::explanation {
519 0     0     my $self = shift;
520 0           my $explanation =
521             'group and capture to \\' .
522             ++$br .
523             $self->extra_info .
524             ":";
525 0           my $string = $self->string;
526            
527 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
528              
529 0           my %old = %modes;
530 0           my $old_br = $br;
531              
532 0           my $oldfmt = $format;
533 0           $format =~ s/\^<<(<+)/ ^$1/g;
534 0 0         $format =~ s/# / #/ if $using_rex;
535 0           $_->explanation for @{ $self->{CONTENT} };
  0            
536 0           $format = $oldfmt;
537 0           $string = ')' . $self->quant;
538 0           $explanation = "end of \\$old_br";
539              
540 0 0         $explanation .= << "END" if $self->quant;
541             (NOTE: because you are using a quantifier on this capture, only the LAST
542             repetition of the captured pattern will be stored in \\$old_br)
543             END
544              
545 0           %modes = %old;
546            
547 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
548             }
549              
550              
551             sub YAPE::Regex::Explain::cut::explanation {
552 0     0     my $self = shift;
553 0           my $explanation =
554             'match (and do not backtrack afterwards)' .
555             $self->extra_info .
556             ":";
557 0           my $string = $self->string;
558            
559 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
560              
561 0           my %old = %modes;
562              
563 0           my $oldfmt = $format;
564 0           $format =~ s/\^<<(<+)/ ^$1/g;
565 0 0         $format =~ s/# / #/ if $using_rex;
566 0           $_->explanation for @{ $self->{CONTENT} };
  0            
567 0           $format = $oldfmt;
568 0           $string = ')' . $self->quant;
569            
570 0           $explanation = 'end of look-ahead';
571              
572 0           %modes = %old;
573            
574 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
575             }
576              
577              
578             sub YAPE::Regex::Explain::lookahead::explanation {
579 0     0     my $self = shift;
580              
581 0 0         if (not @{ $self->{CONTENT} }) {
  0            
582 0 0         my $explanation =
583             ($self->{POS} ? 'succeed' : 'fail') .
584             $self->extra_info;
585 0           my $string = $self->fullstring;
586            
587 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
588 0           return;
589             }
590              
591 0 0         my $explanation =
592             'look ahead to see if there is' .
593             ($self->{POS} ? '' : ' not') .
594             $self->extra_info .
595             ":";
596 0           my $string = $self->string;
597            
598 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
599              
600 0           my %old = %modes;
601              
602 0           my $oldfmt = $format;
603 0           $format =~ s/\^<<(<+)/ ^$1/g;
604 0 0         $format =~ s/# / #/ if $using_rex;
605 0           $_->explanation for @{ $self->{CONTENT} };
  0            
606 0           $format = $oldfmt;
607 0           $string = ')' . $self->quant;
608 0           $explanation = 'end of look-ahead';
609              
610 0           %modes = %old;
611            
612 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
613             }
614              
615              
616             sub YAPE::Regex::Explain::lookbehind::explanation {
617 0     0     my $self = shift;
618 0 0         my $explanation =
619             'look behind to see if there is' .
620             ($self->{POS} ? '' : ' not') .
621             $self->extra_info .
622             ":";
623 0           my $string = $self->string;
624            
625 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
626              
627 0           my %old = %modes;
628              
629 0           my $oldfmt = $format;
630 0           $format =~ s/\^<<(<+)/ ^$1/g;
631 0 0         $format =~ s/# / #/ if $using_rex;
632 0           $_->explanation for @{ $self->{CONTENT} };
  0            
633 0           $format = $oldfmt;
634 0           $string = ')' . $self->quant;
635 0           $explanation = 'end of look-behind';
636              
637 0           %modes = %old;
638            
639 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
640             }
641              
642              
643             sub YAPE::Regex::Explain::conditional::explanation {
644 0     0     my $self = shift;
645 0           my ($string,$explanation);
646            
647 0 0         if (ref $self->{CONTENT}) {
648 0           $string = '(?';
649 0           $explanation =
650             'if the following assertion is true' .
651             $self->extra_info .
652             ":";
653 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) }
  0            
  0            
654 0 0         $^A .= ($using_rex ? '' : '-' x 70) . "\n";
655              
656 0           my $oldfmt = $format;
657 0           $format =~ s/\^<<(<+)/ ^$1/g;
658 0 0         $format =~ s/# / #/ if $using_rex;
659 0           $self->{CONTENT}[0]->explanation;
660              
661 0           $format =~ s/ (\^<+)/$1 /g;
662 0 0         $format =~ s/ #/# / if $using_rex;
663            
664 0           $explanation = 'then:';
665 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) }
  0            
  0            
666 0 0         $^A .= ($using_rex ? '' : '-' x 70) . "\n";
667            
668 0           $format = $oldfmt;
669             }
670             else {
671 0           $string = $self->string;
672 0           $explanation =
673             "if back-reference \\$self->{CONTENT} matched, then" .
674             $self->extra_info .
675             ":";
676 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) }
  0            
  0            
677 0 0         $^A .= ($using_rex ? '' : '-' x 70) . "\n";
678             }
679            
680 0           my %old = %modes;
681              
682 0           my $oldfmt = $format;
683 0           $format =~ s/\^<<(<+)/ ^$1/g;
684 0 0         $format =~ s/# / #/ if $using_rex;
685              
686 0           $_->explanation for @{ $self->{TRUE} };
  0            
687              
688 0 0         unless (@{ $self->{TRUE} }) {
  0            
689 0           my $string = "";
690 0           my $explanation = 'succeed';
691 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) }
  0            
  0            
692 0 0         $^A .= ($using_rex ? '' : '-' x 70) . "\n";
693             }
694              
695             {
696 0           my $oldfmt = $format;
  0            
697              
698 0           $format =~ s/ (\^<+)/$1 /g;
699 0 0         $format =~ s/ #/# / if $using_rex;
700            
701 0           my $string = "|";
702 0           my $explanation = 'else:';
703 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) }
  0            
  0            
704 0 0         $^A .= ($using_rex ? '' : '-' x 70) . "\n";
705              
706 0           $format = $oldfmt;
707             }
708            
709 0           $_->explanation for @{ $self->{FALSE} };
  0            
710              
711 0 0         if (not @{ $self->{FALSE} }) {
  0            
712 0           my $string = "";
713 0           my $explanation = 'succeed';
714 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) }
  0            
  0            
715 0 0         $^A .= ($using_rex ? '' : '-' x 70) . "\n";
716             }
717              
718 0           $format = $oldfmt;
719 0           $string = ')' . $self->quant;
720 0 0         $explanation =
721             "end of conditional" .
722             (ref $self->{CONTENT} ? '' : " on \\$self->{CONTENT}");
723              
724 0           %modes = %old;
725            
726 0 0         if ($using_rex ne 'silent') { formline($format, $string, $explanation) while length($string . $explanation) } else { formline($format, $string) while length($string) } $^A .= ($using_rex ? '' : '-' x 70) . "\n";
  0 0          
  0            
  0            
727             }
728              
729              
730             1;
731              
732              
733             =head1 NAME
734              
735             YAPE::Regex::Explain - explanation of a regular expression
736              
737             =head1 VERSION
738              
739             This document refers to YAPE::Regex::Explain version 4.01.
740              
741             =head1 SYNOPSIS
742              
743             use YAPE::Regex::Explain;
744             my $exp = YAPE::Regex::Explain->new($REx)->explain;
745              
746             =head1 C MODULES
747              
748             The C hierarchy of modules is an attempt at a unified means of parsing
749             and extracting content. It attempts to maintain a generic interface, to
750             promote simplicity and reusability. The API is powerful, yet simple. The
751             modules do tokenization (which can be intercepted) and build trees, so that
752             extraction of specific nodes is doable.
753              
754             =head1 DESCRIPTION
755              
756             This module merely sub-classes C, and produces a rather verbose
757             explanation of a regex, suitable for demonstration and tutorial purposes.
758              
759             =head2 Methods for C
760              
761             =over 4
762              
763             =item * Cnew($regex);>
764              
765             Calls C's C method (see its docs).
766              
767             =item * Cexplain($mode);>
768              
769             Returns a string explaining the regex. While not required for all regexes,
770             it is sometimes necessary to compile the regex using the C operator
771             before passing it to the C method.
772             If C<$mode> is C, it will output
773             a valid regex (instead of the normal string). If C<$mode> is C, no
774             comments will be added, but the regex will be expanded into a readable format.
775              
776             =back
777              
778             =head1 EXAMPLES
779              
780             Print the full explanation for the regex C<\Q[abc]\E\d+>, compiling it first:
781              
782             print YAPE::Regex::Explain->new(qr/\Q[abc]\E\d+/)->explain();
783              
784             Print the explanation for the regex C<\w[a-f]*>, without comments:
785              
786             print YAPE::Regex::Explain->new('\w[a-f]*')->explain('silent');
787              
788             Print the explanation for a multi-line regex:
789              
790             my $re = qr{
791             (foo|bar) # just a comment
792             \d+
793             /
794             }ix;
795             print YAPE::Regex::Explain->new($re)->explain();
796              
797             =head1 LIMITATIONS
798              
799             There is no support for regular expression syntax added after Perl
800             version 5.6, particularly any constructs added in 5.10. For
801             examples, refer to:
802              
803             L
804              
805             =head1 DEPENDENCIES
806              
807             L
808              
809             =head1 AUTHOR
810              
811             The original author is Jeff "japhy" Pinyan (CPAN ID: PINYAN).
812              
813             Gene Sullivan (gsullivan@cpan.org) is a co-maintainer.
814              
815             =head1 LICENSE
816              
817             This module is free software; you can redistribute it and/or modify
818             it under the same terms as Perl itself. See L.
819              
820             =cut
821              
822