# Regexp::HTMLify.pm # Copyright (c) 2008 Niels van Dijke http://PerlBoy.net # All rights reserved. This program is free software. # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. package Regexp::HTMLify; require 5.008002; require Exporter; use vars qw(@ISA @EXPORT); use strict; use Carp 'croak'; use CGI qw/:standard/; use vars qw($VERSION); $VERSION = sprintf('%d.%03d', q$Revision: 0.1 $ =~ m#(\d+)\.(\d+)#); use vars qw($MAXCOLORS $CSS_COLORMAP); ############################################################################### # prototypes ############################################################################### sub HTMLifyGetColormapCSS (;$$); sub HTMLifyRE ($;\@$$); sub HTMLifyREmatches ($;\@$$); @ISA = qw(Exporter); @EXPORT = qw( HTMLifyGetColormapCSS HTMLifyRE HTMLifyREmatches ); sub HTMLifyGetColormapCSS (;$$) { my $fHandle = $_[0]; my $prefix = defined($_[1]) ? $_[1] : 'cDef'; if (!defined $fHandle) { if (!defined $CSS_COLORMAP) { $fHandle = *Regexp::HTMLify::DATA; } else { # hide $CSS_COLORMAP and return cached version return $CSS_COLORMAP; } } my @colorMap = <$fHandle>; map { $MAXCOLORS++ if (/^\s*\.$prefix(\d+)\s*{/ and $1 > 0) } @colorMap; $CSS_COLORMAP = join('',@colorMap); return $CSS_COLORMAP; } sub _init { return HTMLifyGetColormapCSS() ne ''; } # sub HTMLifyRE ($RegExp,[\@variables,$startColorIndex,$templateClass]) sub HTMLifyRE ($;\@$$) { my $re = shift; my $varnames = shift || []; my $startColorIndex = defined $_[0] ? $_[0] : 1; my $cssClass = defined $_[1] ? $_[1] : 'cDef'; # No support for code execution in regexp no re 'eval'; eval { my $tmpRe = qr($re)}; if ($@) { croak("HTMLifyRE('\$regexp') => $@\n"); } # Check whether we support the given regexp if ($re =~ m#\)[*+?{]#sm) { croak("HTMLre: Unsupported regexp (backref quantifiers)"); } if ($re =~ m#\(\?\|#sm) { croak("HTMLre: Unsupported regexp (branch reset (v5.10.x and higher))"); } my $i = 1; my @brStack = ('('); my $ret; # find first 'real' (non escaped) '(' or ')' while ($re =~ m#^(.*?)(?!\\)([()])(.*)#sm) { my ($pre,$br,$post) = ($1,$2,$3); $ret .= escapeHTML($pre); #print STDERR scalar(@brStack)."($brStack[-1]) [".join("] [",$pre,$br,$post)."]
\n"; if ($br eq '(') { # a bracket which creates a capture buffer? #(capture buffer: $1, $2, etc. or \g{1}, \g{2} etc. in Perl v5.10.x) if ($post =~ m#^[\?\*]#) { push(@brStack,''); $ret .= '('; } else { my $title = defined $varnames->[$i-1] ? qq(title="$varnames->[$i-1]") : ''; my $cdef = ($startColorIndex - 1 + (13 * $i++) % $MAXCOLORS) + 1; $ret .= qq[(]; push(@brStack,'('); } } else { $br = pop(@brStack); if ($br eq '(') { $ret .= ')'; } else { $ret .= ')'; } } $re = $post; } $ret .= escapeHTML($re); return $ret; } # sub HTMLifyREmatches ($var,\@variables[,$startColorIndex,$cssClass]) sub HTMLifyREmatches ($;\@$$) { my $var = shift; my $varnames = shift || []; my $startColorIndex = defined $_[0] ? $_[0] : 1; my $cssClass = defined $_[1] ? $_[1] : 'cDef'; my @c = split(//,$var); for (my $i = 1; $i < scalar(@-); $i++) { next if !defined $-[$i]; my $title = defined $varnames->[$i-1] ? qq(title="$varnames->[$i-1]") : ''; my $cdef = ($startColorIndex - 1 + (13 * $i) % $MAXCOLORS) + 1; $c[$-[$i]] = qq[$c[$-[$i]]]; $c[$+[$i]-1] .= ''; } return join('',@c); } _init(); =head1 NAME Regexp::HTMLify - Highlight regular expression capture buffers and matches using HTML and CSS =head1 SYNOPSIS use CGI qw/:standard/; use Regexp::HTMLify; my $re = qr((?i)(This) (?!and not that )(will match)); my $match = 'This will match'; my @titles = qw(this matches); print start_html('A simple example of Regexp::HTMLify'), HTMLifyGetColormapCSS(), p('Regexp: ',HTMLifyRE($re,@titles)); if ($match =~ m#$re#) { print p('MATCH :',HTMLifyREmatches($match,@titles)); } else { print p('NO match'); } print end_html; =begin html

The above example will produce the following HTML:

Regexp: (?-xism:(?i)(This) (?!and not that )(will match))

MATCH : This will match

=end html =head1 DESCRIPTION This library offers (limited, see below) functionality to highlight regular expression capture buffers using HTML and CSS. =head1 LIMITATIONS This library has the following limitations: =over =item * No support for code execution within regexp; B<(?{....})> =item * No support for regexp capture buffer quantifiers; =over =item * (...)B<*> =item * (...)B<+> =item * (...)B =item * (...)B<{n}> =item * (...)B<{n,}> =item * (...)B<{n,m}> =back =back =head1 AUTHOR Niels van Dijke =head1 TODO =over =item * Speedup of HTMLifyREmatches() =item * Work on capture buffer quantifier limitations =item * Add support for backrefs (\1, \2 and Perl v5.10.x \g{1}, \g{2}) =item * Add more 'real life' tests and/or examples =item * Enhance documentation instead of RTFS (read the fine source) =back =head1 NOTES This is alpha code and not extensively tested. Use with care! =head1 COPYRIGHT Copyright (c) 2008 Niels van Dijke L L All rights reserved. This program is free software. You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. =cut __DATA__