lib/HTTP/Headers/ReadOnly.pm

   1 #!/usr/bin/perl
   2
   3 package HTTP::Headers::ReadOnly;
   4 use base qw/HTTP::Headers/;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Carp qw/croak/;
  10 use Class::Inspector;
  11
  12 sub _jerk_it {
  13         croak "Can't modify headers after headers have been sent to the client";
  14 }
  15
  16 sub _header {
  17         my ( $self, $field, $val, $op ) = @_;
  18         shift;
  19         _jerk_it if $val;
  20
  21         $self->SUPER::_header(@_);
  22 }
  23
  24 BEGIN {
  25         for ( @{ Class::Inspector->functions( "HTTP::Headers" ) }) {
  26                 no strict 'refs';
  27                 *$_ = \&_jerk_it if /remove|clear/;
  28
  29         }
  30 }
  31
  32 __PACKAGE__;
  33
  34 __END__
  35
  36 =pod
  37
  38 =head1 NAME
  39
  40 HTTP::Headers::ReadOnly - Immutable HTTP::headers
  41
  42 =head1 SYNOPSIS
  43
  44         my $headers = HTTP::Headers->new(...);
  45
  46         bless $headers, "HTTP::Headers::ReadOnly";
  47
  48         $headers->content_type( "foo" ); # dies
  49
  50 =head1 DESCRIPTION
  51
  52 This class blocks write access to a L<HTTP::Headers> object.
  53
  54 It is used to raise errors in L<Catalyst> if the header object is modified
  55 after C<finalize_headers>.
  56
  57 =cut
  58
  59