APR-HTTP-Headers-Compat

 view release on metacpan or  search on metacpan

lib/APR/HTTP/Headers/Compat.pm  view on Meta::CPAN

  my $h = APR::HTTP::Headers::Compat->new( $table,
    'Content-type' => 'text/plain'
  );

=cut

sub new {
  my ( $class, $table ) = ( shift, shift );
  my %self = %{ $class->SUPER::new( @_ ) };
  tie %self, 'APR::HTTP::Headers::Compat::MagicHash', $table, %self;
  return bless \%self, $class;
}

sub _magic { tied %{ shift() } }

=head2 C<< clone >>

Clone this object. The clone is a regular L<HTTP::Headers> object rather
than an C<APR::HTTP::Headers::Compat>.

=cut

sub clone { bless { %{ shift() } }, 'HTTP::Headers' }

=head2 C<< table >>

Get the underlying L<APR::Table> object. Changes made in either the
table or the wrapper are reflected immediately in the other.

=cut

sub table { shift->_magic->table }

lib/APR/HTTP/Headers/Compat.pm  view on Meta::CPAN

C<APR::HTTP::Headers::Compat>.

=cut

sub remove_content_headers {
  my $self = shift;

  return $self->SUPER::remove_content_headers( @_ )
   unless defined wantarray;

  # This gets nasty. We downbless ourself to be an HTTP::Headers so that
  # when HTTP::Headers->remove_content_headers does
  #
  #   my $c = ref( $self )->new
  #
  # it creates a new HTTP::Headers instead of attempting to create a
  # new APR::HTTP::Headers::Compat.

  my $class = ref $self;
  bless $self, 'HTTP::Headers';
  
  # Calls SUPER::remove_content_headers due to rebless
  my $other = $self->remove_content_headers( @_ );
  bless $self, $class;

  # Return a non-magic HTTP::Headers
  return $other;
}

1;
__END__

=head1 CAVEATS

lib/APR/HTTP/Headers/Compat/MagicArray.pm  view on Meta::CPAN

use warnings;

=head1 NAME

APR::HTTP::Headers::Compat::MagicArray - magic array for multivalue headers

=cut

sub TIEARRAY {
  my ( $class, $fld, $magic, @vals ) = @_;
  return bless {
    a => \@vals,
    f => $fld,
    m => $magic,
  }, $class;
}

sub FETCH {
  my ( $self, $key ) = @_;
  return $self->{a}[$key];
}

lib/APR/HTTP/Headers/Compat/MagicHash.pm  view on Meta::CPAN

=head1 NAME

APR::HTTP::Headers::Compat::MagicHash - Tie a hash to an APR::Table

=cut

sub TIEHASH {
  my ( $class, $table, %args ) = @_;

  my $self = bless { table => $table }, $class;

  while ( my ( $k, $v ) = each %args ) {
    $self->STORE( $k, $v );
  }

  return $self;
}

=head2 C<< table >>