package HTML::Template::Filters;

use strict;
use warnings;
use Exporter;
use Carp;
use vars qw(@ISA @EXPORT);
our $VERSION = '0.01';

@ISA = qw(Exporter);
@EXPORT = qw(
  HT_FILTER_ALLOW_TRAILING_SLASH
  HT_FILTER_SSI_INCLUDE_VIRTUAL
  HT_FILTER_TMPL_COMMENT
  HT_FILTER_TMPL_FIXME
  HT_FILTER_TMPL_SET
);

use constant HT_FILTER_ALLOW_TRAILING_SLASH => 'allow_trailing_slash';
use constant HT_FILTER_SSI_INCLUDE_VIRTUAL => 'ssi_include_virtual';
use constant HT_FILTER_TMPL_COMMENT => 'tmpl_comment';
use constant HT_FILTER_TMPL_FIXME => 'tmpl_fixme';
use constant HT_FILTER_TMPL_SET => 'tmpl_set';

#
# Example: get_filters(HT_FILTER_ALLOW_TRAILING_SLASH,HT_FILTER_TMPL_COMMENT);
#
sub get_filters {
  croak "Invalid arguments to HTML::Template::Filters->get_filters()" unless (@_ > 1);
  my $pkg = shift;
  my @wanted_filters = @_;

  # get the requested filters
  my @filter_subs;
  foreach (@wanted_filters) {
    next unless defined and length;
    croak "Unknown filter: $_" unless ($pkg->can($_));
    my $filter = $pkg->$_();
    push @filter_subs, {
      'sub' => $filter,
      'format' => 'scalar',
    };
  }

  return \@filter_subs;
}

#
# allow trailing slash in <TMPL_xxx /> tags
#
sub allow_trailing_slash {
  my $filter = sub {
    my $text_ref = shift;
    my $match = '(<tmpl_[^>]+)/>';
    $$text_ref =~ s/$match/$1>/ig;
  };
  return $filter;
}

#
# Translate the SSI "include virtual" into a template include:
#
sub ssi_include_virtual {
  my $filter = sub {
    my $text_ref = shift;
    my $match = '<!--\s*#include virtual="[\/]?(.+?)"\s*-->';
    $$text_ref =~ s/$match/<TMPL_INCLUDE NAME="$1">/ig;
  };
  return $filter;
}

#
# strip out <TMPL_COMMENT>...</TMPL_COMMENT> entries
#
sub tmpl_comment {
  my $filter = sub {
    my $text_ref = shift;
    my $match  = '<(?:\!--\s*)?tmpl_comment\s*(?:--)?>.*?<(?:\!--\s*)?/tmpl_comment\s*(?:--)?>';
    $$text_ref  =~ s/$match//igs;
  };
  return $filter;
}

#
# strip out <TMPL_FIXME>...</TMPL_FIXME> entries
#
sub tmpl_fixme {
  my $filter = sub {
    my $text_ref = shift;
    my $match  = '<(?:\!--\s*)?tmpl_fixme\s*(?:--)?>.*?<(?:\!--\s*)?/tmpl_fixme\s*(?:--)?>';
    $$text_ref  =~ s/$match//igs;
  };
  return $filter;
}

#
# allow <TMPL_SET NAME="variable" VALUE="value">
# note this only works for TMPL_VAR's
#
sub tmpl_set {
  my $filter = sub {
    my $text_ref = shift;
    my $match = '<(?:\!--\s*)?tmpl_set\s*name=(.*?)\s*value=(.*?)\s*(?:--)?>';
    my @taglist = $$text_ref =~ m/$match/ig;
    return unless (@taglist > 0);
    my %set_params;
    while (@taglist) {
      my ($t,$v) = (shift @taglist,shift @taglist);
      $set_params{$t} = $v;
    }
    $$text_ref =~ s/$match//ig;
    my @chunks = split (/(?=<(?:\!--\s*)?[Tt][Mm][Pp][Ll]_[Vv][Aa][Rr]\s+)/, $$text_ref);
    return unless (@chunks > 0);
    my @output;
    foreach (@chunks) {
      if (/^(?=
               <(?:!--\s*)?
                [Tt][Mm][Pp][Ll]_[Vv][Aa][Rr]\s+(?:[Nn][Aa][Mm][Ee]\s*=\s*)?
                (?:
                  "([^">]*)"
                  |
                  '([^'>]*)'
                  |
                  ([^\s=>]*)
                )
                \s*(?:[^>])?(?:--)?>
                (.*)
             )/sx) {
        my $name = defined $1 ? $1 : defined $2 ? $2 : defined $3 ? $3 : undef;
        if (defined $name and exists $set_params{$name}) {
          $_ = $set_params{$name};
          $_ .= $4 if $4;
        }
      }
      push @output, $_;
    }
    $$text_ref = join '',@output;
  };
  return $filter;
}

1;
__END__
=pod

=head1 NAME

HTML::Template::Filters - HTML::Template support module, which
contains some useful filters.

=head1 SYNOPSIS

  use HTML::Template::Filters qw(get_filters);

  my $filters = get_filters(
    HT_FILTER_ALLOW_TRAILING_SLASH,
    HT_FILTER_TMPL_COMMENT,
    HT_FILTER_TMPL_SET,
  );
  my $ht = new HTML::Template(
    filename => 'somefile.tmpl',
    filter => $filters,
  );

=head1 DESCRIPTION

This is a support module for HTML::Template, which contains a
collection of filters that can be applied to a HTML::Template
object.

Current filters available (detailed below):
 - HT_FILTER_ALLOW_TRAILING_SLASH
 - HT_FILTER_SSI_INCLUDE_VIRTUAL
 - HT_FILTER_TMPL_COMMENT
 - HT_FILTER_TMPL_FIXME
 - HT_FILTER_TMPL_SET

=head2 Trailing slash

Enable HTML::Template to support the parsing of a trailing
slash within template tags, for example:

  <TMPL_IF somevar />
    <TMPL_VAR anothervar />
  </TMPL_IF />

=head2 SSI (server side includes) virtual includes

Translate SSI virtual includes, into H::T includes.

  <!-- #include virtual="some_include" -->

 becomes

  <TMPL_INCLUDE NAME="some_include">

=head2 TMPL_COMMENT

Allows the TMPL_COMMENT tag so that any text between the
start/end tag is stripped, as in:

  <TMPL_COMMENT>Any text between comments
  is stripped</TMPL_COMMENT>

=head2 TMPL_FIXME

Same as TMPL_COMMENT (makes for searching of FIXME's)

=head2 TMPL_SET

Allows the following syntax within templates:

  <TMPL_SET NAME="template_var" VALUE="some_value">

This will then translate all <TMPL_VAR NAME="template_var">'s
into "some_value".  Doesn't work for <TMPL_LOOP ..>'s as loops
require the template variable to be an array (rather than a
scalar).

=head1 BUGS

You can send bug reports to the HTML::Template mailing-list. To join
the list, visit:

  http://lists.sourceforge.net/lists/listinfo/html-template-users

=head1 CREDITS

The users of the HTML::Template mailing list contributed the idea
and some patterns for the implementation of this module.

=head1 AUTHOR

Mathew Robertson <mathew@users.sf.net>

=head1 LICENSE

This module is released under the same license that HTML::Template
is released under.