File Coverage

blib/lib/Regexp/HTMLify.pm

Criterion	Covered	Total	%
statement	78	81	96.3
branch	22	34	64.7
condition	5	7	71.4
subroutine	11	11	100.0
pod	0	3	0.0
total	116	136	85.2

# Regexp::HTMLify.pm

# Copyright (c) 2008-2011 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.002 $ =~ 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';

  local $_;

  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';

  local $_;

  # perl 5.12 qr((.)) => '(?-xism:(.))'
  # perl 5.14 qr((.)) => '(?:(.))'

  # 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';

  local $_;

  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 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;


=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-2011 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__