package HTML::Highlighter;

use strict;
use warnings;

use HTML::Parser;
use Plack::Request;
use Plack::Util::Accessor qw/param callback/;
use List::Util qw/first/;

use parent 'Plack::Middleware';

use 5.008_001;
our $VERSION = "0.03";
$VERSION = eval $VERSION;

sub call {
  my ($self, $env) = @_;

  my $res = $self->app->($env);

  $self->response_cb( $res, sub {
    my $res = shift;
    my $h = Plack::Util::headers($res->[1]);

    if ($h->get("Content-Type") =~ /html/i) {
      $self->callback->($env) if $self->callback;

      my $req = Plack::Request->new($env);
      $self->param("highlight") unless $self->param;;
      my $highlights = do {
        if ($env->{'psgix.highlight'}) {
          $env->{'psgix.highlight'};
        } else {
          my $param = first {$req->parameters->{$_}} ($self->param, qw/q query search/);
          $param ? $req->parameters->{$param} : undef;
        }
      };

      return $res unless $highlights;
      my @highlights = split /\s+/, $highlights;

      my $html;
      my $p = HTML::Parser->new(
        api_version => 3,
        handlers => {
          default => [
            sub {
              $html .= $_[0]
            }, "text"
          ],
          text => [
            sub {
              for my $highlight (@highlights) {
                $_[0] =~ s/($highlight)/<span class="highlight">$1<\/span>/gi;
              }
              $html .= $_[0]
            }, "text"
          ],
          end_document => [
            sub {
              $res->[2] = [$html];
              $h->set('Content-Length' => length $html)
            }
          ],
        }
      );

      my $done;

      return sub {
        my $chunk = shift;
        return if $done;

        if (defined $chunk) {
          $p->parse($chunk);
          return '';
        } else {
          $p->eof;
          $done = 1;
          return $html;
        }
      };
    }

    return $res;
  });
}

1;

__END__
=head1 NAME

HTML::Highlighter - PSGI middleware to highlight text in an HTML response

=head1 SYNOPSIS

    use Plack::Builder;
    use HTML::Highlighter;

    # highlight the "search" query param

    builder {
      enable "+HTML::Highlighter", param => "search";
      ...
      $app;
    };

    # or highlight the user stored in session

    builder {
      enable "+HTML::Highlighter", callback => sub {
        my $env = shift;
        $env->{'psgix.highlight'} = $env->{'psgix.session'}{user};
      };
      ...
      $app;
    };

=head1 DESCRIPTION

The C<HTML::Highlighter> module is a piece of PSGI middleware that
will inspect an HTML response and highlight parts of the page based
on a query parameter or other request data. This is very much like
what Google does when you load a page from their cache. Any text
that matches your original query is highlighted.

    <span class="highlight">[matching text]</span>

If no param or callback are provided to C<HTML::Highlighter>, it
will look for commonly used search parameters (e.g. q, query, search,
and highlight.)

This module also includes a javascript file called highlighter.js
which gives you a class with methods to jump (scroll) through the
highlights.

=head1 CONSTRUCTOR PARAMETERS

=over

=item B<param>

This option allows you to specify a query parameter to be used for
the highlighting. For example, if you specify "search" as the param,
each response will look for a query parameter called "search" will
highlight that value in the response.

=item B<callback>

This option lets you specify a function that will be called on each
request to generate the text used for highlighting. The function
will be passed the $env hashref, and should set 'psgix.highlight'
on it. This value will be used for the highlighting. This could be
useful if you want to highlight a username that is stored in a
session, or something similar.

=back

=head1 SEE ALSO

L<Plack::Builder>

L<HTML::Parser>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 Lee Aylward <leedo at cpan.org>, all rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 AUTHOR

Lee Aylward, <leedo@cpan.org>

=cut
