File Coverage

blib/lib/Apache2/HttpEquiv.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#---------------------------------------------------------------------
package Apache2::HttpEquiv;
#
# Copyright 2012 Christopher J. Madsen
#
# Author: Christopher J. Madsen
# Created: 11 Mar 2006
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
# GNU General Public License or the Artistic License for more details.
#
# ABSTRACT: Convert  to HTTP headers
#---------------------------------------------------------------------

use 5.008;
use strict;
use Apache2::Const -compile => qw(OK DECLINED);
use HTML::PullParser;

#=====================================================================
# Package Global Variables:

our $VERSION = '1.00';
# This file is part of Apache2-HttpEquiv 1.00 (January 4, 2014)

#=====================================================================
sub handler
{
  my $r = shift;

  return Apache2::Const::DECLINED
      unless $r->is_initial_req
         and $r->content_type eq "text/html"
         and open(my $file, '<:encoding(latin1)', $r->filename);

  my ($p, $token, $header) = HTML::PullParser->new(
    file  => $file,
    start => 'tag, attr',
    end   => 'tag',
  );

  my $content_type;

  while ($token = $p->get_token) {
    if ($token->[0] eq 'meta') {
      if ($header = $token->[1]{'charset'} and not defined $content_type) {
        $content_type = "text/html; charset=$header";
      } # end if
      elsif ($header = $token->[1]{'http-equiv'}) {
        if ($header eq 'Content-Type' and not defined $content_type) {
          $content_type = $token->[1]{content};
          # text/xhtml is not a valid content type:
          $content_type =~ s!^text/xhtml(?=\s|;|\z)!text/html!i;
        } else {
          $r->headers_out->set($header => $token->[1]{content});
        }
      } # end elsif
    } # end if  tag
    last if $token->[0] eq 'body' or $token->[0] eq '/head';
  } # end while get_token

  $r->content_type($content_type) if $content_type;

  close($file);

  return Apache2::Const::OK;
} # end handler

#=====================================================================
# Package Return Value:

1;

__END__