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